Commit | Line | Data |
b49c4318 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; use warnings; |
4 | use Test::More; |
5 | use lib 'lib'; |
6 | use lemmatizer::Model::Graph; |
7 | use XML::LibXML; |
8 | use XML::LibXML::XPathContext; |
9 | |
10 | my $datafile = 't/data/Collatex-16.xml'; |
11 | |
12 | open( GRAPHFILE, $datafile ) or die "Could not open $datafile"; |
13 | my @lines = <GRAPHFILE>; |
14 | close GRAPHFILE; |
15 | my $graph = lemmatizer::Model::Graph->new( 'xml' => join( '', @lines ) ); |
16 | |
17 | # Test the svg creation |
18 | my $parser = XML::LibXML->new(); |
19 | $parser->load_ext_dtd( 0 ); |
20 | my $svg = $parser->parse_string( $graph->as_svg() ); |
21 | is( $svg->documentElement->nodeName(), 'svg', 'Got an svg document' ); |
22 | |
23 | # Test for the correct number of nodes in the SVG |
24 | my $svg_xpc = XML::LibXML::XPathContext->new( $svg->documentElement() ); |
25 | $svg_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' ); |
26 | my @svg_nodes = $svg_xpc->findnodes( '//svg:g[@class="node"]' ); |
27 | is( scalar @svg_nodes, 21, "Correct number of nodes in the graph" ); |
28 | |
29 | # Test for the correct number of edges |
30 | my @svg_edges = $svg_xpc->findnodes( '//svg:g[@class="edge"]' ); |
31 | is( scalar @svg_edges, 27, "Correct number of edges in the graph" ); |
32 | |
33 | # Test for the correct common nodes |
34 | my @expected_nodes = map { [ "node_$_", 1 ] } qw/0 1 8 12 13 16 19 20 23 27/; |
35 | foreach my $idx ( qw/2 3 5 8 10 13 15/ ) { |
36 | splice( @expected_nodes, $idx, 0, [ "node_null", undef ] ); |
37 | } |
38 | my @active_nodes = $graph->active_nodes(); |
39 | # is_deeply( \@active_nodes, \@expected_nodes, "Initial common points" ); |
40 | subtest 'Initial common points' => \&compare_active; |
41 | my $string = '# when ... ... showers sweet with ... fruit the ... of ... has pierced ... the ... #'; |
42 | is( make_text( @active_nodes ), $string, "Got the right starting text" ); |
43 | |
44 | sub compare_active { |
45 | is( scalar( @active_nodes ), scalar ( @expected_nodes ), |
46 | "Arrays are same length" ); |
47 | |
48 | foreach ( 0 .. scalar(@active_nodes)-1 ) { |
49 | is( $active_nodes[$_]->[1], $expected_nodes[$_]->[1], |
50 | "Element has same toggle value" ); |
51 | if( defined $active_nodes[$_]->[1] ) { |
52 | is( $active_nodes[$_]->[0], $expected_nodes[$_]->[0], |
53 | "Active or toggled element has same node name" ); |
54 | } |
55 | } |
56 | } |
57 | |
58 | sub make_text { |
59 | my @words; |
60 | foreach my $n ( @_ ) { |
61 | if( $n->[1] ) { |
62 | push( @words, $graph->text_of_node( $n->[0] ) ); |
63 | } elsif ( !defined $n->[1] ) { |
64 | push( @words, '...' ); |
65 | } |
66 | } |
67 | return join( ' ', @words ); |
68 | } |
69 | |
70 | # Test the manuscript paths |
71 | my $wit_a = '# when april with his showers sweet with fruit the drought of march has pierced unto the root #'; |
72 | my $wit_b = '# when showers sweet with april fruit the march of drought has pierced to the root #'; |
73 | my $wit_c = '# when showers sweet with april fruit the drought of march has pierced the rood #'; |
74 | is( $graph->text_for_witness( "A" ), $wit_a, "Correct path for witness A" ); |
75 | is( $graph->text_for_witness( "B" ), $wit_b, "Correct path for witness B" ); |
76 | is( $graph->text_for_witness( "C" ), $wit_c, "Correct path for witness C" ); |
77 | |
78 | # Test the transposition identifiers |
79 | my $transposed_nodes = { 2 => 9, |
80 | 9 => 2, |
81 | 14 => 18, |
82 | 15 => 17, |
83 | 17 => 15, |
84 | 18 => 14 |
85 | }; |
86 | is_deeply( $graph->{transpositions}, $transposed_nodes, "Found the right transpositions" ); |
87 | |
88 | # Test turning on a node |
89 | my @off = $graph->toggle_node( 'node_24' ); |
90 | $expected_nodes[ 15 ] = [ "node_24", 1 ]; |
91 | splice( @expected_nodes, 15, 1, ( [ "node_26", 0 ], [ "node_24", 1 ] ) ); |
92 | @active_nodes = $graph->active_nodes( @off ); |
93 | subtest 'Turned on node for new location' => \&compare_active; |
94 | $string = '# when ... ... showers sweet with ... fruit the ... of ... has pierced ... the root #'; |
95 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
96 | |
97 | # Test the toggling effects of same-column |
98 | @off = $graph->toggle_node( 'node_26' ); |
99 | splice( @expected_nodes, 15, 2, ( [ "node_24", 0 ], [ "node_26", 1 ] ) ); |
100 | @active_nodes = $graph->active_nodes( @off ); |
101 | subtest 'Turned on other node in that location' => \&compare_active; |
102 | $string = '# when ... ... showers sweet with ... fruit the ... of ... has pierced ... the rood #'; |
103 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
104 | |
105 | # Test the toggling effects of transposition |
106 | |
107 | @off = $graph->toggle_node( 'node_14' ); |
108 | # Add the turned on node |
109 | splice( @expected_nodes, 8, 1, ( [ "node_15", 0 ], [ "node_14", 1 ] ) ); |
110 | # Add the off transposition node |
111 | splice( @expected_nodes, 11, 1, [ "node_18", undef ] ); |
112 | # Remove the explicit turning off of the earlier node |
113 | splice( @expected_nodes, 16, 1 ); |
114 | @active_nodes = $graph->active_nodes( @off ); |
115 | subtest 'Turned on transposition node' => \&compare_active; |
116 | $string = '# when ... ... showers sweet with ... fruit the drought of ... has pierced ... the rood #'; |
117 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
118 | |
119 | @off = $graph->toggle_node( 'node_18' ); |
120 | splice( @expected_nodes, 8, 2, [ "node_14", undef ] ); |
121 | splice( @expected_nodes, 10, 1, ( [ "node_17", 0 ], [ "node_18", 1 ] ) ); |
122 | @active_nodes = $graph->active_nodes( @off ); |
123 | subtest 'Turned on that node\'s partner' => \&compare_active; |
124 | $string = '# when ... ... showers sweet with ... fruit the ... of drought has pierced ... the rood #'; |
125 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
126 | |
127 | @off = $graph->toggle_node( 'node_14' ); |
128 | splice( @expected_nodes, 8, 1, [ "node_15", 0 ], [ "node_14", 1 ] ); |
129 | splice( @expected_nodes, 11, 2, ( [ "node_18", undef ] ) ); |
130 | @active_nodes = $graph->active_nodes( @off ); |
131 | subtest 'Turned on the original node' => \&compare_active; |
132 | $string = '# when ... ... showers sweet with ... fruit the drought of ... has pierced ... the rood #'; |
133 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
134 | |
135 | @off = $graph->toggle_node( 'node_3' ); |
136 | splice( @expected_nodes, 3, 1, [ "node_3", 1 ] ); |
137 | splice( @expected_nodes, 8, 1 ); |
138 | @active_nodes = $graph->active_nodes( @off ); |
139 | subtest 'Turned on a singleton node' => \&compare_active; |
140 | $string = '# when ... with his showers sweet with ... fruit the drought of ... has pierced ... the rood #'; |
141 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
142 | |
143 | @off = $graph->toggle_node( 'node_3' ); |
144 | splice( @expected_nodes, 3, 1, [ "node_3", 0 ] ); |
145 | @active_nodes = $graph->active_nodes( @off ); |
146 | subtest 'Turned off a singleton node' => \&compare_active; |
147 | $string = '# when ... showers sweet with ... fruit the drought of ... has pierced ... the rood #'; |
148 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
149 | |
150 | done_testing(); |