From: Tara L Andrews <tla@mit.edu>
Date: Wed, 22 Aug 2012 19:57:15 +0000 (+0200)
Subject: make tests work for the interim
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e6823346f0ad469b49c70264c14fd153ba1c432a;p=scpubgit%2Fstemmatology.git

make tests work for the interim
---

diff --git a/t/analysis.t b/t/analysis.t
index 3d48eff..63e5fb1 100755
--- a/t/analysis.t
+++ b/t/analysis.t
@@ -20,131 +20,243 @@ $tradition->add_stemma( 'dotfile' => 't/data/besoin.dot' );
 # Run the analysis of the tradition
 ## TODO Make proper test db
 my $calcdsn = 'dbi:SQLite:dbname=t/data/analysis.db';
-my $results = run_analysis( $tradition, calcdsn => $calcdsn );
 
 my %expected = (
-    3 => 1,
-    28 => 1,
-    39 => 1,
-    73 => '',
-    76 => 1,
-    91 => '',
-    93 => 1,
-    94 => 1,
-    99 => '',
-    136 => '',
-    142 => '',
-    155 => 1,
-    170 => 1,
-    205 => 1,
-    219 => 1,
-    239 => 1,
-    244 => 1,
-    251 => 1,
-    252 => 1,
-    293 => 1,
-    295 => 1,
-    309 => 1,
-    317 => '',
-    318 => 1,
-    319 => 1,
-    328 => '',
-    335 => 1,
-    350 => '',
-    361 => '',
-    382 => '',
-    385 => '',
-    406 => 1,
-    413 => 1,
-    418 => '',
-    493 => 1,
-    497 => '',
-    500 => '',
-    515 => '',
-    558 => '',
-    632 => 1,
-    634 => 1,
-    636 => 1,
-    685 => 1,
-    737 => 1,
-    742 => '',
-    743 => '',
-    744 => '',
-    777 => '',
-    780 => 1,
-    837 => 1,
-    897 => '',
-    898 => '',
-    925 => 1,
-    952 => 1,
-    954 => 1,
-    969 => 1,
-    972 => 1,
-    973 => 1,
-    1003 => 1,
-    1004 => 1,
-    1013 => 1,
+    2 => 'type1',
+    3 => 'genealogical',
+    28 => 'genealogical',
+    39 => 'genealogical',
+    62 => 'type1',
+    63 => 'type1',
+    73 => 'reverted',
+    76 => 'genealogical',
+    91 => 'conflict',
+    93 => 'genealogical',
+    94 => 'genealogical',
+    99 => 'reverted',
+    110 => 'type1',
+    117 => 'type1',
+    136 => 'reverted',
+    142 => 'conflict',
+    155 => 'genealogical',
+    170 => 'genealogical',
+    182 => 'type1',
+    205 => 'genealogical',
+    219 => 'genealogical',
+    239 => 'genealogical',
+    244 => 'genealogical',
+    245 => 'type1',
+    251 => 'genealogical',
+    252 => 'genealogical',
+    293 => 'genealogical',
+    295 => 'genealogical',
+    309 => 'genealogical',
+    310 => 'type1',
+    314 => 'type1',
+    315 => 'type1',
+    317 => 'reverted',
+    318 => 'genealogical',
+    319 => 'genealogical',
+    324 => 'type1',
+    328 => 'reverted',
+    334 => 'type1',
+    335 => 'genealogical',
+    350 => 'reverted',
+    361 => 'reverted',
+    367 => 'type1',
+    370 => 'type1',
+    382 => 'reverted',
+    385 => 'reverted',
+    406 => 'genealogical',
+    413 => 'genealogical',
+    417 => 'type1',
+    418 => 'reverted',
+    459 => 'type1',
+    493 => 'genealogical',
+    497 => 'reverted',
+    499 => 'type1',
+    500 => 'reverted',
+    515 => 'reverted',
+    556 => 'type1',
+    558 => 'conflict',
+    597 => 'type1',
+    615 => 'type1',
+    617 => 'type1',
+    632 => 'genealogical',
+    634 => 'genealogical',
+    636 => 'genealogical',
+    685 => 'genealogical',
+    737 => 'genealogical',
+    742 => 'reverted',
+    743 => 'reverted',
+    744 => 'reverted',
+    745 => 'type1',
+    746 => 'type1',
+    747 => 'type1',
+    757 => 'type1',
+    762 => 'type1',
+    763 => 'type1',
+    777 => 'reverted',
+    780 => 'genealogical',
+    802 => 'type1',
+    803 => 'type1',
+    815 => 'type1',
+    837 => 'genealogical',
+    854 => 'type1',
+    855 => 'type1',
+    856 => 'type1',
+    857 => 'type1',
+    858 => 'type1',
+    859 => 'type1',
+    860 => 'type1',
+    861 => 'type1',
+    862 => 'type1',
+    863 => 'type1',
+    864 => 'type1',
+    865 => 'type1',
+    866 => 'type1',
+    867 => 'type1',
+    868 => 'type1',
+    869 => 'type1',
+    870 => 'type1',
+    871 => 'type1',
+    872 => 'type1',
+    873 => 'type1',
+    874 => 'type1',
+    875 => 'type1',
+    876 => 'type1',
+    877 => 'type1',
+    878 => 'type1',
+    879 => 'type1',
+    880 => 'type1',
+    881 => 'type1',
+    882 => 'type1',
+    883 => 'type1',
+    884 => 'type1',
+    885 => 'type1',
+    886 => 'type1',
+    887 => 'type1',
+    888 => 'type1',
+    889 => 'type1',
+    890 => 'type1',
+    891 => 'type1',
+    892 => 'type1',
+    893 => 'type1',
+    894 => 'type1',
+    895 => 'type1',
+    896 => 'type1',
+    897 => 'conflict',
+    898 => 'conflict',
+    899 => 'type1',
+    900 => 'type1',
+    901 => 'type1',
+    902 => 'type1',
+    903 => 'type1',
+    904 => 'type1',
+    905 => 'type1',
+    906 => 'type1',
+    907 => 'type1',
+    915 => 'type1',
+    916 => 'type1',
+    925 => 'genealogical',
+    927 => 'type1',
+    952 => 'genealogical',
+    954 => 'genealogical',
+    969 => 'genealogical',
+    972 => 'genealogical',
+    973 => 'genealogical',
+    974 => 'type1',
+    1003 => 'genealogical',
+    1004 => 'genealogical' # check for transp
 );
 
