1 package Text::Tradition::Stemma;
5 use IPC::Run qw/ run /;
7 use Text::Tradition::Collation::Position;
9 use Graph::Reader::Dot;
13 isa => 'Text::Tradition::Collation',
17 has character_matrix => (
19 isa => 'ArrayRef[ArrayRef[Str]]',
20 writer => '_save_character_matrix',
21 predicate => 'has_character_matrix',
27 predicate => 'has_graph',
36 my( $self, $args ) = @_;
37 # If we have been handed a dotfile, initialize it into a graph.
38 if( exists $args->{'dot'} ) {
39 my $reader = Graph::Reader::Dot->new();
40 my $graph = $reader->read_graph( $args->{'dot'} );
42 ? $self->graph( $graph )
43 : warn "Failed to parse dot file " . $args->{'dot'};
46 # If we have a graph, calculate all the shortest paths between nodes,
47 # disregarding direction.
48 if( $self->has_graph ) {
50 if( $self->graph->is_directed ) {
51 # Make an undirected version.
52 $undirected = Graph->new( 'undirected' => 1 );
53 foreach my $v ( $self->graph->vertices ) {
54 $undirected->add_vertex( $v );
56 foreach my $e ( $self->graph->edges ) {
57 $undirected->add_edge( @$e );
60 $undirected = $self->graph;
62 $self->apsp( $undirected->APSP_Floyd_Warshall() );
67 sub make_character_matrix {
69 unless( $self->collation->linear ) {
70 warn "Need a linear graph in order to make an alignment table";
73 my $table = $self->collation->make_alignment_table;
74 # Push the names of the witnesses to initialize the rows of the matrix.
75 my @matrix = map { [ $self->_normalize_ac( $_ ) ] } @{$table->[0]};
77 foreach my $token_index ( 1 .. $#{$table} ) {
78 # First implementation: make dumb alignment table, caring about
79 # nothing except which reading is in which position.
80 my @chars = convert_characters( $table->[$token_index] );
81 foreach my $idx ( 0 .. $#matrix ) {
82 push( @{$matrix[$idx]}, $chars[$idx] );
85 $self->_save_character_matrix( \@matrix );
89 my( $self, $witname ) = @_;
90 my $ac = $self->collation->ac_label;
91 if( $witname =~ /(.*)\Q$ac\E$/ ) {
92 $witname = $1 . '_ac';
94 return sprintf( "%-10s", $witname );
97 sub convert_characters {
99 # This is a simple algorithm that treats every reading as different.
100 # Eventually we will want to be able to specify how relationships
101 # affect the character matrix.
102 my %unique = ( '__UNDEF__' => 'X',
106 foreach my $word ( @$row ) {
107 if( $word && !exists $unique{$word} ) {
108 $unique{$word} = chr( 65 + $ctr );
112 if( scalar( keys %unique ) > 8 ) {
113 warn "Have more than 8 variants on this location; pars will break";
115 my @chars = map { $_ ? $unique{$_} : $unique{'__UNDEF__' } } @$row;
121 $self->make_character_matrix unless $self->has_character_matrix;
123 my $rows = scalar @{$self->character_matrix};
124 my $columns = scalar @{$self->character_matrix->[0]} - 1;
125 $matrix .= "\t$rows\t$columns\n";
126 foreach my $row ( @{$self->character_matrix} ) {
127 $matrix .= join( '', @$row ) . "\n";
135 # Set up a temporary directory for all the default Phylip files.
136 my $phylip_dir = File::Temp->newdir();
137 print STDERR $phylip_dir . "\n";
138 # $phylip_dir->unlink_on_destroy(0);
139 # We need an infile, and we need a command input file.
140 open( MATRIX, ">$phylip_dir/infile" ) or die "Could not write $phylip_dir/infile";
141 print MATRIX $self->pars_input();
144 open( CMD, ">$phylip_dir/cmdfile" ) or die "Could not write $phylip_dir/cmdfile";
145 ## TODO any configuration parameters we want to set here
146 # U Search for best tree? Yes
147 # S Search option? More thorough search
148 # V Number of trees to save? 100
149 # J Randomize input order of species? No. Use input order
150 # O Outgroup root? No, use as outgroup species 1
151 # T Use Threshold parsimony? No, use ordinary parsimony
152 # W Sites weighted? No
153 # M Analyze multiple data sets? No
154 # I Input species interleaved? Yes
155 # 0 Terminal type (IBM PC, ANSI, none)? ANSI
156 # 1 Print out the data at start of run No
157 # 2 Print indications of progress of run Yes
158 # 3 Print out tree Yes
159 # 4 Print out steps in each site No
160 # 5 Print character at all nodes of tree No
161 # 6 Write out trees onto tree file? Yes
165 # And then we run the program.
167 my $PHYLIP_PATH = '/Users/tla/Projects/phylip-3.69/exe';
168 my $program = "pars";
169 if( $^O eq 'darwin' ) {
170 $program = "$PHYLIP_PATH/$program.app/Contents/MacOS/$program";
172 $program = "$PHYLIP_PATH/$program";
176 # We need to run it in our temporary directory where we have created
177 # all the expected files.
178 local $CWD = $phylip_dir;
179 my @cmd = ( $program );
180 run \@cmd, '<', 'cmdfile', '>', '/dev/null';
182 # Now our output should be in 'outfile' and our tree in 'outtree',
183 # both in the temp directory.
186 if( -f "$phylip_dir/outtree" ) {
187 open( TREE, "$phylip_dir/outtree" ) or die "Could not open outtree for read";
191 return( 1, join( '', @outtree ) ) if @outtree;
194 if( -f "$phylip_dir/outfile" ) {
195 open( OUTPUT, "$phylip_dir/outfile" ) or die "Could not open output for read";
199 push( @error, "Neither outtree nor output file was produced!" );
201 return( undef, join( '', @error ) );
205 __PACKAGE__->meta->make_immutable;