/[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.10 by srv89, Tue Sep 9 12:56:27 2003 UTC revision 1.11 by srv89, Tue Sep 9 15:58:23 2003 UTC
# Line 77  object Line 77  object
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        
# Line 206  tdnn_time_nb,tdnn_field_size)> Line 206  tdnn_time_nb,tdnn_field_size)>
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
# Line 228  tdnn_time_nb,tdnn_field_size)> Line 228  tdnn_time_nb,tdnn_field_size)>
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
# Line 344  tdnn_time_nb,tdnn_field_size)> Line 344  tdnn_time_nb,tdnn_field_size)>
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;
# Line 359  tdnn_time_nb,tdnn_field_size)> Line 359  tdnn_time_nb,tdnn_field_size)>
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) =
# Line 375  tdnn_time_nb,tdnn_field_size)> Line 375  tdnn_time_nb,tdnn_field_size)>
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        (**        (**
# Line 419  tdnn_time_nb,tdnn_field_size)> Line 414  tdnn_time_nb,tdnn_field_size)>
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    (**    (**

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

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