9 use Text::Tradition::Analysis qw/ run_analysis /;
11 binmode STDOUT, ':utf8';
12 binmode STDERR, ':utf8';
13 eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
15 my $tradition = Text::Tradition->new(
17 'file' => 't/data/besoin.xml' );
18 $tradition->add_stemma( 'dotfile' => 't/data/besoin.dot' );
20 # Run the analysis of the tradition
21 ## TODO Make proper test db
22 my $calcdsn = 'dbi:SQLite:dbname=t/data/analysis.db';
41 155 => 'genealogical',
42 170 => 'genealogical',
44 205 => 'genealogical',
45 219 => 'genealogical',
46 239 => 'genealogical',
47 244 => 'genealogical',
49 251 => 'genealogical',
50 252 => 'genealogical',
51 293 => 'genealogical',
52 295 => 'genealogical',
53 309 => 'genealogical',
58 318 => 'genealogical',
59 319 => 'genealogical',
63 335 => 'genealogical',
70 406 => 'genealogical',
71 413 => 'genealogical',
75 493 => 'genealogical',
85 632 => 'genealogical',
86 634 => 'genealogical',
87 636 => 'genealogical',
88 685 => 'genealogical',
89 737 => 'genealogical',
100 780 => 'genealogical',
104 837 => 'genealogical',
161 925 => 'genealogical',
163 952 => 'genealogical',
164 954 => 'genealogical',
165 969 => 'genealogical',
166 972 => 'genealogical',
167 973 => 'genealogical',
169 1003 => 'genealogical',
170 1004 => 'genealogical' # check for transp
175 my @all_variant_ranks = sort { $a <=> $b } keys( %expected );
176 # Look through the results
177 my $c = $tradition->collation;
179 my $results = run_analysis( $tradition, %analysis_opts );
181 foreach my $row ( @{$results->{'variants'}} ) {
182 push( @analyzed, $row->{id} );
183 $num_readings{$row->{id}} = scalar @{$row->{'readings'}};
184 my $type = 'genealogical';
185 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
187 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
190 my $expected = $expected{$row->{'id'}};
191 $expected = 'genealogical' if $expected eq 'type1';
192 is( $type, $expected, "Got expected genealogical result for rank " . $row->{'id'} );
193 # If the row is genealogical, there should be one reading with no parents,
194 # every reading should independently occur exactly once, and the total
195 # number of changes + maybe-changes should equal the total number of
196 # readings who have that one as a parent.
197 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
198 next if exists $row->{'unsolved'};
199 if( $row->{'genealogical'} ) {
200 # Make the mapping of parent -> child readings
203 foreach my $rdg ( @{$row->{'readings'}} ) {
204 my $parents = $rdg->{'source_parents'} || {};
205 foreach my $p ( keys %$parents ) {
206 push( @{$is_parent{$p}}, $rdg->{'readingid'} );
208 push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
211 foreach my $rdg ( @{$row->{'readings'}} ) {
212 is( @{$rdg->{'independent_occurrence'}}, 1,
213 "Genealogical reading originates exactly once" );
215 is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
218 # Check that run_analysis ran an analysis on all our known variant ranks
219 is_deeply( \@all_variant_ranks, \@analyzed, "Ran analysis for all expected rows" );
221 # Now run it again, excluding type 1 variants.
222 map { delete $expected{$_} if $expected{$_} eq 'type1' } keys %expected;
223 my @useful_variant_ranks = sort { $a <=> $b } keys( %expected );
224 $analysis_opts{'exclude_type1'} = 1;
226 $results = run_analysis( $tradition, %analysis_opts );
227 foreach my $row ( @{$results->{'variants'}} ) {
228 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
229 next if exists $row->{'unsolved'};
230 push( @analyzed, $row->{id} );
231 my $type = 'genealogical';
232 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
234 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
237 is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on exclude_type1 run for rank " . $row->{'id'} );
239 is_deeply( \@analyzed, \@useful_variant_ranks, "Ran analysis for all useful rows" );
241 # Now run it again, excluding orthography / spelling.
242 my @merged_exclude = qw/ 76 136 142 155 293 317 319 335 350 361 413 500 515 636 685
244 # 205 now conflicts; it and 493 should also have one fewer reading
245 $expected{205} = 'conflict';
246 $num_readings{205}--;
247 $num_readings{493}--;
248 map { delete $expected{$_} } @merged_exclude;
249 my @merged_remaining = sort { $a <=> $b } keys( %expected );
250 $analysis_opts{'merge_types'} = [ qw/ orthographic spelling / ];
252 $results = run_analysis( $tradition, %analysis_opts );
253 foreach my $row ( @{$results->{'variants'}} ) {
254 push( @analyzed, $row->{id} );
255 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
256 next if exists $row->{'unsolved'};
257 my $type = 'genealogical';
258 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
260 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
263 is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on merge_types run for rank " . $row->{'id'} );
264 is( scalar @{$row->{'readings'}}, $num_readings{$row->{id}}, "Got expected number of readings during merge" );
266 is_deeply( \@analyzed, \@merged_remaining, "Ran analysis for all useful unmerged rows" );