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 |
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 |
|
|
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 |
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 |
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 } |
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. |