63 |
exception FileExists |
exception FileExists |
64 |
|
|
65 |
(** |
(** |
66 |
|
Raised if an error occurs during the XML parsing. |
67 |
|
*) |
68 |
|
exception ParseError |
69 |
|
|
70 |
|
(** |
71 |
|
The warner used to make PXP verbose. |
72 |
|
@see <http://ocaml-programming.de/packages/documentation/pxp/manual/x550.html> |
73 |
|
How to parse a document from an application (from the PXP user's guide). |
74 |
*) |
*) |
75 |
class warner = |
class warner = |
76 |
object |
object |
77 |
method warn w = |
method warn msg = |
78 |
print_endline ("WARNING: " ^ w) |
(Env.getEnv())#err "xml import/export" msg |
79 |
end |
end |
80 |
|
|
81 |
(** |
(** |
89 |
inherit ['a] defaultVisitor |
inherit ['a] defaultVisitor |
90 |
|
|
91 |
(** |
(** |
92 |
|
Writes a message on the standard output. |
93 |
|
@param msg The message to be displayed. |
94 |
|
*) |
95 |
|
method private out msg = |
96 |
|
(Env.getEnv())#out "xml import/export" msg |
97 |
|
|
98 |
|
(** |
99 |
|
Writes a message on the error output. |
100 |
|
@param msg The message to be displayed. |
101 |
|
*) |
102 |
|
method private err msg = |
103 |
|
(Env.getEnv())#err "xml import/export" msg |
104 |
|
|
105 |
|
(** |
106 |
The XML file's header. Contains the DTD. |
The XML file's header. Contains the DTD. |
107 |
@see <http://www.w3schools.com/dtd/dtd_intro.asp> How to get a DTD |
@see <http://www.w3schools.com/dtd/dtd_intro.asp> How to get a DTD |
108 |
whithin a XML file. |
whithin a XML file. |
151 |
<!ELEMENT input (_2d_array)> |
<!ELEMENT input (_2d_array)> |
152 |
<!ELEMENT output (_2d_array)> |
<!ELEMENT output (_2d_array)> |
153 |
<!-- Environment (`env' class) --> |
<!-- Environment (`env' class) --> |
154 |
<!ELEMENT env (verbosity,randlimit,channel)> |
<!ELEMENT env (verbosity,randlimit,out_channel,err_channel)> |
155 |
<!ELEMENT verbosity (#PCDATA)> |
<!ELEMENT verbosity (#PCDATA)> |
156 |
<!ELEMENT randlimit (#PCDATA)> |
<!ELEMENT randlimit (#PCDATA)> |
157 |
<!ELEMENT channel (#PCDATA)> |
<!ELEMENT out_channel (#PCDATA)> |
158 |
|
<!ELEMENT err_channel (#PCDATA)> |
159 |
<!-- Arrays --> |
<!-- Arrays --> |
160 |
<!ELEMENT _2d_array ((x,y,value)*)> |
<!ELEMENT _2d_array ((x,value)*)> |
161 |
<!ELEMENT _3d_array ((x,y,z,value)*)> |
<!ELEMENT _3d_array ((x,y,value)*)> |
162 |
<!ELEMENT _4d_array ((x,y,z,t,value)*)> |
<!ELEMENT _4d_array ((x,y,z,value)*)> |
163 |
<!ELEMENT _5d_array ((x,y,z,t,u,value)*)> |
<!ELEMENT _5d_array ((x,y,z,t,value)*)> |
164 |
<!ELEMENT x (#PCDATA)> |
<!ELEMENT x (#PCDATA)> |
165 |
<!ELEMENT y (#PCDATA)> |
<!ELEMENT y (#PCDATA)> |
166 |
<!ELEMENT z (#PCDATA)> |
<!ELEMENT z (#PCDATA)> |
167 |
<!ELEMENT t (#PCDATA)> |
<!ELEMENT t (#PCDATA)> |
|
<!ELEMENT u (#PCDATA)> |
|
168 |
<!ELEMENT value (#PCDATA)> |
<!ELEMENT value (#PCDATA)> |
169 |
<!-- Others --> |
<!-- Others --> |
170 |
<!ELEMENT step (#PCDATA)> |
<!ELEMENT step (#PCDATA)> |
192 |
val mutable _fileName = "neural_network_dump.xml" |
val mutable _fileName = "neural_network_dump.xml" |
193 |
|
|
194 |
(** |
(** |
195 |
|
A get*. |
196 |
|
@return the name of the .xml file which is to be generated. |
197 |
|
*) |
198 |
|
method getFileName = |
199 |
|
_fileName |
200 |
|
|
201 |
|
(** |
202 |
|
Sets the name of the .xml file which is to be generated. |
203 |
|
*) |
204 |
|
method setFileName newval = |
205 |
|
_fileName <- newval; |
206 |
|
this#out ("selected `" ^ _fileName ^ "\' as file name for xml dump") |
207 |
|
|
208 |
|
(** |
209 |
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 |
210 |
during the dump. Otherwise the `FileExists' exception is thrown during |
during the dump. Otherwise the `FileExists' exception is thrown during |
211 |
the dump. |
the dump. |
212 |
*) |
*) |
213 |
val mutable _overwriteFile = false |
val mutable _overwriteFile = false |
214 |
|
|
215 |
|
(** |
216 |
|
A get*. |
217 |
|
@return True if the `overwrite' mode is set. Otherwise, false. |
218 |
|
*) |
219 |
|
method getOverwriteFile = |
220 |
|
_overwriteFile |
221 |
|
|
222 |
|
(** |
223 |
|
Enables to choose whether LibNN is supposed to overwrite files during |
224 |
|
XML dumps or not. |
225 |
|
*) |
226 |
|
method setOverwriteFile newval = |
227 |
|
_overwriteFile <- newval; |
228 |
|
this#out "file overwriting enabled" |
229 |
|
|
230 |
(** |
(** |
231 |
The out_channel used to dump the neural network. stdout is actually |
The out_channel used to dump the neural network. stdout is actually |
232 |
never used (since there is a default value for _fileName), but OCaml |
never used (since there is a default value for _fileName), but OCaml |
341 |
Dumps a pattern. |
Dumps a pattern. |
342 |
*) |
*) |
343 |
let dumpPattern (pattern : pattern) = |
let dumpPattern (pattern : pattern) = |
344 |
|
this#out "Dumping pattern as XML ..."; |
345 |
this#openTag "pattern"; |
this#openTag "pattern"; |
346 |
this#openTag "input"; |
this#openTag "input"; |
347 |
this#dump3dArray pattern#getInputs string_of_float; |
this#dump3dArray pattern#getInputs string_of_float; |
356 |
Dumps an instance of corpus. |
Dumps an instance of corpus. |
357 |
*) |
*) |
358 |
let dumpCorpus (corpus : corpus) = |
let dumpCorpus (corpus : corpus) = |
359 |
|
this#out "Dumping corpus as XML ..."; |
360 |
this#openTag "corpus"; |
this#openTag "corpus"; |
361 |
let patterns = corpus#getPatterns in |
let patterns = corpus#getPatterns in |
362 |
let rec dumpPatterns (patterns) = |
let rec dumpPatterns (patterns) = |
372 |
Dumps an instance of env. |
Dumps an instance of env. |
373 |
*) |
*) |
374 |
dumpEnv (env : environmentType) = |
dumpEnv (env : environmentType) = |
375 |
|
this#out "Dumping env as XML ..."; |
376 |
let string_of_channel (channel : out_channel) = |
let string_of_channel (channel : out_channel) = |
377 |
match channel with |
match channel with |
378 |
stdout when stdout = Pervasives.stdout -> "stdout" |
stdout when stdout = Pervasives.stdout -> "stdout" |
382 |
this#openTag "env"; |
this#openTag "env"; |
383 |
this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>"); |
this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>"); |
384 |
this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>"); |
this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>"); |
385 |
this#write ("<channel>" ^ (string_of_channel env#getChannel) ^ "</channel>"); |
this#write ("<out_channel>" ^ (string_of_channel env#getOutChannel) ^ "</out_channel>"); |
386 |
|
this#write ("<err_channel>" ^ (string_of_channel env#getOutChannel) ^ "</err_channel>"); |
387 |
this#closeTag "env"; |
this#closeTag "env"; |
388 |
in |
in |
389 |
|
this#out ("Checking whether writing `" ^ _fileName ^ "\' is possible/enabled ..."); |
390 |
if (Sys.file_exists _fileName & not _overwriteFile & _fileName <> "") then |
if (Sys.file_exists _fileName & not _overwriteFile) then |
391 |
raise FileExists; |
raise FileExists; |
392 |
if (_fileName <> "") then |
if (_fileName <> "") then |
393 |
_outChannel <- open_out _fileName |
(this#out ("Opening `" ^ _fileName ^"' ..."); |
394 |
|
_outChannel <- open_out _fileName) |
395 |
else |
else |
396 |
_outChannel <- stdout; |
(this#out "No file name was provided."; |
397 |
|
this#out "Setting the standard output as output of the dump ..."; |
398 |
|
_outChannel <- stdout); |
399 |
|
this#out "Writing XML header ..."; |
400 |
this#write _header; |
this#write _header; |
401 |
|
|
402 |
(** |
(** |
403 |
Dump stuffs inherited from the `nn' class. |
Dump stuffs inherited from the `nn' class. |
404 |
FIXME |
FIXME |
416 |
@param network The neural network which is to be dumped. |
@param network The neural network which is to be dumped. |
417 |
*) |
*) |
418 |
method private endDump (network : 'a) = |
method private endDump (network : 'a) = |
419 |
|
this#out "Writing XML footer ..."; |
420 |
this#write _footer; |
this#write _footer; |
421 |
close_out _outChannel |
this#out ("Closing `" ^ _fileName ^ "\' ..."); |
422 |
|
close_out _outChannel; |
423 |
|
this#out ("Neural network successfully dumped as `" ^ _fileName ^ "\'.") |
424 |
|
|
425 |
(** |
(** |
426 |
Parses an XML file and creates a nn object out of it. |
Parses an XML file and creates a nn object out of it. |
427 |
*) |
*) |
428 |
method private xmlParse = |
method xml2Nn = |
429 |
let document2Nn doc = |
let document2Nn doc = |
430 |
((new mlpNN) :> nn) |
this#out "Loading neural network from the XML tree ..."; |
431 |
|
let res = ((new mlpNN) :> nn) in |
432 |
|
this#out "Successfully loaded neural network from the XML tree ..."; |
433 |
|
res |
434 |
in |
in |
435 |
try |
let doc = |
436 |
let config = |
let config = |
437 |
{ default_config with warner = new warner } |
{ default_config with warner = new warner } |
438 |
in |
in |
439 |
let d = |
this#out ("Parsing `" ^ _fileName ^ "\' ..."); |
440 |
parse_document_entity config (from_file "doc.xml") default_spec |
try |
441 |
in |
parse_document_entity config (from_file _fileName) default_spec |
442 |
document2Nn d |
with |
443 |
with |
e -> |
444 |
e -> |
this#err (Pxp_types.string_of_exn e); |
445 |
print_endline (Pxp_types.string_of_exn e); ((new mlpNN) :> nn) |
raise ParseError |
446 |
|
in |
447 |
|
this#out ("Successfully parsed `" ^ _fileName ^ "\'."); |
448 |
|
document2Nn doc |
449 |
|
|
450 |
(** |
(** |
451 |
The generic visit method. |
The generic visit method. |