X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstemma.t;h=404b686bbeab8a9368c0fd1e9fbc0aaf6b1696bb;hb=ab06f3edf9045dc9a24ee138df7ae0b9bb141098;hp=6f3e7dbd54fb9106b1af90a0d6a23b40888f3cf5;hpb=68454b71e5a66972515258d6312f6355ee0536f4;p=scpubgit%2Fstemmatology.git diff --git a/t/stemma.t b/t/stemma.t index 6f3e7db..404b686 100644 --- a/t/stemma.t +++ b/t/stemma.t @@ -5,7 +5,7 @@ use File::Which; use Test::More; use lib 'lib'; use Text::Tradition; -use Text::Tradition::StemmaUtil qw/ phylip_pars_input /; +use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /; use XML::LibXML; use XML::LibXML::XPathContext; @@ -18,53 +18,48 @@ my $tradition = Text::Tradition->new( ); # Set up some relationships my $c = $tradition->collation; -$c->add_relationship( 'n25', 'n26', { 'type' => 'spelling' } ); -$c->add_relationship( 'n9', 'n23', { 'type' => 'spelling' } ); -$c->add_relationship( 'n8', 'n13', { 'type' => 'spelling' } ); +$c->add_relationship( 'n23', 'n24', { 'type' => 'spelling' } ); +$c->add_relationship( 'n9', 'n10', { 'type' => 'spelling' } ); +$c->add_relationship( 'n12', 'n13', { 'type' => 'spelling' } ); $c->calculate_ranks(); -my $stemma = $tradition->add_stemma( 't/data/simple.dot' ); +my $stemma = $tradition->add_stemma( dotfile => 't/data/simple.dot' ); # Test for object creation ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' ); is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" ); # Test for character matrix creation -my $m = phylip_pars_input( $c->make_alignment_table() ); +my $mstr = character_input( $c->alignment_table() ); ## check number of rows -my $expected = "\t3\t18\n"; -$expected .= 'A AAAAAAAXAAAAAAAAAA -B AXXXAAAAAABABAABAA -C AXXXAAAAABAAAAAXBB'; -$expected .= "\n"; -is( $m, $expected, "Got the right pars input" ); -# is( scalar @$m, 3, "Found three witnesses in char matrix" ); -# ## check number of columns -# is( scalar( @{$m->[0]} ), 19, "Found 18 rows plus sigla in char matrix" ); -# ## check matrix -# my %expected = ( -# 'A' => 'AAAAAAAXAAAAAAAAAA', -# 'B' => 'AXXXAAAAAABABAABAA', -# 'C' => 'AXXXAAAAABAAAAAXBB', -# ); -# my @wits = map { shift @$_; } @$m; -# map { s/\s+//g } @wits; -# foreach my $i ( 0 .. $#wits ) { -# my $w = $wits[$i]; -# is( join( '', @{$m->[$i]} ), $expected{$w}, "Row for witness $w is correct" ); -# } +my @mlines = split( "\n", $mstr ); +my $msig = shift @mlines; +my( $rows, $chars ) = $msig =~ /(\d+)\s+(\d+)/; +is( $rows, 3, "Found three witnesses in char matrix" ); + ## check number of columns +is( $chars, 18, "Found 18 rows plus sigla in char matrix" ); + ## check matrix +my %expected = ( + 'A' => 'AAAAAAAXAAAAAAAAAA', + 'B' => 'AXXXAAAAAABABAABAA', + 'C' => 'AXXXAAAAABAAAAAXBB', + ); +foreach my $ml ( @mlines ) { + my( $wit, $chars ) = split( /\s+/, $ml ); + is( $chars, $expected{$wit}, "Row for witness $wit is correct" ); +} # Test that pars runs SKIP: { skip "pars not in path", 3 unless File::Which::which('pars'); - my( $status, $tree ) = $stemma->run_phylip_pars(); - ok( $status, "pars ran successfully" ); - print STDERR "Error was $tree\n" unless $status; - + my $newick = phylip_pars( $mstr ); + ok( $newick, "pars ran successfully" ); + + my $trees = parse_newick( $newick ); # Test that we get a tree - is( scalar @{$stemma->distance_trees}, 1, "Got a single tree" ); + is( scalar @$trees, 1, "Got a single tree" ); # Test that the tree has all our witnesses - $tree = $stemma->distance_trees->[0]; + my $tree = $trees->[0]; my @leaves = grep { $tree->degree( $_ ) == 1 } $tree->vertices; is( scalar @leaves, 3, "All witnesses in the tree" ); }