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 |
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)> |
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)> |
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)> |
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. |
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 |
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) = |
375 |
close_out _outChannel |
close_out _outChannel |
376 |
|
|
377 |
end |
end |
378 |
|
|