3 use strict; use warnings;
8 use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
11 my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data
13 my $tradition = Text::Tradition->new(
15 'input' => 'CollateX',
18 # Set up some relationships
19 my $c = $tradition->collation;
20 $c->add_relationship( 'n23', 'n24', { 'type' => 'spelling' } );
21 $c->add_relationship( 'n9', 'n10', { 'type' => 'spelling' } );
22 $c->add_relationship( 'n12', 'n13', { 'type' => 'spelling' } );
23 $c->calculate_ranks();
25 my $stemma = $tradition->add_stemma( dotfile => 't/data/simple.dot' );
27 # Test for object creation
28 ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' );
29 is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" );
31 # Test for character matrix creation
32 my $mstr = character_input( $tradition );
33 ## check number of rows
34 my @mlines = split( "\n", $mstr );
35 my $msig = shift @mlines;
36 my( $rows, $chars ) = $msig =~ /(\d+)\s+(\d+)/;
37 is( $rows, 3, "Found three witnesses in char matrix" );
38 ## check number of columns
39 is( $chars, 18, "Found 18 rows plus sigla in char matrix" );
42 'A' => 'AAAAAAAXAAAAAAAAAA',
43 'B' => 'AXXXAAAAAABABAABAA',
44 'C' => 'AXXXAAAAABAAAAAXBB',
46 foreach my $ml ( @mlines ) {
47 my( $wit, $chars ) = split( /\s+/, $ml );
48 is( $chars, $expected{$wit}, "Row for witness $wit is correct" );
53 skip "pars not in path", 3 unless File::Which::which('pars');
54 my $newick = phylip_pars( $mstr );
55 ok( $newick, "pars ran successfully" );
57 my $trees = parse_newick( $newick );
58 # Test that we get a tree
59 is( scalar @$trees, 1, "Got a single tree" );
60 # Test that the tree has all our witnesses
61 my $tree = $trees->[0];
62 is( scalar $tree->witnesses, 3, "All witnesses in the tree" );
66 my $display = $stemma->as_dot();
67 ok( $display =~ /digraph/, "Got a dot display graph" );
68 ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
69 # Test our editable output
70 my $editable = $stemma->editable();
71 ok( $editable =~ /digraph/, "Got a dot edit graph" );
72 ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
74 # Test re-rooting of our graph
76 $stemma->root_graph('D');
77 ok( 0, "Made attempt to root stemma graph on nonexistent vertex" );
78 } catch( Text::Tradition::Error $e ) {
79 like( $e->message, qr/Cannot orient graph(.*)on nonexistent vertex/,
80 "Exception raised for attempt to root graph on nonexistent vertex" );
82 $stemma->root_graph( 'B' );
83 is( $stemma->graph, '1-A,2-1,2-C,B-2',
84 "Stemma graph successfully re-rooted on vertex B" );