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
39 155 => 'genealogical',
40 170 => 'genealogical',
42 205 => 'genealogical',
43 219 => 'genealogical',
44 239 => 'genealogical',
45 244 => 'genealogical',
47 251 => 'genealogical',
48 252 => 'genealogical',
49 293 => 'genealogical',
50 295 => 'genealogical',
51 309 => 'genealogical',
56 318 => 'genealogical',
57 319 => 'genealogical',
61 335 => 'genealogical',
68 406 => 'genealogical',
69 413 => 'genealogical',
73 493 => 'genealogical',
83 632 => 'genealogical',
84 634 => 'genealogical',
85 636 => 'genealogical',
86 685 => 'genealogical',
87 737 => 'genealogical',
98 780 => 'genealogical',
102 837 => 'genealogical',
159 925 => 'genealogical',
161 952 => 'genealogical',
162 954 => 'genealogical',
163 969 => 'genealogical',
164 972 => 'genealogical',
165 973 => 'genealogical',
167 1003 => 'genealogical',
168 1004 => 'genealogical' # check for transp
173 my @all_variant_ranks = sort { $a <=> $b } keys( %expected );
174 # Look through the results
175 my $c = $tradition->collation;
177 my $results = run_analysis( $tradition, %analysis_opts );
179 foreach my $row ( @{$results->{'variants'}} ) {
180 push( @analyzed, $row->{id} );
181 $num_readings{$row->{id}} = scalar @{$row->{'readings'}};
182 my $type = 'genealogical';
183 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
185 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
188 my $expected = $expected{$row->{'id'}};
189 $expected = 'genealogical' if $expected eq 'type1';
190 is( $type, $expected, "Got expected genealogical result for rank " . $row->{'id'} );
191 # If the row is genealogical, there should be one reading with no parents,
192 # every reading should independently occur exactly once, and the total
193 # number of changes + maybe-changes should equal the total number of
194 # readings who have that one as a parent.
195 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
196 next if exists $row->{'unsolved'};
197 if( $row->{'genealogical'} ) {
198 # Make the mapping of parent -> child readings
201 foreach my $rdg ( @{$row->{'readings'}} ) {
202 my $parents = $rdg->{'source_parents'} || {};
203 foreach my $p ( keys %$parents ) {
204 push( @{$is_parent{$p}}, $rdg->{'readingid'} );
206 push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
209 foreach my $rdg ( @{$row->{'readings'}} ) {
210 is( @{$rdg->{'independent_occurrence'}}, 1,
211 "Genealogical reading originates exactly once" );
213 is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
216 # Check that run_analysis ran an analysis on all our known variant ranks
217 is_deeply( \@all_variant_ranks, \@analyzed, "Ran analysis for all expected rows" );
219 # Now run it again, excluding type 1 variants.
220 map { delete $expected{$_} if $expected{$_} eq 'type1' } keys %expected;
221 my @useful_variant_ranks = sort { $a <=> $b } keys( %expected );
222 $analysis_opts{'exclude_type1'} = 1;
224 $results = run_analysis( $tradition, %analysis_opts );
225 foreach my $row ( @{$results->{'variants'}} ) {
226 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
227 next if exists $row->{'unsolved'};
228 push( @analyzed, $row->{id} );
229 my $type = 'genealogical';
230 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
232 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
235 is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on exclude_type1 run for rank " . $row->{'id'} );
237 is_deeply( \@analyzed, \@useful_variant_ranks, "Ran analysis for all useful rows" );
239 # Now run it again, excluding orthography / spelling.
240 my @merged_exclude = qw/ 76 136 142 155 293 317 319 335 350 361 413 500 515 636 685
242 # 205 now conflicts; it and 493 should also have one fewer reading
243 $expected{205} = 'conflict';
244 $num_readings{205}--;
245 $num_readings{493}--;
246 map { delete $expected{$_} } @merged_exclude;
247 my @merged_remaining = sort { $a <=> $b } keys( %expected );
248 $analysis_opts{'merge_types'} = [ qw/ orthographic spelling / ];
250 $results = run_analysis( $tradition, %analysis_opts );
251 foreach my $row ( @{$results->{'variants'}} ) {
252 push( @analyzed, $row->{id} );
253 ok( !exists $row->{'unsolved'}, "Got a solution for the stated problem" );
254 next if exists $row->{'unsolved'};
255 my $type = 'genealogical';
256 if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
258 } elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
261 is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on merge_types run for rank " . $row->{'id'} );
262 is( scalar @{$row->{'readings'}}, $num_readings{$row->{id}}, "Got expected number of readings during merge" );
264 is_deeply( \@analyzed, \@merged_remaining, "Ran analysis for all useful unmerged rows" );