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;
   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 $m = Text::Tradition::StemmaUtil::_make_character_matrix( $c->make_alignment_table() );
  34  ## check number of rows
  35 is( scalar @$m, 3, "Found three witnesses in char matrix" );
  36  ## check number of columns
  37 is( scalar( @{$m->[0]} ), 19, "Found 18 rows plus sigla in char matrix" );
  38  ## check matrix
  39 my %expected = (
  40         'A' => 'AAAAAAAXAAAAAAAAAA',
  41         'B' => 'AXXXAAAAAABABAABAA',
  42         'C' => 'AXXXAAAAABAAAAAXBB',
  43         );
  44 my @wits = map { shift @$_; } @$m;
  45 map { s/\s+//g } @wits;
  46 foreach my $i ( 0 .. $#wits ) {
  47         my $w = $wits[$i];
  48         is( join( '', @{$m->[$i]} ), $expected{$w}, "Row for witness $w is correct" );
  49 }
  50
  51 # Test that pars runs
  52 SKIP: {
  53     skip "pars not in path", 3 unless File::Which::which('pars');
  54     my( $status, $tree ) = $stemma->run_phylip_pars();
  55     ok( $status, "pars ran successfully" );
  56     print STDERR "Error was $tree\n" unless $status;
  57
  58     # Test that we get a tree
  59     is( scalar @{$stemma->distance_trees}, 1, "Got a single tree" );
  60     # Test that the tree has all our witnesses
  61     $tree = $stemma->distance_trees->[0];
  62     my @leaves = grep { $tree->degree( $_ ) == 1 } $tree->vertices;
  63     is( scalar @leaves, 3, "All witnesses in the tree" );
  64 }
  65
  66 # Test our dot output
  67 my $display = $stemma->as_dot();
  68 ok( $display =~ /digraph/, "Got a dot display graph" );
  69 ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
  70 # Test our editable output
  71 my $editable = $stemma->editable();
  72 ok( $editable =~ /digraph/, "Got a dot edit graph" );
  73 ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
  74
  75 done_testing();