77 |
@param msg The message to be displayed |
@param msg The message to be displayed |
78 |
*) |
*) |
79 |
method warn msg = |
method warn msg = |
80 |
(Env.getEnv())#err "xml import/export" msg |
(Env.getEnv())#err "xml import/export" msg 1 |
81 |
|
|
82 |
end |
end |
83 |
|
|
206 |
*) |
*) |
207 |
method setFileName newval = |
method setFileName newval = |
208 |
_fileName <- newval; |
_fileName <- newval; |
209 |
this#out ("selected `" ^ _fileName ^ "\' as file name") |
this#out ("selected `" ^ _fileName ^ "\' as file name.") 4 |
210 |
|
|
211 |
(** |
(** |
212 |
If true, then if _fileName already exists on the disk, it is overwritten |
If true, then if _fileName already exists on the disk, it is overwritten |
228 |
*) |
*) |
229 |
method setOverwriteFile newval = |
method setOverwriteFile newval = |
230 |
_overwriteFile <- newval; |
_overwriteFile <- newval; |
231 |
this#out "file overwriting enabled" |
this#out "file overwriting enabled" 4 |
232 |
|
|
233 |
(** |
(** |
234 |
The out_channel used to dump the neural network. stdout is actually |
The out_channel used to dump the neural network. stdout is actually |
344 |
Dumps a pattern. |
Dumps a pattern. |
345 |
*) |
*) |
346 |
let dumpPattern (pattern : 'b) = |
let dumpPattern (pattern : 'b) = |
347 |
this#out "Dumping pattern as XML ..."; |
this#out "Dumping pattern as XML ..." 5; |
348 |
this#openTag "pattern"; |
this#openTag "pattern"; |
349 |
this#openTag "input"; |
this#openTag "input"; |
350 |
this#dump3dArray pattern#getInputs string_of_float; |
this#dump3dArray pattern#getInputs string_of_float; |
359 |
Dumps an instance of corpus. |
Dumps an instance of corpus. |
360 |
*) |
*) |
361 |
let dumpCorpus (corpus : 'c) = |
let dumpCorpus (corpus : 'c) = |
362 |
this#out "Dumping corpus as XML ..."; |
this#out "Dumping corpus as XML ..." 5; |
363 |
this#openTag "corpus"; |
this#openTag "corpus"; |
364 |
let patterns = corpus#getPatterns in |
let patterns = corpus#getPatterns in |
365 |
let rec dumpPatterns (patterns) = |
let rec dumpPatterns (patterns) = |
375 |
Dumps an instance of env. |
Dumps an instance of env. |
376 |
*) |
*) |
377 |
dumpEnv (env : 'd) = |
dumpEnv (env : 'd) = |
378 |
this#out "Dumping env as XML ..."; |
this#out "Dumping env as XML ..." 5; |
379 |
let string_of_channel (channel : out_channel) = |
this#openTag "env"; |
380 |
match channel with |
this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>"); |
381 |
stdout when stdout = Pervasives.stdout -> "stdout" |
this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>"); |
382 |
| stderr when stderr = Pervasives.stderr -> "stderr" |
this#write ("<out_channel>" ^ (env#string_of_channel env#getOutChannel) ^ "</out_channel>"); |
383 |
| _ -> "unknown" |
this#write ("<err_channel>" ^ (env#string_of_channel env#getOutChannel) ^ "</err_channel>"); |
384 |
in |
this#closeTag "env"; |
|
this#openTag "env"; |
|
|
this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>"); |
|
|
this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>"); |
|
|
this#write ("<out_channel>" ^ (string_of_channel env#getOutChannel) ^ "</out_channel>"); |
|
|
this#write ("<err_channel>" ^ (string_of_channel env#getOutChannel) ^ "</err_channel>"); |
|
|
this#closeTag "env"; |
|
385 |
in |
in |
386 |
this#out ("Checking whether writing `" ^ _fileName ^ "\' is possible/enabled ..."); |
this#out ("Dumping neural network to XML as `" ^ _fileName ^ "\'.") 3; |
387 |
|
this#out ("Checking whether writing `" ^ _fileName ^ "\' is possible/enabled ...") 5; |
388 |
if (Sys.file_exists _fileName & not _overwriteFile) then |
if (Sys.file_exists _fileName & not _overwriteFile) then |
389 |
raise FileExists; |
raise FileExists; |
390 |
if (_fileName <> "") then |
if (_fileName <> "") then |
391 |
(this#out ("Opening `" ^ _fileName ^"' ..."); |
(this#out ("Opening `" ^ _fileName ^"' ...") 5; |
392 |
_outChannel <- open_out _fileName) |
_outChannel <- open_out _fileName) |
393 |
else |
else |
394 |
(this#out "No file name was provided."; |
(this#err "No file name was provided." 2; |
395 |
this#out "Setting the standard output as output of the dump ..."; |
this#err "Setting the standard output as output of the dump ..." 2; |
396 |
_outChannel <- stdout); |
_outChannel <- stdout); |
397 |
this#out "Writing XML header ..."; |
this#out "Writing XML header ..." 5; |
398 |
this#write _header; |
this#write _header; |
399 |
|
|
400 |
(** |
(** |
414 |
@param network The neural network which is to be dumped. |
@param network The neural network which is to be dumped. |
415 |
*) |
*) |
416 |
method private endDump (network : nn) = |
method private endDump (network : nn) = |
417 |
this#out "Writing XML footer ..."; |
this#out "Writing XML footer ..." 5; |
418 |
this#write _footer; |
this#write _footer; |
419 |
this#out ("Closing `" ^ _fileName ^ "\' ..."); |
this#out ("Closing `" ^ _fileName ^ "\' ...") 5; |
420 |
close_out _outChannel; |
close_out _outChannel; |
421 |
this#out ("Neural network successfully dumped as `" ^ _fileName ^ "\'.") |
this#out ("Neural network successfully dumped as `" ^ _fileName ^ "\'.") 3 |
422 |
|
|
423 |
(** |
(** |
424 |
Parses an XML file and creates a nn object out of it. |
Parses an XML file and creates a nn object out of it. |
425 |
*) |
*) |
426 |
method xml2Nn = |
method xml2Nn = |
427 |
let document2Nn doc = |
let document2Nn doc = |
428 |
this#out "Loading neural network from the XML tree ..."; |
this#out "Loading neural network from the XML tree ..." 5; |
429 |
let res = ((new mlpNN) :> nn) in |
let res = ((new mlpNN) :> nn) in |
430 |
this#out "Successfully loaded neural network from the XML tree ..."; |
this#out "Successfully loaded neural network from the XML tree ..." 5; |
431 |
res |
res |
432 |
in |
in |
433 |
let doc = |
let doc = |
434 |
let config = |
let config = |
435 |
{ default_config with warner = new warner } |
{ default_config with warner = new warner } |
436 |
in |
in |
437 |
this#out ("Parsing `" ^ _fileName ^ "\' ..."); |
this#out ("Parsing `" ^ _fileName ^ "\' ...") 5; |
438 |
try |
try |
439 |
parse_document_entity config (from_file _fileName) default_spec |
parse_document_entity config (from_file _fileName) default_spec |
440 |
with |
with |
441 |
e -> |
e -> |
442 |
this#err (Pxp_types.string_of_exn e); |
this#err (Pxp_types.string_of_exn e) 1; |
443 |
raise ParseError |
raise ParseError |
444 |
in |
in |
445 |
this#out ("Successfully parsed `" ^ _fileName ^ "\'."); |
this#out ("Successfully parsed `" ^ _fileName ^ "\'.") 5; |
446 |
document2Nn doc |
document2Nn doc |
447 |
|
|
448 |
(** |
(** |