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' );
59 foreach my $word ( @$row ) {
60 if( $word && !exists $unique{$word} ) {
61 $unique{$word} = chr( 65 + $ctr );
65 if( scalar( keys %unique ) > 8 ) {
66 warn "Have more than 8 variants on this location; pars will break";
68 my @chars = map { $_ ? $unique{$_} : $unique{'__UNDEF__' } } @$row;
74 $self->make_character_matrix unless $self->has_character_matrix;
76 my $rows = scalar @{$self->character_matrix};
77 my $columns = scalar @{$self->character_matrix->[0]} - 1;
78 $matrix .= "\t$rows\t$columns\n";
79 foreach my $row ( @{$self->character_matrix} ) {
80 $matrix .= join( '', @$row ) . "\n";
88 # Set up a temporary directory for all the default Phylip files.
89 my $phylip_dir = File::Temp->newdir();
90 # We need an infile, and we need a command input file.
91 open( MATRIX, ">$phylip_dir/infile" ) or die "Could not write $phylip_dir/infile";
92 print MATRIX $self->pars_input();
95 open( CMD, ">$phylip_dir/cmdfile" ) or die "Could not write $phylip_dir/cmdfile";
96 ## TODO any configuration parameters we want to set here
97 # U Search for best tree? Yes
98 # S Search option? More thorough search
99 # V Number of trees to save? 100
100 # J Randomize input order of species? No. Use input order
101 # O Outgroup root? No, use as outgroup species 1
102 # T Use Threshold parsimony? No, use ordinary parsimony
103 # W Sites weighted? No
104 # M Analyze multiple data sets? No
105 # I Input species interleaved? Yes
106 # 0 Terminal type (IBM PC, ANSI, none)? ANSI
107 # 1 Print out the data at start of run No
108 # 2 Print indications of progress of run Yes
109 # 3 Print out tree Yes
110 # 4 Print out steps in each site No
111 # 5 Print character at all nodes of tree No
112 # 6 Write out trees onto tree file? Yes
116 # And then we run the program.
118 my $PHYLIP_PATH = '/Users/tla/Projects/phylip-3.69/exe';
119 my $program = "pars";
120 if( $^O eq 'darwin' ) {
121 $program = "$PHYLIP_PATH/$program.app/Contents/MacOS/$program";
123 $program = "$PHYLIP_PATH/$program";
127 # We need to run it in our temporary directory where we have created
128 # all the expected files.
129 local $CWD = $phylip_dir;
130 my @cmd = ( $program );
131 run \@cmd, '<', 'cmdfile', '>', '/dev/null';
133 # Now our output should be in 'outfile' and our tree in 'outtree',
134 # both in the temp directory.
137 if( -f "$phylip_dir/outtree" ) {
138 open( TREE, "$phylip_dir/outtree" ) or die "Could not open outtree for read";
142 return( 1, join( '', @outtree ) ) if @outtree;
145 if( -f "$phylip_dir/outfile" ) {
146 open( OUTPUT, "$phylip_dir/outfile" ) or die "Could not open output for read";
150 push( @error, "Neither outtree nor output file was produced!" );
152 return( undef, join( '', @error ) );
156 __PACKAGE__->meta->make_immutable;