X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FStemmaUtil.pm;h=295110d37f3356f4321b105c51f77a5cbd02d64a;hb=da83693e61ca80c4c9a23583a0aadda94d087125;hp=15e7f898d4357ca0bfa1c0019623d0bb59d19bae;hpb=69403daab6a116b2868b73adf3ac5b97e6c531db;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/StemmaUtil.pm b/lib/Text/Tradition/StemmaUtil.pm index 15e7f89..295110d 100644 --- a/lib/Text/Tradition/StemmaUtil.pm +++ b/lib/Text/Tradition/StemmaUtil.pm @@ -13,10 +13,41 @@ use Graph; use Graph::Reader::Dot; use IPC::Run qw/ run binary /; use Text::Tradition::Error; -@EXPORT_OK = qw/ make_character_matrix character_input phylip_pars - parse_newick newick_to_svg /; +@EXPORT_OK = qw/ character_input phylip_pars parse_newick newick_to_svg /; -sub make_character_matrix { +=head1 NAME + +Text::Tradition::StemmaUtil - standalone utilities for distance tree calculations + +=head1 DESCRIPTION + +This package contains a set of utilities for running phylogenetic analysis on +text collations. + +=head1 SUBROUTINES + +=head2 character_input( $alignment_table ) + +Returns a character matrix string suitable for Phylip programs, which +corresponds to the given alignment table. See Text::Tradition::Collation +for a description of the alignment table format. + +=cut + +sub character_input { + my $table = shift; + my $character_matrix = _make_character_matrix( $table ); + my $input = ''; + my $rows = scalar @{$character_matrix}; + my $columns = scalar @{$character_matrix->[0]} - 1; + $input .= "\t$rows\t$columns\n"; + foreach my $row ( @{$character_matrix} ) { + $input .= join( '', @$row ) . "\n"; + } + return $input; +} + +sub _make_character_matrix { my( $table ) = @_; # Push the names of the witnesses to initialize the rows of the matrix. my @matrix = map { [ _normalize_witname( $_->{'witness'} ) ] } @@ -27,7 +58,7 @@ sub make_character_matrix { my @pos_readings = map { $_->{'tokens'}->[$token_index] } @{$table->{'alignment'}}; my @pos_text = map { $_ ? $_->{'t'} : $_ } @pos_readings; - my @chars = convert_characters( \@pos_text ); + my @chars = _convert_characters( \@pos_text ); foreach my $idx ( 0 .. $#matrix ) { push( @{$matrix[$idx]}, $chars[$idx] ); } @@ -45,7 +76,7 @@ sub _normalize_witname { return sprintf( "%-10s", $witname ); } -sub convert_characters { +sub _convert_characters { my $row = shift; # This is a simple algorithm that treats every reading as different. # Eventually we will want to be able to specify how relationships @@ -78,18 +109,11 @@ sub convert_characters { return @chars; } -sub character_input { - my $table = shift; - my $character_matrix = make_character_matrix( $table ); - my $input = ''; - my $rows = scalar @{$character_matrix}; - my $columns = scalar @{$character_matrix->[0]} - 1; - $input .= "\t$rows\t$columns\n"; - foreach my $row ( @{$character_matrix} ) { - $input .= join( '', @$row ) . "\n"; - } - return $input; -} +=head2 phylip_pars( $character_matrix ) + +Runs Phylip Pars on the given character matrix. Returns results in Newick format. + +=cut sub phylip_pars { my( $charmatrix ) = @_; @@ -158,6 +182,12 @@ sub phylip_pars { throw( join( '', @error ) ); } +=head2 parse_newick( $newick_string ) + +Parses the given Newick tree(s) into one or more undirected Graph objects. + +=cut + sub parse_newick { my $newick = shift; my @trees; @@ -173,6 +203,13 @@ sub parse_newick { return \@trees; } +=head2 newick_to_svg( $newick_string ) + +Uses the FigTree utility (if installed) to transform the given Newick tree(s) +into a graph visualization. + +=cut + sub newick_to_svg { my $newick = shift; my $program = File::Which::which( 'figtree' ); @@ -220,3 +257,14 @@ sub throw { ); } +1; + +=head1 LICENSE + +This package is free software and is provided "as is" without express +or implied warranty. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 AUTHOR + +Tara L Andrews Eaurum@cpan.orgE