[Bio] / FigKernelPackages / tree_neighborhood.pm Repository:
ViewVC logotype

View of /FigKernelPackages/tree_neighborhood.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Mon Jan 8 19:47:28 2007 UTC (12 years, 10 months ago) by overbeek
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
add tree_neighbors and latest phylogeny stuff

package tree_neighborhood;

use Data::Dumper;

use strict;

# @rep_tips = n_tips_for_neighborhood( $tree, $n );

# $node_start_end = branch_intervals_and_nodes( $tree );
# @node_start_end = branch_intervals_and_nodes( $tree );

# \%node_to_rep_tip = tip_representing_node( $tree );

# $nodes = n_representatives( $n, $id_start_end );
# $nodes = n_representatives( $n, @id_start_end );
# @nodes = n_representatives( $n, $id_start_end );
# @nodes = n_representatives( $n, @id_start_end );


# @rep_tips = n_tips_for_neighborhood( $tree, $n );

sub n_tips_for_neighborhood
{
    my ( $tree, $n ) = @_;
    my @tips = @{&tree_utilities::tips_of_tree( $tree )};
    if ( $n && ( @tips <= $n ) ) { return @tips }
    my $id_start_end = branch_intervals_and_nodes( $tree );
    my $nodes = n_representatives( $n, $id_start_end );
    my $node_to_rep_tip = tip_representing_node( $tree );
    my @rep_tips = map { $node_to_rep_tip->{ $_ } } @$nodes;
    return wantarray ? @rep_tips : \@rep_tips;
}

sub n_representatives
{
    my $n = shift;
    my @unprocessed = sort { $a->[1] <=> $b->[1] }
                      ( ref( $_[0]->[0] ) eq 'ARRAY' ) ? @{ $_[0] } : @_;
    my @active = ();
    my ( $current_interval, $current_point );
    while ( ( @active < $n ) && @unprocessed )
    {
        $current_interval = shift @unprocessed;
        $current_point = $current_interval->[1];
        @active = grep { $_->[2] > $current_point } @active;
        push @active, $current_interval;
    }

    my @ids = map { $_->[0] } @active;
    return wantarray() ? @ids : \@ids;
}

#  Overbeek tree:
#
#     [ Label,
#       DistanceToParent,
#       [ ParentPointer, ChildPointer1, ... ],
#       [ Name1\tVal1, Name2\Val2, ... ]
#     ]
#

sub branch_intervals_and_nodes
{
    my ( $node, $parent_x ) = @_;
    $parent_x ||= 0;
    my ( $label, $dx, $desc ) = @$node;
    my $x = $parent_x + $dx;
    my $interval = [ $node, $parent_x, (@$desc > 1) ? $x : 1e100 ];
    my @intervals = ( $interval,
                      map { &branch_intervals_and_nodes( $_, $x ) } @$desc[ 1 .. $#{@$desc} ]
                    );
    return wantarray() ? @intervals : \@intervals;
}



sub tip_representing_node
{
    my ( $tree ) = @_;
    my $hash = {};
    &tip_representing_node_1( $tree, $hash );
    return $hash;
}


sub tip_representing_node_1
{
    my ( $node, $hash ) = @_;
    my ( $label, $dx, $desc ) = @$node;
    $dx ||= 0;
    if ( @$desc > 1 )
    {
        my ( $rep, $min_dist ) = ( undef, 1e100 );
        foreach my $node2 ( @$desc[ 1 .. $#{@$desc} ] )
        {
            my ( $tip, $dist ) = &tip_representing_node_1( $node2, $hash );
            if ( $dist < $min_dist ) { $min_dist = $dist; $rep = $tip }
        }
        $hash->{ $node } = $rep;
        return ( $rep, $min_dist + $dx );
    }
    else
    {
        $hash->{ $node } = $label;
        return ( $label, $dx );
    }
}

sub focused_neighborhood {
    my($tree,$id,$approx_tree,$n) = @_;

    my $hash = {};
    foreach my $tip (@{ &tree_utilities::tips_of_tree($tree)})
    {
	$hash->{$tip} = 1;
    }
    $hash->{$id} = 1;
    my $subtree = &tree_utilities::subtree($approx_tree,$hash);
    my $indexes = &tree_utilities::tree_index_tables($subtree);
    my $tree1   = &tree_utilities::root_tree_at_node($indexes,$id);
    my $desc    = $tree1->[2]->[1];
    my @tips = &tree_neighborhood::n_tips_for_neighborhood($desc,$n);
    my %hash2 = map { $_ => 1 } @tips;
    return &tree_utilities::subtree($tree,\%hash2);
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3