/[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.12 by srv89, Wed Sep 10 11:32:19 2003 UTC revision 1.13 by srv89, Mon Sep 15 13:50:59 2003 UTC
# Line 45  Line 45 
45    
46  open Sys  open Sys
47  open Pxp_yacc  open Pxp_yacc
48    open Pxp_document
49    
50  open DefaultVisitor  open DefaultVisitor
 open Nn  
51  open XmlMlpnnVisitor  open XmlMlpnnVisitor
52  open XmlTdnnVisitor  open XmlTdnnVisitor
53    open Nn
54  open MlpNN  open MlpNN
55  open TdNN  open TdNN
56    open Corpus
57    open Pattern
58    
59  (**  (**
60    Raised if _overwriteFile is false, and someone tries to overwrite an    Raised if _overwriteFile is false, and someone tries to overwrite an
# Line 98  object (this) Line 101  object (this)
101    *)    *)
102    val _header =    val _header =
103      "<?xml version=\"1.0\"?>      "<?xml version=\"1.0\"?>
104    
105  <!--  This file was generated by LibNN  -->  <!--  This file was generated by LibNN  -->
106  <!--          http://libnn.org          -->  <!--          http://libnn.org          -->
107    
# Line 301  tdnn_time_nb,tdnn_field_size)> Line 305  tdnn_time_nb,tdnn_field_size)>
305      Dumps a 5d array.      Dumps a 5d array.
306      @param array The array which is to be dumped.      @param array The array which is to be dumped.
307    *)    *)
308    method private dump5dArray (a_array : float array array array array) string_of_a =    method private dump5dArray
309        (a_array : float array array array array) string_of_a =
310      this#openTag "_5d_array";      this#openTag "_5d_array";
311      for x = 0 to (Array.length a_array - 1) do      for x = 0 to (Array.length a_array - 1) do
312        for y = 0 to (Array.length a_array.(x) - 1) do        for y = 0 to (Array.length a_array.(x) - 1) do
# Line 363  tdnn_time_nb,tdnn_field_size)> Line 368  tdnn_time_nb,tdnn_field_size)>
368        dumpEnv (env : 'd) =        dumpEnv (env : 'd) =
369        this#out "Dumping env as XML ..." 5;        this#out "Dumping env as XML ..." 5;
370        this#openTag "env";        this#openTag "env";
371        this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>");        this#write ("<verbosity>" ^ (string_of_int env#getVerbosity)
372        this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>");                    ^ "</verbosity>");
373        this#write ("<out_channel>" ^ (env#string_of_channel env#getOutChannel) ^ "</out_channel>");        this#write ("<randlimit>" ^ (string_of_float env#getRandLimit)
374        this#write ("<err_channel>" ^ (env#string_of_channel env#getOutChannel) ^ "</err_channel>");                    ^ "</randlimit>");
375          this#write ("<out_channel>" ^ (env#string_of_channel env#getOutChannel)
376                      ^ "</out_channel>");
377          this#write ("<err_channel>" ^ (env#string_of_channel env#getOutChannel)
378                      ^ "</err_channel>");
379        this#closeTag "env";        this#closeTag "env";
380      in      in
381        this#out ("Dumping neural network to XML as `" ^ _fileName ^ "\' ...") 3;        this#out ("Dumping neural network to XML as `" ^ _fileName ^ "\' ...") 3;
382        this#out ("Checking whether writing `" ^ _fileName ^ "\' is possible/enabled ...") 5;        this#out ("Checking whether writing `" ^ _fileName
383                    ^ "\' is possible/enabled ...") 5;
384        if (Sys.file_exists _fileName & not _overwriteFile) then        if (Sys.file_exists _fileName & not _overwriteFile) then
385          raise FileExists;          raise FileExists;
386        if (_fileName <> "") then        if (_fileName <> "") then
# Line 407  tdnn_time_nb,tdnn_field_size)> Line 417  tdnn_time_nb,tdnn_field_size)>
417      this#out ("Neural network successfully dumped as `" ^ _fileName ^ "\'.") 3      this#out ("Neural network successfully dumped as `" ^ _fileName ^ "\'.") 3
418    
419    (**    (**
420      Parses an XML file and creates a nn object out of it.      Parses an XML file and creates a nn object which corresponds to the parsed
421        XML file.
422    *)    *)
423    method xml2Nn =    method xml2Nn =
424      let document2Nn doc =      
425        (**
426          A function which checks whether a node matches one of the possible
427          element names.
428          @param node The node to check.
429          @param expected_element_names A list of possible element names (a list
430          of strings).
431        *)
432        let checkNode (node : 'ext node) (expected_element_names : string list) =
433          let rec checkNodeRec node expected_element_names =
434            let checkOnePossibility possible_name =
435              match node#node_type with
436                  T_element(name) when name = possible_name -> true
437                | _ -> false
438            in
439              match expected_element_names with
440                  h::t -> (if (checkOnePossibility h || checkNodeRec node t)
441                           then true
442                           else false)
443                | [] -> false
444          in
445            if (not (checkNodeRec node expected_element_names))
446            then (assert false)
447        in
448    
449        (**
450          Checks whether a node is a data node.
451          @param node The node to check.
452        *)
453        let checkDataNode (node : 'ext node) =
454          match node#node_type with
455              T_data -> ()
456            | _ -> assert false
457        in
458    
459        (**
460          Returns an int which corresponds to a given XML node.
461          NB: node must be a x, y, z, or t element, not a data node!.
462          @param node An XML node which corresponds to an int.
463          @return an int which corresponds to node parameter.
464        *)
465        let int_of_node (node : 'ext node) =
466          checkNode node ["x"; "y"; "z"; "t"];
467          let data_node = List.hd (node#sub_nodes) in
468            checkDataNode data_node;
469            int_of_string (data_node#data)
470        in
471    
472        (**
473          Returns a float which corresponds to a given XML node.
474          NB: node must be a value element, not a data node!.
475          @param node An XML node which corresponds to a float.
476          @return an int which corresponds to node parameter.
477        *)
478        let float_of_node (node : 'ext node) =
479          checkNode node ["value"];
480          let data_node = List.hd (node#sub_nodes) in
481            checkDataNode data_node;
482            float_of_string (data_node#data)
483        in
484    
485        (**
486          Given a list of lists, gives you the max element of all the
487          position'th member of the sublists in the whole list.
488          @param collector A list of lists.
489          @param position The nth element of the sublist to care about.
490          @return the max element of all the position'th member of the sublists
491          in the whole list.
492        *)
493        let maxInCollector
494          (collector : (int list * float) list) (position : int) =
495          let rec maxFromList (list : int list) =
496            match list with
497                [] -> 0
498              | h::t when (t = []) -> h
499              | h::t -> (max h (maxFromList t))
500          in
501            (**
502              Creates a list containing the nth element of the int list of the
503              collector.
504            *)
505          let rec nthFromCollector
506            (collector : (int list * float) list) (position : int) =
507            match collector with
508                [] -> []
509              | h::t -> ([(List.nth (fst h) position)]
510                         @ (nthFromCollector t position))
511          in
512            maxFromList (nthFromCollector collector position)
513        in
514          
515        (**
516          Returns a float array which corresponds to a given XML node.
517          NB: node must be a _2d_array element.
518          @param node An XML node which corresponds to an _3d_array.
519          @return a float float array which corresponds to node parameter.
520        *)
521        let _3d_array_of_node (node : 'ext node) =
522          checkNode node ["_3d_array"];
523          let rec createCollector nodes_list =
524            match nodes_list with
525                [] -> []
526              | _ -> (
527                  let x_node = List.hd nodes_list and
528                    y_node = List.nth nodes_list 1 and
529                    value_node = List.nth nodes_list 2
530                  in
531                  let x_value = int_of_node x_node and
532                    y_value = int_of_node y_node and
533                    value_value = float_of_node value_node and
534                    remove3FirstElements list =
535                    List.tl (List.tl (List.tl list))
536                  in
537                    [([x_value; y_value], value_value)]
538    @ (createCollector (remove3FirstElements nodes_list ))
539                )
540          in
541            assert (((List.length node#sub_nodes) mod 3) = 0);
542            let collector = createCollector (node#sub_nodes)
543            in
544              (* Now, let's find the result array's dimensions. *)
545            let max_x = maxInCollector collector 0 and
546              max_y = maxInCollector collector 1
547            in
548              (* Build the result array *)
549            let res = Array.make max_x [||] in
550              for i = 0 to max_x - 1 do
551                res.(i) <- Array.make max_y 0.;
552              done;
553              (* Fill the result array *)
554              for i = 0 to List.length collector - 1 do
555                let couple = List.nth collector i in
556                  res.(List.nth (fst couple) 0).(List.nth (fst couple) 1)
557                  <- (snd couple)
558              done;
559              res
560        in
561          
562        (**
563          Returns an input vector which corresponds to a given XML node.
564          NB: node must be an input element.
565          @param node An XML node which corresponds to an input.
566          @return an input vector which corresponds to node parameter.
567        *)
568        let input_of_node (node : 'ext node) =
569          checkNode node ["input"];
570          _3d_array_of_node (List.hd node#sub_nodes)
571        in
572          
573        (**
574          Returns an output vector which corresponds to a given XML node.
575          NB: node must be an output element.
576          @param node An XML node which corresponds to an output.
577            @return an output vector which corresponds to node parameter.
578        *)
579        let output_of_node (node : 'ext node) =
580          checkNode node ["output"];
581          _3d_array_of_node (List.hd node#sub_nodes)
582        in
583          (**
584            Returns an instance of the pattern class, which corresponds to a given
585            XML node.
586            NB: node must be a pattern element.
587            @param node An XML node which corresponds to a pattern.
588            @return an instance of pattern which corresponds to node parameter.
589          *)
590        let pattern_of_node (node : 'ext node) =
591          checkNode node ["pattern"];
592          let children = node#sub_nodes in
593            new pattern
594              (input_of_node (List.nth children 0))
595              (output_of_node (List.nth children 1))
596        in
597          (**
598            Returns an instance of the corpus class, which corresponds to a given XML
599            node.
600            NB: node must be a corpus element.
601            @param node An XML node which corresponds to a corpus.
602            @return an instance of corpus which corresponds to node parameter.
603          *)
604        let corpus_of_node (node : 'ext node) =
605          this#out "Loading corpus from XML node ..." 5;
606          checkNode node ["corpus"];
607          let corpus = new corpus in
608          let children =    node#sub_nodes in
609            for i = 0 to List.length children - 1 do
610              corpus#addPattern (pattern_of_node ((List.nth) children i))
611            done;
612            corpus
613        in
614          
615        (**
616          Returns a new instance of the `nn' class which corresponds to the
617          document tree returned by the parser.
618          @param doc The document returned by the PXP parser.`
619          @return an instance of nn which corresponds to node parameter.
620        *)
621        let nn_of_document (doc : 'ext document) =
622        this#out "Loading neural network from the XML tree ..." 5;        this#out "Loading neural network from the XML tree ..." 5;
623          let root = doc#root in
624          let corpus = corpus_of_node (root#nth_node 1) in
625            (* //FIXME: return something wich makes sense... *)
626        let res = ((new mlpNN) :> nn) in        let res = ((new mlpNN) :> nn) in
627          this#out "Successfully loaded neural network from the XML tree ..." 5;          this#out "Successfully loaded neural network from the XML tree." 5;
628          res          res
629      in      in
630          
631      let doc =      let doc =
632        let config =        let config =
633          { default_config with warner = new warner }          { default_config with warner = new warner }
# Line 429  tdnn_time_nb,tdnn_field_size)> Line 641  tdnn_time_nb,tdnn_field_size)>
641                raise ParseError                raise ParseError
642      in      in
643        this#out ("Successfully parsed `" ^ _fileName ^ "\'.") 5;        this#out ("Successfully parsed `" ^ _fileName ^ "\'.") 5;
644        document2Nn doc        nn_of_document doc
645                        
646    (**    (**
647      The generic visit method.      The generic visit method.

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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