1 package Text::Tradition::Stemma;
5 use IPC::Run qw/ run /;
7 use Text::Tradition::Collation::Position;
11 isa => 'Text::Tradition::Collation',
15 has character_matrix => (
17 isa => 'ArrayRef[ArrayRef[Str]]',
18 writer => '_save_character_matrix',
19 predicate => 'has_character_matrix',
22 sub make_character_matrix {
24 unless( $self->collation->linear ) {
25 warn "Need a linear graph in order to make an alignment table";
28 my $table = $self->collation->make_alignment_table;
29 # Push the names of the witnesses to initialize the rows of the matrix.
30 my @matrix = map { [ $self->_normalize_ac( $_ ) ] } @{$table->[0]};
32 foreach my $token_index ( 1 .. $#{$table} ) {
33 # First implementation: make dumb alignment table, caring about
34 # nothing except which reading is in which position.
35 my @chars = convert_characters( $table->[$token_index] );
36 foreach my $idx ( 0 .. $#matrix ) {
37 push( @{$matrix[$idx]}, $chars[$idx] );
40 $self->_save_character_matrix( \@matrix );
44 my( $self, $witname ) = @_;
45 my $ac = $self->collation->ac_label;
46 if( $witname =~ /(.*)\Q$ac\E$/ ) {
47 $witname = $1 . '_ac';
49 return sprintf( "%-10s", $witname );
52 sub convert_characters {
54 # This is a simple algorithm that treats every reading as different.
55 # Eventually we will want to be able to specify how relationships
56 # affect the character matrix.
57 my %unique = ( '__UNDEF__' => 'X',
61 foreach my $word ( @$row ) {
62 if( $word && !exists $unique{$word} ) {
63 $unique{$word} = chr( 65 + $ctr );
67 if( scalar( keys %unique ) > 8 ) {
68 warn "Have more than 8 variants on this location; pars will break";
70 my @chars = map { $_ ? $unique{$_} : $unique{'__UNDEF__' } } @$row;
76 $self->make_character_matrix unless $self->has_character_matrix;
78 my $rows = scalar @{$self->character_matrix};
79 my $columns = scalar @{$self->character_matrix->[0]} - 1;
80 $matrix .= "\t$rows\t$columns\n";
81 foreach my $row ( @{$self->character_matrix} ) {
82 $matrix .= join( '', @$row ) . "\n";
90 # Set up a temporary directory for all the default Phylip files.
91 my $phylip_dir = File::Temp->newdir();
92 print STDERR $phylip_dir . "\n";
93 # $phylip_dir->unlink_on_destroy(0);
94 # We need an infile, and we need a command input file.
95 open( MATRIX, ">$phylip_dir/infile" ) or die "Could not write $phylip_dir/infile";
96 print MATRIX $self->pars_input();
99 open( CMD, ">$phylip_dir/cmdfile" ) or die "Could not write $phylip_dir/cmdfile";
100 ## TODO any configuration parameters we want to set here
101 # U Search for best tree? Yes
102 # S Search option? More thorough search
103 # V Number of trees to save? 100
104 # J Randomize input order of species? No. Use input order
105 # O Outgroup root? No, use as outgroup species 1
106 # T Use Threshold parsimony? No, use ordinary parsimony
107 # W Sites weighted? No
108 # M Analyze multiple data sets? No
109 # I Input species interleaved? Yes
110 # 0 Terminal type (IBM PC, ANSI, none)? ANSI
111 # 1 Print out the data at start of run No
112 # 2 Print indications of progress of run Yes
113 # 3 Print out tree Yes
114 # 4 Print out steps in each site No
115 # 5 Print character at all nodes of tree No
116 # 6 Write out trees onto tree file? Yes
120 # And then we run the program.
122 my $PHYLIP_PATH = '/Users/tla/Projects/phylip-3.69/exe';
123 my $program = "pars";
124 if( $^O eq 'darwin' ) {
125 $program = "$PHYLIP_PATH/$program.app/Contents/MacOS/$program";
127 $program = "$PHYLIP_PATH/$program";
131 # We need to run it in our temporary directory where we have created
132 # all the expected files.
133 local $CWD = $phylip_dir;
134 my @cmd = ( $program );
135 run \@cmd, '<', 'cmdfile', '>', '/dev/null';
137 # Now our output should be in 'outfile' and our tree in 'outtree',
138 # both in the temp directory.
141 if( -f "$phylip_dir/outtree" ) {
142 open( TREE, "$phylip_dir/outtree" ) or die "Could not open outtree for read";
146 return( 1, join( '', @outtree ) ) if @outtree;
149 if( -f "$phylip_dir/outfile" ) {
150 open( OUTPUT, "$phylip_dir/outfile" ) or die "Could not open output for read";
154 push( @error, "Neither outtree nor output file was produced!" );
156 return( undef, join( '', @error ) );
160 __PACKAGE__->meta->make_immutable;