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

View of /FigKernelPackages/UnvSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (as text) (annotate)
Thu Sep 15 14:33:49 2005 UTC (14 years, 5 months ago) by parrello
Branch: MAIN
Changes since 1.4: +156 -156 lines
Converted tabs to spaces.

package UnvSubsys;

use Subsystem;
use Carp;
use FIG;

use Data::Dumper;
use strict;

sub new
{
    my($class, $ssa, $fig, $show_clusters, $aliases) = @_;

    $ssa =~ s/ /_/g;


        ### { Roles =>Roles,
        ###   RoleIndex => ToRoleIndexHash,
        ###   RoleSubsets => ColSubsets,
        ###   Genomes => Genomes,
        ###   GenomeIndex => ToGenomeIndexHash,
        ###   PegHash => PegHash,
        ###   Colors  => ColorHash,
        ###   Aliases => AliasHash,
        ###   Curator => Curator,
        ###   Notes => Notes,
        ###   Reactions => ReactionHash
        ### }
        ### 
        ### Roles = pointer to a list of [Role,Abbrev,[ReactionURLs]]
        ###
        ### ToRoleIndexHash = a pointer to a hash: key=Role Value=RoleIndex
        ###
        ### ColSubsets = pointer to a list of [SubsetName,[RoleIndexesFrom0]]
        ### 
        ### Genomes is a pointer to a list of [Genome,Variant]
        ###
        ### ToGenomeIndexHash = a pointer to a hash: key=Genome value=GenomeIndex
        ###
        ### PegHash = a pointer to a hash of hashes such that $peg_hash->{$genome_index}->{$role_index} = a
        ###           pointer to a list of PEGs
        ###
        ### ColorHash is a hash: key=PEG value=color
        ###
        ### AliasHash is a hash: key=PEG value=aliases
        ###
        ### ReactionHash is a hash: key=Role value=[reaction-ids]

    if (ref($fig) eq "FIG")
    {

        
        my $subsystem = new Subsystem($ssa,$fig,0);
        my $curator = $subsystem->get_curator;
        my $notes = $subsystem->get_notes;
        $notes =~ s/
/\n/g;
        my @roles = $subsystem->get_roles;
        my $reactions = $subsystem->get_reactions;
        my @genomes = $subsystem->get_genomes;
        my @col_subsets = $subsystem->get_subset_namesC;

        my $role_info = [];
        my $roleH     = {};

        my($i,$j,$subset,$peg);
        for ($i=0; ($i < @roles); $i++)
        {
            my $role = $roles[$i];
            my $abbrev = $subsystem->get_role_abbr( $subsystem->get_role_index( $role ) );
            my $react = $reactions ? join(",", map { &HTML::reaction_link($_) } @{$reactions->{$role}}) : [];
            push(@$role_info,[$role,$abbrev,$react]);
            $roleH->{$role} = $i;
        }

        my $subset_info = [];
        foreach $subset (@col_subsets)
        {
            if ($subset ne 'All')
            {
                push(@$subset_info,[$subset,[map { $roleH->{$_} } $subsystem->get_subsetC_roles($subset)]]);
            }
        }

        my $genomes_info = [];
        my $genomeH      = {};
        for ($i=0; ($i < @genomes); $i++)
        {
            my $genome  = $genomes[$i];
            my $variant = $subsystem->get_variant_code( $subsystem->get_genome_index( $genome ) );
            push(@$genomes_info,[$genome,$variant]);
            $genomeH->{$genome} = $i;
        }

        my $pegH = {};
        for ($i=0; ($i < @genomes); $i++)
        {
            my $genome = $genomes[$i];
            for ($j=0; ($j < @roles); $j++)
            {
                my $role = $roles[$j];
                my @pegs = $subsystem->get_pegs_from_cell($genome,$role);
                $pegH->{$i}->{$j} = [@pegs];
            }
        }
        my $colorsH  = $show_clusters  ? &set_colors($fig,$pegH)  : {};
        my $aliasesH = $aliases ? &set_aliases($fig,$pegH) : {};
        my $reactions = $subsystem->get_reactions;          
        my $self = { Roles => $role_info,
                     RoleIndex => $roleH,
                     RoleSubsets => $subset_info,
                     Genomes => $genomes_info,
                     GenomeIndex => $genomeH,
                     PegHash => $pegH,
                     Colors => $colorsH,
                     Aliases => $aliasesH,
                     Curator => $curator,
                     Notes => $notes,
                     Reactions => $reactions
                   };
        bless($self, $class);
        return $self;
    }
    else
    {
        return undef;
    }
}

