/[marvin]/marvin/src/libnn/xml/xmlVisitor.ml
ViewVC logotype

Diff of /marvin/src/libnn/xml/xmlVisitor.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by srv89, Mon Sep 8 12:45:49 2003 UTC revision 1.9 by srv89, Mon Sep 8 23:28:47 2003 UTC
# Line 63  open TdNN Line 63  open TdNN
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  (**  (**
# Line 82  object (this) Line 89  object (this)
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.
# Line 130  tdnn_time_nb,tdnn_field_size)> Line 151  tdnn_time_nb,tdnn_field_size)>
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)>
# Line 171  tdnn_time_nb,tdnn_field_size)> Line 192  tdnn_time_nb,tdnn_field_size)>
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
# Line 291  tdnn_time_nb,tdnn_field_size)> Line 341  tdnn_time_nb,tdnn_field_size)>
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;
# Line 305  tdnn_time_nb,tdnn_field_size)> Line 356  tdnn_time_nb,tdnn_field_size)>
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) =
# Line 320  tdnn_time_nb,tdnn_field_size)> Line 372  tdnn_time_nb,tdnn_field_size)>
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"
# Line 329  tdnn_time_nb,tdnn_field_size)> Line 382  tdnn_time_nb,tdnn_field_size)>
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
# Line 357  tdnn_time_nb,tdnn_field_size)> Line 416  tdnn_time_nb,tdnn_field_size)>
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.

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26