t/stemma.t

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