sub set_aliases {
    my($fig,$pegH) = @_;
    my($genomeI,$roleI,$pegs,$peg,$roleH);

    my $aliasesH = {};

    foreach $genomeI (keys(%$pegH))
    {
        $roleH = $pegH->{$genomeI};
        foreach $roleI (keys(%$roleH))
        {
            $pegs = $roleH->{$roleI};
            foreach $peg (@$pegs)
            {
                if (! $aliasesH->{$peg})
                {
                    $aliasesH->{$peg} = scalar &ext_id($fig,$peg);
                }
            }
        }
    }
    return $aliasesH;
}

sub set_colors {
    my($fig,$pegH) = @_;
    my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);

    my $colorsH = {};

    foreach $genomeI (keys(%$pegH))
    {
        undef %pegs_in_genome;
        $roleH = $pegH->{$genomeI};
        foreach $roleI (keys(%$roleH))
        {
            $pegs = $roleH->{$roleI};
            foreach $peg (@$pegs)
            {
                $pegs_in_genome{$peg} = 1;
            }
        }

        my @pegs = keys(%pegs_in_genome);
        my($tuple,$peg,$color);
        my $colors_for_one_genome = &set_colors_for_genome($fig,\@pegs);

        while (($peg,$color) = each %$colors_for_one_genome)
        {
            $colorsH->{$peg} = $colors_for_one_genome->{$peg};
        }
    }
    return $colorsH;
}

sub set_colors_for_genome {
    my($fig,$pegs) = @_;
    my($peg,@clusters,$cluster,@colors,$color,%seen,%conn,$x,$peg1,@pegs,$i);
    
    my $color_of = {};
    foreach $peg (@$pegs) { $color_of->{$peg} = '#FFFFFF' }

    @pegs = keys(%$color_of);  #  Use of keys makes @pegs entries unique

    foreach $peg (@pegs)
    {
        $conn{$peg} = [grep { $color_of->{$_} && ($_ ne $peg) } $fig->close_genes($peg,5000)];
    }

    @clusters = ();
    while ($peg = shift @pegs)
    {
        if (! $seen{$peg})
        {
            $cluster = [$peg];
            $seen{$peg} = 1;
            for ($i=0; ($i < @$cluster); $i++)
            {
                my @tmp = grep { ! $seen{$_} } @{$conn{$cluster->[$i]}};
                if (@tmp > 0)
                {
                    foreach my $peg1 (@tmp) { $seen{$peg1} = 1 }
                    push(@$cluster,@tmp);
                }
            }
            push(@clusters,$cluster);
        }
    }

    @colors =  &cool_colors();

    @clusters = grep { @$_ > 1 } sort { @$a <=> @$b } @clusters;

    if (@clusters > @colors) { splice(@clusters,0,(@clusters - @colors)) }  # make sure we have enough colors

    my($cluster);
    foreach $cluster (@clusters)
    {
        $color = shift @colors;
        foreach $peg (@$cluster)
        {
            $color_of->{$peg} = $color;
        }
    }
    return $color_of;
}

