/[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.3 by srv89, Fri Aug 29 08:32:32 2003 UTC revision 1.4 by srv89, Mon Sep 1 13:08:35 2003 UTC
# Line 47  open Sys Line 47  open Sys
47    
48  open DefaultVisitor  open DefaultVisitor
49  open Nn  open Nn
50    open Pattern
51    open Env
52    open Corpus
53    
54  (**  (**
55    Thrown if _overwriteFile is false, and someone tries to overwrite an    Thrown if _overwriteFile is false, and someone tries to overwrite an
# Line 85  object (this) Line 88  object (this)
88  <!-- Neural Network (the XML file's root. `nn' class) -->  <!-- Neural Network (the XML file's root. `nn' class) -->
89  <!ELEMENT nn (step,corpus,env,(mlpnn|tdnn))>  <!ELEMENT nn (step,corpus,env,(mlpnn|tdnn))>
90    
91  <!-- Neural Networks kinds (concrete classes which inherit from the `nn' class) -->  <!-- Neural Networks kinds (concrete classes which inherit from the -->
92    <!-- `nn' class)                                                    -->
93  <!-- Multi Layer Perceptron (`mlpNN' class) -->  <!-- Multi Layer Perceptron (`mlpNN' class) -->
94  <!ELEMENT mlpnn (mlpnn_output_activation,mlpnn_input_sum,mlpnn_error,\  <!ELEMENT mlpnn (mlpnn_output_activation,mlpnn_input_sum,mlpnn_error,
95  mlpnn_weights,mlpnn_gradients,layer_nb,mlpnn_neurons_per_layer)>  mlpnn_weights,mlpnn_gradients,layer_nb,mlpnn_neurons_per_layer)>
96  <!ELEMENT mlpnn_output_activation (3d_array)>  <!ELEMENT mlpnn_output_activation (3d_array)>
97  <!ELEMENT mlpnn_input_sum (3d_array)>  <!ELEMENT mlpnn_input_sum (3d_array)>
# Line 96  mlpnn_weights,mlpnn_gradients,layer_nb,m Line 100  mlpnn_weights,mlpnn_gradients,layer_nb,m
100  <!ELEMENT mlpnn_gradients (4d_array)>  <!ELEMENT mlpnn_gradients (4d_array)>
101  <!ELEMENT mlpnn_neurons_per_layer (2d_array)>  <!ELEMENT mlpnn_neurons_per_layer (2d_array)>
102  <!-- Time Delay Neural Network (`tdNNN' class) -->  <!-- Time Delay Neural Network (`tdNNN' class) -->
103  <!ELEMENT tdnn (tdnn_output_activation,tdnn_input_sum,tdnn_error,\  <!ELEMENT tdnn (tdnn_output_activation,tdnn_input_sum,tdnn_error,
104  tdnn_weights,tdnn_gradients,layer_nb,tdnn_delay,tdnn_features_nb,\  tdnn_weights,tdnn_gradients,layer_nb,tdnn_delay,tdnn_features_nb,
105  tdnn_time_nb,tdnn_field_size)>  tdnn_time_nb,tdnn_field_size)>
106  <!ELEMENT tdnn_output_activation (4d_array)>  <!ELEMENT tdnn_output_activation (4d_array)>
107  <!ELEMENT tdnn_input_sum (4d_array)>  <!ELEMENT tdnn_input_sum (4d_array)>
# Line 114  tdnn_time_nb,tdnn_field_size)> Line 118  tdnn_time_nb,tdnn_field_size)>
118  <!ELEMENT corpus (pattern*)>  <!ELEMENT corpus (pattern*)>
119  <!-- Pattern (`pattern' class) -->  <!-- Pattern (`pattern' class) -->
120  <!ELEMENT pattern (input,output)>  <!ELEMENT pattern (input,output)>
121  <!ELEMENT input (#CDATA)>  <!ELEMENT input (2d_array)>
122  <!ELEMENT output (#CDATA)>  <!ELEMENT output (2d_array)>
123  <!-- Environment (`env' class) -->  <!-- Environment (`env' class) -->
124  <!ELEMENT env (verbosity,randlimit,channel)>  <!ELEMENT env (verbosity,randlimit,channel)>
125  <!ELEMENT verbosity (#CDATA)>  <!ELEMENT verbosity (#CDATA)>
# Line 147  tdnn_time_nb,tdnn_field_size)> Line 151  tdnn_time_nb,tdnn_field_size)>
151      The XML file's footer. Closes all pending tags.      The XML file's footer. Closes all pending tags.
152    *)    *)
153    val _footer =    val _footer =
154      "</nn>      "
155    </nn>
156    
157  <!-- End of the dump -->  <!-- End of the dump -->"
 "  
158    
159    (**    (**
160      The name of the .xml file which is to be generated.      The name of the .xml file which is to be generated.
# Line 203  tdnn_time_nb,tdnn_field_size)> Line 207  tdnn_time_nb,tdnn_field_size)>
207      @param str The string that is to be written.      @param str The string that is to be written.
208    *)    *)
209    method private write (str : string) =    method private write (str : string) =
210      output _outChannel str 0 (String.length str)      let writen = str ^ "
211    " in
212          output _outChannel (writen) 0 (String.length writen)
213          
214      (**
215        Opens a XML tag.
216        @param tag Would be "plop" if you want "<plop>" to be output.
217      *)
218      method private openTag (tag) =
219        this#write ("<" ^ tag ^ ">")
220    
221      (**
222        CLoses a XML tag.
223        @param tag Would be "plop" if you want "</plop>" to be output.
224      *)
225      method private closeTag (tag) =
226        this#write ("</" ^ tag ^ ">")
227    
228      (**
229        Dumps a 2d array.
230        @param array The array which is to be dumped.
231      *)
232      method private dump2dArray a_array string_of_a =
233        this#openTag "2d_array";
234        for x = 0 to (Array.length a_array - 1) do
235          this#write ("<x>" ^ (string_of_int x) ^
236                      "</x><value>" ^
237                      (string_of_a a_array.(x)) ^
238                      "</value>")
239        done;
240        this#closeTag "2d_array"
241          
242      (**
243        Dumps a 3d array.
244        @param array The array which is to be dumped.
245      *)
246      method private dump3dArray a_array string_of_a =
247        this#openTag "3d_array";
248        for x = 0 to (Array.length a_array - 1) do
249          for y = 0 to (Array.length a_array.(x) - 1) do
250            this#write ("<x>" ^ (string_of_int x) ^
251                        "</x><y>" ^ (string_of_int y) ^
252                        "</y><value>" ^
253                        (string_of_a a_array.(x).(y)) ^
254                        "</value>")
255          done
256        done;
257        this#closeTag "3d_array"
258    
259      (**
260        Dumps a 4d array.
261        @param array The array which is to be dumped.
262      *)
263      method private dump4dArray a_array string_of_a =
264        this#openTag "4d_array";
265        for x = 0 to (Array.length a_array - 1) do
266          for y = 0 to (Array.length a_array.(x) - 1) do
267            for z = 0 to (Array.length a_array.(x).(y) - 1) do
268              this#write ("<x>" ^ (string_of_int x) ^
269                          "</x><y>" ^ (string_of_int y) ^
270                          "</y><z>" ^ (string_of_int z) ^
271                          "</z><value>" ^
272                          string_of_a a_array.(x).(y).(z) ^
273                          "</value>")
274            done
275          done
276        done;
277        this#closeTag "4d_array"
278          
279      (**
280        Dumps a 5d array.
281        @param array The array which is to be dumped.
282      *)
283      method private dump5dArray a_array string_of_a =
284        this#openTag "5d_array";
285        for x = 0 to (Array.length a_array - 1) do
286          for y = 0 to (Array.length a_array.(x) - 1) do
287            for z = 0 to (Array.length a_array.(x).(y) - 1) do
288              for t = 0 to (Array.length a_array.(x).(y).(z) - 1) do
289                this#write ("<x>" ^ (string_of_int x) ^
290                            "</x><y>" ^ (string_of_int y) ^
291                            "</y><z>" ^ (string_of_int z) ^
292                            "</z><t>" ^ (string_of_int t) ^
293                            "</t><value>" ^
294                            (string_of_a a_array.(x).(y).(z).(t)) ^
295                            "</value>")
296              done
297            done
298          done
299        done;
300        this#closeTag "5d_array"
301                
302    (**    (**
303      The method which creates the XML file with its embedded DTD, and dump      The method which creates the XML file with its embedded DTD, and dump
# Line 211  tdnn_time_nb,tdnn_field_size)> Line 305  tdnn_time_nb,tdnn_field_size)>
305      @param network The neural network which is to be dumped.      @param network The neural network which is to be dumped.
306    *)    *)
307    method beginDump (network : nn) =    method beginDump (network : nn) =
    if (Sys.file_exists _fileName & not _overwriteFile) then  
       raise FileExists;  
     _outChannel <- open_out _fileName;  
     this#write _header;  
308      (**      (**
309        Dump stuffs inherited from the `nn' class.        Dumps a pattern.
310      *)      *)
311      let step = "<step>" ^ (string_of_float network#getStep) ^ "</step>" in      let dumpPattern (pattern : pattern) =
312        this#write step        this#openTag "pattern";
313          this#openTag "input";
314          this#dump3dArray pattern#getInputs string_of_float;
315          this#closeTag "input";
316          this#openTag "output";
317          this#dump3dArray pattern#getOutputs string_of_float;
318          this#closeTag "output";
319          this#closeTag "pattern"
320        in
321          
322        (**
323          Dumps an instance of corpus.
324        *)
325        let dumpCorpus (corpus : corpus) =
326          this#openTag "corpus";
327          let patterns = corpus#getPatterns in
328          let rec dumpPatterns (patterns) =
329            match patterns with
330                [] -> ()
331              | h::t -> (dumpPattern h;
332                         dumpPatterns t)
333          in
334            dumpPatterns patterns;
335            this#closeTag "corpus"
336        and
337          (**
338            Dumps an instance of env.
339          *)
340          dumpEnv (env : environmentType) =
341          let string_of_channel (channel : out_channel) =
342            match channel with
343                stdout when stdout = Pervasives.stdout -> "stdout"
344              | stderr when stderr = Pervasives.stderr -> "stderr"
345              | _ -> "unknown"
346          in
347            this#openTag "env";
348            this#write ("<verbosity>" ^ (string_of_int env#getVerbosity) ^ "</verbosity>");
349            this#write ("<randlimit>" ^ (string_of_float env#getRandLimit) ^ "</randlimit>");
350            this#write ("<channel>" ^ (string_of_channel env#getChannel) ^ "</channel>");
351            this#closeTag "env";
352        in
353          
354          if (Sys.file_exists _fileName & not _overwriteFile) then
355            raise FileExists;
356          _outChannel <- open_out _fileName;
357          this#write _header;
358          (**
359            Dump stuffs inherited from the `nn' class.
360          *)
361          let step = "<step>" ^ (string_of_float network#getStep) ^ "</step>
362    " in
363            this#write step;
364            dumpCorpus network#getCorpus;
365            this#write "";
366            dumpEnv (Env.getEnv());
367            this#write ""  
368                    
369    (**    (**
370      Close tags which have to be closed, and close the file.      Closes tags which were opened by beginDump, and close the file.
371      @param network The neural network which is to be dumped.      @param network The neural network which is to be dumped.
372    *)    *)
373    method endDump (network : nn) =    method endDump (network : nn) =
# Line 230  tdnn_time_nb,tdnn_field_size)> Line 375  tdnn_time_nb,tdnn_field_size)>
375      close_out _outChannel      close_out _outChannel
376                
377  end  end
378      

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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