+my %num_readings;
+
+my @all_variant_ranks = sort { $a <=> $b } keys( %expected );
 # Look through the results
-my $display = $ARGV[0];
 my $c = $tradition->collation;
+my %analysis_opts = ( calcdsn => $calcdsn );
+my $results = run_analysis( $tradition, %analysis_opts );
+my @analyzed;
 foreach my $row ( @{$results->{'variants'}} ) {
-	if( $display ) {
-		say sprintf( "=== Looking at rank %d (%s) ===", $row->{'id'},
-			$row->{'genealogical'} ? 'genealogical' : 'not genealogical' );
+	push( @analyzed, $row->{id} );
+	$num_readings{$row->{id}} = scalar @{$row->{'readings'}};
+	my $type = 'genealogical';
+	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
+		$type = 'conflict';
+	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
+		$type = 'reverted';
+	}
+	my $expected = $expected{$row->{'id'}};
+	$expected = 'genealogical' if $expected eq 'type1';
+	is( $type, $expected, "Got expected genealogical result for rank " . $row->{'id'} );
+	# If the row is genealogical, there should be one reading with no parents,
+	# every reading should independently occur exactly once, and the total
+	# number of changes + maybe-changes should equal the total number of
+	# readings who have that one as a parent.
+	if( $row->{'genealogical'} ) {
+		# Make the mapping of parent -> child readings
+		my %is_parent;
+		my @has_no_parent;
 		foreach my $rdg ( @{$row->{'readings'}} ) {
-			my $parents = $rdg->{'source_parents'};
-			say sprintf( "Reading %s: %s", $rdg->{'readingid'}, 
-				$rdg->{'conflict'} ? '(conflicted)' : '' );
-			if( $parents && @$parents ) {
-				say "\tParent reading(s) " . join( ', ', @$parents );
-				foreach my $p ( @$parents ) {
-					# Is there a relationship here?
-					my $rel = $c->get_relationship( $rdg->{'readingid'}, $p );
-					if( $rel ) {
-						say sprintf( "\t* Relationship %s %s to parent %s",
-							$rel->type, 
-							$rel->annotation ? '('.$rel->annotation.')' : '', 
-							$p );
-					}
-				}
+			my $parents = $rdg->{'source_parents'} || {};
+			foreach my $p ( keys %$parents ) {
+				push( @{$is_parent{$p}}, $rdg->{'readingid'} );
 			}
-			say sprintf( "\t%d independent, %d followed, %d changed, %d unknown",
-				$rdg->{'independent_occurrence'}, $rdg->{'followed'}, 
-				$rdg->{'not_followed'}, $rdg->{'follow_unknown'} );
+			push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
 		}
-	} else {
-		# If not displaying, we're testing.
-		# HACK to cope with formerly unuseful rows
-		unless( exists $expected{$row->{'id'}} ) {
-			$expected{$row->{'id'}} = 1;
-		}
-		my $gen_bool = $row->{'genealogical'} ? 1 : '';
-		is( $gen_bool, $expected{$row->{'id'}}, 
-			"Got expected genealogical result for rank " . $row->{'id'} );
-		# If the row is genealogical, there should be one reading with no parents,
-		# every reading should independently occur exactly once, and the total
-		# number of changes + maybe-changes should equal the total number of
-		# readings who have that one as a parent.
-		if( $row->{'genealogical'} ) {
-			# Make the mapping of parent -> child readings
-			my %is_parent;
-			my @has_no_parent;
-			foreach my $rdg ( @{$row->{'readings'}} ) {
-				my $parents = $rdg->{'source_parents'} || {};
-				foreach my $p ( keys %$parents ) {
-					push( @{$is_parent{$p}}, $rdg->{'readingid'} );
-				}
-				push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
-			}
-			# Test some stuff
-			foreach my $rdg ( @{$row->{'readings'}} ) {
-				is( @{$rdg->{'independent_occurrence'}}, 1, 
-					"Genealogical reading originates exactly once" );
-			}
-			is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
+		# Test some stuff
+		foreach my $rdg ( @{$row->{'readings'}} ) {
+			is( @{$rdg->{'independent_occurrence'}}, 1, 
+				"Genealogical reading originates exactly once" );
 		}
+		is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
 	}
 }
-done_testing() unless $display;
+# Check that run_analysis ran an analysis on all our known variant ranks
+is_deeply( \@all_variant_ranks, \@analyzed, "Ran analysis for all expected rows" );
+
+# Now run it again, excluding type 1 variants.
+map { delete $expected{$_} if $expected{$_} eq 'type1' } keys %expected;
+my @useful_variant_ranks = sort { $a <=> $b } keys( %expected );
+$analysis_opts{'exclude_type1'} = 1;
+@analyzed = ();
+$results = run_analysis( $tradition, %analysis_opts );
+foreach my $row ( @{$results->{'variants'}} ) {
+	push( @analyzed, $row->{id} );
+	my $type = 'genealogical';
+	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
+		$type = 'conflict';
+	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
+		$type = 'reverted';
+	}
+	is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on exclude_type1 run for rank " . $row->{'id'} );
+}
+is_deeply( \@analyzed, \@useful_variant_ranks, "Ran analysis for all useful rows" );
+
+# Now run it again, excluding orthography / spelling.
+my @merged_exclude = qw/ 76 136 142 155 293 317 319 335 350 361 413 500 515 636 685 
+	737 954 1003 /;
+# 205 now conflicts; it and 493 should also have one fewer reading
+$expected{205} = 'conflict';
+$num_readings{205}--;
+$num_readings{493}--;
+map { delete $expected{$_} } @merged_exclude;
+my @merged_remaining = sort { $a <=> $b } keys( %expected );
+$analysis_opts{'merge_types'} = [ qw/ orthographic spelling / ];
+@analyzed = ();
+$results = run_analysis( $tradition, %analysis_opts );
+foreach my $row ( @{$results->{'variants'}} ) {
+	push( @analyzed, $row->{id} );
+	my $type = 'genealogical';
+	if( grep { $_->{'is_conflict'} } @{$row->{'readings'}} ) {
+		$type = 'conflict';
+	} elsif( grep { $_->{'is_reverted'} } @{$row->{'readings'}} ) {
+		$type = 'reverted';
+	}
+	is( $type, $expected{$row->{'id'}}, "Got expected genealogical result on merge_types run for rank " . $row->{'id'} );
+	is( scalar @{$row->{'readings'}}, $num_readings{$row->{id}}, "Got expected number of readings during merge" );
+}
+is_deeply( \@analyzed, \@merged_remaining, "Ran analysis for all useful unmerged rows" );
+
+done_testing();
diff --git a/t/data/analysis.db b/t/data/analysis.db
index be56bad..ce18ac5 100644
Binary files a/t/data/analysis.db and b/t/data/analysis.db differ