sub cool_colors {
 # just an array of "websafe" colors or whatever colors we want to use. Feel free to remove bad colors (hence the lines not being equal length!)
 return (
 '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040', '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
 "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
 "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A", "#FFE4C4", "#FFB6C1",
 "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD", "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD",
 "#00FA9A", "#228B22", "#1E90FF", "#FA8072", "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4",
 "#D3D3D3", "#7B68EE", "#2F4F4F", "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1",
 "#6495ED", "#800080", "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C",
 "#EE82EE", "#7CFC00", "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520", "#008080",
 "#00FF7F", "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#00008B", "#5F9EA0",
 "#4169E1", "#20B2AA", "#8A2BE2", "#ADFF2F", "#556B2F",
 "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B", "#FF0000", "#F08080", "#7FFF00", "#8B0000",
 "#40E0D0", "#0000CD", "#48D1CC", "#8B008B", "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A",
 "#FFE4B5", "#B0C4DE", "#FAF0E6", "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF",
 "#000080", "#32CD32", "#FFFACD", "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585",
 "#BDB76B", "#00FFFF", "#FFDAB9", "#ADD8E6", "#778899",
 );
}

sub ext_id {
    my($fig,$peg) = @_;

    my @tmp;
    my @aliases = $fig->feature_aliases($peg);
    if      ((@tmp = grep { $_ =~ /^uni\|/ } @aliases) > 0)
    {
        @aliases =  @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^sp\|/ } @aliases) > 0)
    {
        @aliases = @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^gi\|/ } @aliases) > 0)
    {
        @aliases = @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^kegg\|/ } @aliases) > 0)
    {
        @aliases = @tmp;
    }
    else
    {
        @aliases = ();
    }

    if (wantarray())
    {
        return @aliases;
    }
    else
    {
        return $aliases[0];
    }
}


sub subsystem_curator {
    my($self) = @_;

    my $curator = $self->{Curator};
    $curator =~ s/master://;
    return $curator;
}

sub get_roles {
    my($self) = @_;

    return map { $_->[0] } @{$self->{Roles}};
}

sub get_genome_index {
    my($self,$genome) = @_;

    return $self->{GenomeIndex}->{$genome};
}

sub get_genomes {
    my($self) = @_;

    return map { $_->[0] } @{$self->{Genomes}};
}

sub get_variant_code {
    my($self,$genome) = @_;

    if ($genome =~ /^\d+$/)
    {
        return $self->{Genomes}->[$genome]->[1];
    }
    else
    {
        my $genomeI = $self->{GenomeIndex}->{$genome};
        return $self->{Genomes}->[$genomeI]->[1];
    }
}

sub get_pegs_from_cell {
    my($self,$genome,$role) = @_;

    my $genomeI = $self->{GenomeIndex}->{$genome};
    my $roleI   = $self->{RoleIndex}->{$role};

    my $pegs    = $self->{PegHash}->{$genomeI}->{$roleI};
    return $pegs ? @$pegs : ();
}

sub get_notes {
    my($self) = @_;

    return $self->{Notes};
}

sub get_role_index {
    my($self,$role) = @_;

    return $self->{RoleIndex}->{$role};
}

sub get_role_abbr {
    my($self,$roleI) = @_;

    if ($roleI !~ /^\d+$/)
    {
        $roleI = $self->{RoleIndex}->{$roleI};
    }
    my $roles = $self->{Roles};
    return $roles->[$roleI]->[1];
}

sub get_reactions {
    my($self) = @_;

    return $self->{Reactions};
}

sub get_subset_namesC {
    my($self) = @_;

    return map { $_->[0] } @{$self->{RoleSubsets}};
}

sub get_subsetC_roles {
    my($self,$subset) = @_;
    my($i,$j);

    my $subset_info = $self->{RoleSubsets};
    for ($i=0; ($i < @$subset_info) && ($subset_info->[$i]->[0] ne $subset); $i++) {}
    if ($i < @$subset_info)
    {
        my @roles = ();
        foreach $j (@{$subset_info->[$i]->[1]})
        {
            push(@roles,$self->{Roles}->[$j]->[0]);
        }
        return @roles;
    }
    return undef;
}

sub get_color_of {
    my($self,$peg)  = @_;

    return $self->{Colors}->{$peg};
}

1;



MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3