Commit | Line | Data |
6f4946fb |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; use warnings; |
457b1620 |
4 | use File::Which; |
6f4946fb |
5 | use Test::More; |
6 | use lib 'lib'; |
7 | use Text::Tradition; |
9457207b |
8 | use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /; |
951ddfe8 |
9 | use TryCatch; |
6f4946fb |
10 | |
11 | my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data |
12 | |
7035e3a6 |
13 | my $tradition = Text::Tradition->new( |
14 | 'name' => 'inline', |
15 | 'input' => 'CollateX', |
16 | 'file' => $datafile, |
17 | ); |
7a7c249c |
18 | # Set up some relationships |
19 | my $c = $tradition->collation; |
679f17e1 |
20 | $c->add_relationship( 'n23', 'n24', { 'type' => 'spelling' } ); |
21 | $c->add_relationship( 'n9', 'n10', { 'type' => 'spelling' } ); |
22 | $c->add_relationship( 'n12', 'n13', { 'type' => 'spelling' } ); |
7a7c249c |
23 | $c->calculate_ranks(); |
24 | |
9ba651b9 |
25 | my $stemma = $tradition->add_stemma( dotfile => 't/data/simple.dot' ); |
6f4946fb |
26 | |
27 | # Test for object creation |
28 | ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' ); |
7a7c249c |
29 | is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" ); |
6f4946fb |
30 | |
31 | # Test for character matrix creation |
a0acdb4b |
32 | my $mstr = character_input( $tradition ); |
6f4946fb |
33 | ## check number of rows |
9457207b |
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" ); |
b02332ca |
38 | ## check number of columns |
9457207b |
39 | is( $chars, 18, "Found 18 rows plus sigla in char matrix" ); |
b02332ca |
40 | ## check matrix |
41 | my %expected = ( |
42 | 'A' => 'AAAAAAAXAAAAAAAAAA', |
43 | 'B' => 'AXXXAAAAAABABAABAA', |
44 | 'C' => 'AXXXAAAAABAAAAAXBB', |
45 | ); |
9457207b |
46 | foreach my $ml ( @mlines ) { |
47 | my( $wit, $chars ) = split( /\s+/, $ml ); |
48 | is( $chars, $expected{$wit}, "Row for witness $wit is correct" ); |
b02332ca |
49 | } |
6f4946fb |
50 | |
51 | # Test that pars runs |
457b1620 |
52 | SKIP: { |
951ddfe8 |
53 | skip "pars not in path", 3 unless File::Which::which('pars'); |
54 | my $newick = phylip_pars( $mstr ); |
55 | ok( $newick, "pars ran successfully" ); |
9457207b |
56 | |
57 | my $trees = parse_newick( $newick ); |
951ddfe8 |
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" ); |
457b1620 |
63 | } |
7a7c249c |
64 | |
65 | # Test our dot output |
66 | my $display = $stemma->as_dot(); |
907f6671 |
67 | like( $display, qr/^digraph \"?Stemma/, "Got a dot display graph" ); |
7a7c249c |
68 | ok( $display !~ /hypothetical/, "Graph is display rather than edit" ); |
69 | # Test our editable output |
70 | my $editable = $stemma->editable(); |
907f6671 |
71 | like( $editable, qr/^digraph \"?Stemma/, "Got a dot edit graph" ); |
7a7c249c |
72 | ok( $editable =~ /hypothetical/, "Graph contains an edit class" ); |
1cf6dd32 |
73 | |
907f6671 |
74 | # Test changing the name of the Graph |
75 | $editable =~ s/^(digraph )\"?Stemma\"?/$1"Simple test stemma"/; |
76 | $stemma->alter_graph( $editable ); |
77 | is( $stemma->identifier, "Simple test stemma", "Successfully changed name of graph" ); |
78 | |
1cf6dd32 |
79 | # Test re-rooting of our graph |
80 | try { |
81 | $stemma->root_graph('D'); |
82 | ok( 0, "Made attempt to root stemma graph on nonexistent vertex" ); |
83 | } catch( Text::Tradition::Error $e ) { |
84 | like( $e->message, qr/Cannot orient graph(.*)on nonexistent vertex/, |
85 | "Exception raised for attempt to root graph on nonexistent vertex" ); |
86 | } |
87 | $stemma->root_graph( 'B' ); |
88 | is( $stemma->graph, '1-A,2-1,2-C,B-2', |
89 | "Stemma graph successfully re-rooted on vertex B" ); |
907f6671 |
90 | is( $stemma->identifier, "Simple test stemma", |
91 | "Stemma identifier survived re-rooting of graph" ); |
92 | |
1cf6dd32 |
93 | |
457b1620 |
94 | done_testing(); |