Merge branch 'master' of github.com:tla/stemmatology
[scpubgit/stemmatology.git] / t / stemma.t
CommitLineData
6f4946fb 1#!/usr/bin/perl
2
3use strict; use warnings;
457b1620 4use File::Which;
6f4946fb 5use Test::More;
6use lib 'lib';
7use Text::Tradition;
9457207b 8use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
6f4946fb 9use XML::LibXML;
10use XML::LibXML::XPathContext;
11
12my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data
13
7035e3a6 14my $tradition = Text::Tradition->new(
15 'name' => 'inline',
16 'input' => 'CollateX',
17 'file' => $datafile,
18 );
7a7c249c 19# Set up some relationships
20my $c = $tradition->collation;
21$c->add_relationship( 'n25', 'n26', { 'type' => 'spelling' } );
22$c->add_relationship( 'n9', 'n23', { 'type' => 'spelling' } );
23$c->add_relationship( 'n8', 'n13', { 'type' => 'spelling' } );
24$c->calculate_ranks();
25
9ba651b9 26my $stemma = $tradition->add_stemma( dotfile => 't/data/simple.dot' );
6f4946fb 27
28# Test for object creation
29ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' );
7a7c249c 30is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" );
6f4946fb 31
32# Test for character matrix creation
1dd07bda 33my $mstr = character_input( $c->alignment_table() );
6f4946fb 34 ## check number of rows
9457207b 35my @mlines = split( "\n", $mstr );
36my $msig = shift @mlines;
37my( $rows, $chars ) = $msig =~ /(\d+)\s+(\d+)/;
38is( $rows, 3, "Found three witnesses in char matrix" );
b02332ca 39 ## check number of columns
9457207b 40is( $chars, 18, "Found 18 rows plus sigla in char matrix" );
b02332ca 41 ## check matrix
42my %expected = (
43 'A' => 'AAAAAAAXAAAAAAAAAA',
44 'B' => 'AXXXAAAAAABABAABAA',
45 'C' => 'AXXXAAAAABAAAAAXBB',
46 );
9457207b 47foreach my $ml ( @mlines ) {
48 my( $wit, $chars ) = split( /\s+/, $ml );
49 is( $chars, $expected{$wit}, "Row for witness $wit is correct" );
b02332ca 50}
6f4946fb 51
52# Test that pars runs
457b1620 53SKIP: {
0f5d05c6 54 skip "pars not in path", 3 unless File::Which::which('pars');
9457207b 55 my $newick = phylip_pars( $mstr );
56 ok( $newick, "pars ran successfully" );
57
58 my $trees = parse_newick( $newick );
457b1620 59 # Test that we get a tree
9457207b 60 is( scalar @$trees, 1, "Got a single tree" );
457b1620 61 # Test that the tree has all our witnesses
9457207b 62 my $tree = $trees->[0];
457b1620 63 my @leaves = grep { $tree->degree( $_ ) == 1 } $tree->vertices;
64 is( scalar @leaves, 3, "All witnesses in the tree" );
65}
7a7c249c 66
67# Test our dot output
68my $display = $stemma->as_dot();
69ok( $display =~ /digraph/, "Got a dot display graph" );
70ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
71# Test our editable output
72my $editable = $stemma->editable();
73ok( $editable =~ /digraph/, "Got a dot edit graph" );
74ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
7035e3a6 75
457b1620 76done_testing();