[Bio] / FigWebServices / resolve_paralogs.cgi Repository:
ViewVC logotype

View of /FigWebServices/resolve_paralogs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (download) (annotate)
Sat Aug 13 21:36:45 2011 UTC (8 years, 3 months ago) by golsen
Branch: MAIN
CVS Tags: rast_rel_2014_0912, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2014_0729, mgrast_release_3_1_2, rast_rel_2011_0928, mgrast_dev_10262011, HEAD
Changes since 1.13: +38 -27 lines
Add fraction identity filter for paralogs.
Improve handling of links to the proteins in the tree.

# -*- perl -*-
#
# Copyright (c) 2003-2011 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

#  Test url:
#  resolve_paralogs.cgi?user=gjo&genome=83333.1&genome=224308.1&genome=224324.1&genome=262724.1&genome=243232.1&genome=196164.1&roles=Translation%20initiation%20factor%202&roles=Translation%20elongation%20factor%20Tu&roles=GTP-binding%20protein%20TypA/BipA&roles=GTP-binding%20protein%20Era
#

use FIG;
use strict;
use clustaltree;   # tree_with_clustal()
use gjoalignment;
use gjonewicklib;
use ParalogResolution;
use HTML;
use CGI;

my $fig = new FIG;
my $cgi = new CGI;

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/resolve_parlogs`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    print "<PRE>\n";
    foreach ( $cgi->param )
    {
        print "$_\t:",join(",",$cgi->param($_)),":\n";
    }
    print "</PRE>\n";

    if (0)
    {
	if (open(TMP,">/tmp/resolve_paralogs"))
	{
	    use Data::Dumper;
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $align       = $cgi->param('align');
my $e_value     = $cgi->param('e_value')      || 1e-10;
my $min_ident   = $cgi->param('min_identity') || 0.25;
my @genomes     = current_genomes( $cgi );
my $keep_mf     = $cgi->param('keep_mf');
my @roles       = current_roles( $cgi );
my $tree_prog   = $cgi->param('tree')         || 'clustal';  # or 'muscle'
my $user        = $cgi->param('user');
my $min_cov     = $cgi->param('min_coverage') || 0.7;
my $haveviewer  = -f "$FIG_Config::fig/CGI/seedviewer.cgi";
my $protein_cgi = $haveviewer ? $cgi->param('protein_cgi') : 1;

#  Values for testing
if (0)
{
    @genomes = qw( 83333.1 224308.1 224324.1 262724.1 243232.1 196164.1 ) if ! @genomes;
    @roles   = ( 'Translation initiation factor 2',
               # 'Translation elongation factor 1 alpha subunit',
                 'Translation elongation factor Tu',
               # 'Translation elongation factor 2',
               # 'Translation elongation factor G',
                 'GTP-binding protein TypA/BipA',
               # 'GTP-binding protein EngA',
                 'GTP-binding protein Era',
               # 'GTPase and tRNA-U34 5-formylation enzyme TrmE',
               # 'GTP-binding and nucleic acid-binding protein YchF',
               ) if ! @roles;
}

my $role0 = $roles[0] ? ": $roles[0]" : ''; 
my @html = ();

my $agent  = $ENV{ HTTP_USER_AGENT } || '';

my $height = $agent =~ /Safari/i  ? '120%'
           : $agent =~ /Firefox/i ? '100%'
           :                        '110%';

my $lsize  = $agent =~ /Safari/i  ? '160%'
           : $agent =~ /Firefox/i ? '130%'
           :                        '150%';

my $v_pos  = $agent =~ /Safari/i  ? 'sub'
           : $agent =~ /Firefox/i ? 'base-line'
           :                        'base-line';

push @html, map { map { "$_\n" } split /\n/ } <<End_of_Head;
<HTML>
<HEAD>
<TITLE>SEED paralog resolution tool$role0</TITLE>

<STYLE Type="text/css">
  /* HTML printer graphics tree in unicode box drawing set */
  TABLE.tree {
    font-size:     100%;
    line-height:   $height;
    border-width:   0px;
    padding:        0px;
    white-space: nowrap;
  }
  TABLE.tree TR {
    height:        $height;
    border-width:   0px;
    padding:        0px;
  }
  TABLE.tree TD {
    border-width:   0px;
    padding:        0px;
    white-space: nowrap;
  }
  TABLE.tree A {
    text-decoration: none;
  }
  TABLE.tree INPUT {
    height: 10px;    /* ignored by Firefox */
    width:  10px;    /* ignored by Firefox */
    padding: 0px;
    margin:  0px;
  }
  TABLE.tree PRE {
    font-size: $lsize;
    padding:    0px;
    margin:     0px;
    vertical-align: $v_pos;
    display: inline;
  }
  TABLE.tree SPAN.w {  /* used for tree white space */
    color: white;
  }
</STYLE>

<SCRIPT Type="text/javascript" Src="./Html/layout.js"></SCRIPT>

<LINK Type="text/css" Rel="stylesheet" HRef="./Html/frame.css" />

</HEAD>
<BODY>
End_of_Head

#-------------------------------------------------------------------------------
#  Build a form for changing analysis parameters:
#-------------------------------------------------------------------------------

push( @html, $cgi->h3( 'Analysis Paramters' ), "\n",
             $cgi->start_form(-action => "resolve_paralogs.cgi"),
             $cgi->hidden( -name => 'genome', -value => \@genomes, -override => 1 ), "\n",
             $cgi->hidden( -name => 'roles',  -value => \@roles,   -override => 1 ), "\n",
             "User: ",
             $cgi->textfield(-name => "user", -size => 20,  -override => 1, -value => $user), "<BR />\n",
             "Blast maximum e-value: ",
             $cgi->textfield(-name => "e_value", -size => 20, -override => 1, -value => $e_value), "<BR />\n",
             "Blast minimum identity: ",
             $cgi->textfield(-name => "min_identity", -size => 20, -override => 1, -value => $min_ident), "<BR />\n",
             "Blast minimum coverage: ",
             $cgi->textfield(-name => "min_coverage", -size => 20, -override => 1, -value => $min_cov), "<BR />\n",
             $cgi->hidden( -name => 'user',         -value => $user ),
             "Show alignment: ",
             $cgi->checkbox( -name => 'align', -checked => $align, -override => 1, -label => ''  ), "<BR />\n",
             "Allow multifunctional assignments: ",
             $cgi->checkbox( -name => 'keep_mf', -checked => $keep_mf, -override => 1, -label => ''  ), "<BR />\n",
             $haveviewer ? ( "Link to old protein page: ",
                             $cgi->checkbox( -name => 'protein_cgi', -checked => $protein_cgi, -override => 1, -label => '' ),
                             "<BR />\n"
                           )
                         : $cgi->hidden( -name => 'protein_cgi', -value => 1, -override => 1 ),
             "Tree construction tool: ",
             "<select name=tree>\n",
             "    <option value=clustal" . ( $tree_prog eq 'clustal' ? ' selected' : '' ) . ">clustalw</option>\n",
             "    <option value=muscle"  . ( $tree_prog eq 'muscle'  ? ' selected' : '' ) . ">muscle</option>\n",
             "</select>\n","<BR />"
    );

genome_picker( $fig, $cgi, \@html, \@genomes );

role_picker( $fig, $cgi, \@html, \@roles );

push( @html, $cgi->submit( 'Update' ), "\n",
             $cgi->end_form, $cgi->br, $cgi->hr, "\n"
    );


#-------------------------------------------------------------------------------
#  Collect, align and tree the paralogous sequences:
#
#  In each @genomes, find all genes with one of the @roles.
#  Find all other similar to genes in each of the @genomes.
#  Align the related genes with muscle, returning the alignment and tree.
#
#-------------------------------------------------------------------------------

my $parms = { keep_multifunctional => $keep_mf,
              max_sc               => $e_value,
              min_cov              => $min_cov,
              min_ident            => $min_ident };

my ( $ali, $tree_str ) = &ParalogResolution::reference_set_for_paralogs( $fig, \@genomes, \@roles, $parms);

if ( ! $ali )
{
    push @html, $cgi->h3( "Less than 2 sequences satisfied the request.  Analysis is futile." ), "\n";
    &HTML::show_page($cgi,\@html);
    exit;
}

my $tree1;
if ( $ali && $tree_prog eq 'clustal' )
{
    $tree1 = &clustaltree::tree_with_clustal( map { [$_->[0],'',$_->[2]] } @$ali );
}
elsif ( $tree_str )
{
    $tree1 = &gjonewicklib::parse_newick_tree_str( $tree_str );
}
my $tree2 = &gjonewicklib::reroot_newick_to_midpoint( $tree1 );
my $tree3 = &gjonewicklib::aesthetic_newick_tree( $tree2 );

#  Identify common roles within a given distance of each peg.  Produce a
#  tag that is the list of gene roles (identified by numbers) before and
#  after the given peg.  Produce a table that translates the role numbers
#  to their actual names.

my @pegs = map { $_->[0] } @$ali;
my( $tags, $table ) = &ParalogResolution::context_tags( \@pegs, 5000 );

#  Descriptions of the sequences from reference_set_for_paralogs():

my %descs = map { $_->[0] => $_->[1] } @$ali;

#  Build label strings that integrate the label, coloring, and context tags.
#  Put them into the tree.

my $labels = &make_labels( $cgi, \%descs, $tags );
my $tree   = &gjonewicklib::newick_relabel_tips( $tree3, $labels );

#-------------------------------------------------------------------------------
#  Build a form, and print the tree in it:
#-------------------------------------------------------------------------------

push @html, "<h2>Tree of Protein Sequences</h2>\n",
            $cgi->start_form( -method => 'post',
                              -target => '_blank',
                              -action => 'fid_checked.cgi',
                              -name   => 'fid_checked'
                             ),
            $cgi->hidden( -name => 'user', -value => $user );

my $plot_options = { chars  => 'html',       # html-encoded unicode box set
                     format => 'tree_lbl',   # line = [ $graphic, $label ]
                     dy     =>  1,
                     min_dx =>  1,
                     width  => 64
                   };

push @html, "\n",
            "<TABLE Class=tree>\n",
            ( map { my ( $line, $lbl0 ) = @$_;
                    my ( $lbl, $tag1, $tag2 ) = ref $lbl0 ? map { $_ || '' } @$lbl0
                                                          : ( '' x 3 );
                    #  Fix white space for even spacing:
                    $line =~ s/((&nbsp;)+)/<SPAN Class=w>$1<\/SPAN>/g;
                    $line =~ s/&nbsp;/&#9474;/g;
                    #  Output line:
                    $lbl ? "   <TR><TD><PRE>$line</PRE> $lbl</TD><TD Align=right>$tag1</TD><TD>::</TD><TD Align=left>$tag2</TD></TR>\n"
                         : "   <TR><TD><PRE>$line</PRE></TD><TD Align=right></TD><TD></TD><TD Align=left></TD></TR>\n"
                 }
              text_plot_newick( $tree, $plot_options )
            ),
            "</TABLE>\n",
            "\n";


push @html, join( "\n", $cgi->br,
                        &HTML::java_buttons( "fid_checked", "checked" ),
                        $cgi->br, "",
                       "For selected (checked) sequences: ",
                        $cgi->submit( 'align' ),
                        $cgi->submit( 'view annotations' ),
                        $cgi->submit( 'show regions' ),
                        $cgi->br, ""
               );

if ( $user)
{
    push @html, $cgi->submit('assign/annotate') . "\n",
                $cgi->br,
                "<a href='Html/help_for_assignments_and_rules.html'>Help on Assignments, Rules, and Checkboxes</a>", "";
}

push @html, $cgi->end_form . "\n";

#-------------------------------------------------------------------------------
#  Write out the roles in the context tags
#-------------------------------------------------------------------------------

push @html, "<HR />\n",
            "<H2>Key to role numbers of genes in context tags</H2>\n",
            "<TABLE>\n";
foreach $_ ( @$table )
{
    push @html, "  <TR><TD Align=right>$_->[0]</TD><TD Align=left>$_->[1]</TD></TR>\n";
}
push(@html,"</TABLE>\n");

#  Do we want to show the alignment?
if ( $align )
{
    push @html, join( "\n",
                      "<HR /><H3>Alignment:</H3><PRE>",
                      ( map { ( ">$_->[0] $_->[1]", $_->[2] =~ m/.{1,60}/g ) } @$ali ),
                      "</PRE><BR />\n"
                    );
}

&HTML::show_page($cgi,\@html);

exit;

#===============================================================================
#  End of script; only subroutines below.
#===============================================================================
#
#  \%html_string = make_labels( $cgi, \%descriptions, \%context_tags )
#
#  context tags are roles before and after the sequence (marked by ::)
#
#-------------------------------------------------------------------------------
sub make_labels
{
    my ( $cgi, $descs, $tags ) = @_;
    
    my $user = $cgi->param( 'user' );
    my $protein_cgi = $cgi->param( 'protein_cgi' );

    my @pegs = keys %$descs;

    my %split_description;
    my @pegs_with_func = ();
    my %role_count;
    my %role_color;
    my %check;
    my %from;
    my %labels;

    #------------------------------------------------------------------
    #  Parse the text into roles, comments and organisms:
    #------------------------------------------------------------------

    foreach my $peg ( @pegs )
    {
        my $desc = $descs->{ $peg };
        my ( $func, $roles, $com, $org ) = split_desc( $desc );
        foreach ( @$roles ) { $role_count{ $_ }++ if /[0-9A-Za-z]/ }
        $split_description{ $peg } = [ $func, $roles, $com, $org ];
        push @pegs_with_func, $peg  if $func =~ /[0-9A-Za-z]/;
    }

    #------------------------------------------------------------------
    #  Assign colors to roles:
    #------------------------------------------------------------------

    my @pallet = ( '#DDCCAA', '#FFAAAA', '#FFCC66', '#FFFF44',
                   '#CCFF66', '#88FF88', '#88EECC', '#88FFFF',
                   '#66CCFF', '#AAAAFF', '#CC88FF', '#FFAAFF'
                 );
    %role_color = map  { $_->[0] => ( shift @pallet ) || '#C0C0C0' }
                  sort { $b->[1] <=> $a->[1] }
                  map  { [ $_, $role_count{ $_ } ] }
                  keys %role_count;

    #------------------------------------------------------------------
    #  Build checkboxes and radio buttons for appropriate sequences:
    #------------------------------------------------------------------

    %check = map { $_ => qq(<input type=checkbox name=checked value="$_">) } @pegs;

    if ( $user )
    {
        %from = map { m/value=\"([^\"]+)\"/; $1 => $_ }
                $cgi->radio_group( -name     => 'from',
                                   -nolabels => 1,
                                   -override => 1,
                                   -values   => [ @pegs_with_func ]
                                );
    }

    #------------------------------------------------------------------
    #  Build the actual labels:
    #------------------------------------------------------------------

    foreach my $peg ( @pegs )
    {
        my ( $func, $roles, $com, $org ) = @{ $split_description{ $peg } };
        foreach ( @$roles )
        {
            my $color = $role_color{ $_ };
            $_ = "<SPAN Style='background-color:$color'>$_</SPAN>" if $color;
        }
        $func = join( '', @$roles );  # Clobber the original, uncolored string

        my $link = $protein_cgi ? "<A Target=_blank HRef=protein.cgi?prot=$peg&user=$user>$peg</A>&nbsp;"
                                : HTML::fid_link( $cgi, $peg );
        my   @label;
        push @label, $link;
        push @label, $check{ $peg }  if $check{ $peg };
        push @label, $from{ $peg }   if $from{ $peg };
        push @label, $func           if $func =~ /[0-9A-Za-z]/;
        push @label, $com            if $com;
        push @label, "[$org]"        if $org;

        my $label = join( ' ', @label );

        $labels{ $peg } = [ $label, split /::/, $tags->{ $peg } ];
    }

    return \%labels;
}


#  Split a sequence description string into the roles, the comment and the
#  organism.  Further, split the role string into its components and 
#  punctuation.

#  ( $function, \@roles, $comment, $organism ) = split_desc( $description )

sub split_desc
{
    local $_ = shift;
    s/\s+/ /g;  # White space to single blanks

    my $org = '';
    s/ $//;
    if ( m/\]$/ )
    {
        my $i = length( $_ ) - 2;
        my $d = 1;
        while ( $d > 0 && $i >= 0 )
        {
            my $c = substr( $_, $i, 1 );
            if ( $c eq '[' ) { $d-- } elsif ( $c eq ']' ) { $d++ }
            if ($d) { $i-- }
        }
        if ( $i >= 0 )
        {
            $org = substr( $_, $i+1, length($_) - $i - 2 );  # Excludes brackets
            $_ = substr( $_, 0, $i );
            s/\s+$//;
        }
    }

    my ( $com ) = s/ (\#\#? .*)$//;
    $com ||= '';

    my $func = $_;
    my @roles = split /(; | @ | \/ )/;

    return ( $func, \@roles, $com, $org );
}

#-----------------------------------------------------------------------------
#  Determine the current list of roles:
#-----------------------------------------------------------------------------

sub current_roles
{
    my ( $cgi ) = @_;

    my %roles = map { $_ => 1 } $cgi->param( 'roles' );

    foreach ( $cgi->param( 'delete_role' ) ) { $roles{ $_ } = 0 }
    $cgi->delete( 'delete_role' );

    if ( $cgi->param( 'new_roles' ) )
    {
        my @new_roles = grep { /\S/ }
                        map  { s/^\s+//; s/\s+$//; s/\s\s+/ /; $_ }
                        split /\r/, $cgi->param( 'new_roles' );
        foreach ( @new_roles ) { $roles{ $_ } = 1 }
    }
    $cgi->delete( 'new_roles' );

    sort { lc $a cmp lc $b } grep { $roles{$_} } keys %roles;
}


#-----------------------------------------------------------------------------
#  Selection of roles:
#-----------------------------------------------------------------------------

sub role_picker
{
    my( $fig, $cgi, $html, $roles ) = @_;

    push @$html, qq(<input type='button' id='role_chooser_link' value='show' onclick='change_element("role_chooser", "show", "hide");'>\n),
                 qq(<B>Role Selection</B><BR />\n),
                 qq(<span id='role_chooser_content' class='hideme'>\n);

    push @$html, "<BR /><B>Current Roles (use check box to remove)</B><BR />\n";
    push @$html, $cgi->hidden( -name     => 'roles',
                               -value    => $roles,
                               -override => 1
                             ) . "\n";
    foreach ( sort { lc $a cmp lc $b } @$roles )
    {
        push @$html, $cgi->checkbox( -name     => 'delete_role',
                                     -value    => $_,
                                     -label    => $_,
                                     -override => 1
                                   ),
                     $cgi->br, "\n";
    }

    push @$html, "<BR /<B>Enter Additional Roles (separated by newlines)</B><BR />\n",
                 $cgi->textarea( -name     => 'new_roles',
                                 -rows     =>   5,
                                 -cols     => 100,
                                 -override =>   1
                               ),
                 $cgi->br, "\n";

    push @$html, "</SPAN>\n";
}


#-----------------------------------------------------------------------------
#  Determine the current list of genomes:
#-----------------------------------------------------------------------------

sub current_genomes
{
    my ( $cgi ) = @_;

    my %genomes = map { $_ => 1 } $cgi->param( 'genome' );

    foreach ( $cgi->param( 'delete_genome' ) ) { $genomes{ $_ } = 0 }
    $cgi->delete( 'delete_genome' );

    foreach ( $cgi->param( 'new_genomes' ) ) { $genomes{ $_ } = 1 }
    $cgi->delete( 'new_genomes' );

    grep { $genomes{$_} } keys %genomes;
}


#-----------------------------------------------------------------------------
#  Selection list of genomes:
#-----------------------------------------------------------------------------

sub genome_picker
{
    my( $fig, $cgi, $html, $genomes ) = @_;

    $genomes = [] if ! ref( $genomes ) eq 'ARRAY';
    my %current = map { $_ => 1 } @$genomes;

    push @$html, qq(<input type='button' id='genome_chooser_link' value='show' onclick='change_element("genome_chooser", "show", "hide");'>\n),
                 qq(<B>Genome Selection</B><BR />\n),
                 qq(<span id='genome_chooser_content' class='hideme'>\n);

    push @$html, "<BR /><B>Current Genomes (use check box to remove)</B><BR />\n";
    push @$html, $cgi->hidden( -name     => 'genome',
                               -value    => $genomes,
                               -override => 1
                             ) . "\n";

    my @with_gs = sort { lc $a->[1] cmp lc $b->[1] }
                  map { [ $_, $fig->genus_species_domain( $_ ) ] }
                  @$genomes;

    #  Abbbreviated domain names

    my %maindomain = ( Archaea               => 'A',
                       Bacteria              => 'B',
                       Eukaryota             => 'E',
                       Plasmid               => 'P',
                       Virus                 => 'V',
                      'Environmental Sample' => 'M',  # Metagenome
                       unknown               => 'U'
                     );

    #  Check list of current genomes:

    foreach ( @with_gs )
    {
        my $domain = $maindomain{ $_->[2] } || '';
        my $label  = "$_->[1] [$domain] ($_->[0])";
        push @$html, $cgi->checkbox( -name     => 'delete_genome',
                                     -value    => $_->[0],
                                     -label    => $label,
                                     -override => 1
                                   ),
                     $cgi->br, "\n";
    }

    #  Building the list of genomes that can be added:

    my $req_comp = $cgi->param( 'complete' ) || 'Only "complete"';
    my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";

    #  What domains are to be displayed in the genome picker?
    #  These are the canonical domain names defined in compute_genome_counts
    #  and entered in the DBMS:

    my %label = ( Archaea               => 'Archaea [A]',
                  Bacteria              => 'Bacteria [B]',
                  Eukaryota             => 'Eucarya [E]',
                  Plasmid               => 'Plasmids [P]',
                  Virus                 => 'Viruses [V]',
                 'Environmental Sample' => 'Environmental (metagenomes) [M]',
                  unknown               => 'unknown [U]'
                );

    #  Currently, compute_genome_counts marks everything that is not Archaea,
    #  Bacteria or Eukcayra to not complete.  So, the completeness status must
    #  be ignored on the others.

    my %honor_complete = map { $_ => 1 } qw( Archaea Bacteria Eukaryota );

    #  Requested domains or default:

    my @picker_domains = grep { $maindomain{ $_ } }
                         $cgi->param( 'picker_domains' );
    if ( ! @picker_domains ) { @picker_domains = qw( Archaea Bacteria Eukaryota ) }

    my %picker_domains = map { $_ => 1 } @picker_domains;

    #  Build domain selection checkboxes:

    my @domain_checkboxes = ();
    my %domain_abbrev = reverse %maindomain;
    foreach ( map { $domain_abbrev{ $_ } } qw( A B E P V M U ) )
    {
        push @domain_checkboxes, $cgi->checkbox( -name     => 'picker_domains',
                                                 -value    => $_,
                                                 -checked  => ( $picker_domains{ $_ } ? 1 : 0 ),
                                                 -label    => $label{ $_ },
                                                 -override => 1
                                               )
    }

    #  Assemble the genome list for the picker.  This could be optimized for
    #  some special cases, but it is far from rate limiting.  Most of the time
    #  is looking up the name and domain, not the call to genomes().
    #  Filter out current genomes.
    #
    #  Each genome is represented as [ gid, genus_species, domain ]

    my @new_orgs = ();
    foreach my $domain ( @picker_domains )
    {
        push @new_orgs, map { [ $_, $fig->genus_species_domain( $_ ) ] }
                        grep { ! $current{ $_ } }
                        $fig->genomes( $complete && $honor_complete{ $domain }, undef, $domain )
    }

    #
    #  Put it in the order requested by the user:
    #
    my $pick_order = $cgi->param('pick_order') || 'Alphabetic';
    if ( $pick_order eq "Phylogenetic" )
    {
        @new_orgs = sort { $a->[-1] cmp $b->[-1] }
                    map  { push @$_, lc $fig->taxonomy_of( $_->[0] ); $_ }
                    @new_orgs;
    }
    elsif ( $pick_order eq "Genome ID" )
    {
        @new_orgs = sort { $a->[-1]->[0] <=> $b->[-1]->[0] || $a->[-1]->[1] <=> $b->[-1]->[1] }
                    map  { push @$_, [ split /\./, $_->[0] ]; $_ }
                    @new_orgs;
    }
    else
    {
        $pick_order = 'Alphabetic';
        @new_orgs = sort { $a->[-1] cmp $b->[-1] }
                    map  { push @$_, lc $_->[1]; $_ }
                    @new_orgs;
    }

    #  Build the displayed name and id list:

    my %new_orgs = map { $_->[0] => "$_->[1] [$maindomain{$_->[2]}] ($_->[0])" } @new_orgs;
    my @new_gids = map { $_->[0] } @new_orgs;

    #
    #  Radio buttons to let the user choose the order they want for the list:
    #
    my @order_opt = $cgi->radio_group( -name     => 'pick_order',
                                       -values   => [ 'Alphabetic', 'Phylogenetic', 'Genome ID' ],
                                       -default  => $pick_order,
                                       -override => 1
                                     );

    #
    #  Radio buttons to let the user choose to include incomplete genomes:
    #
    my @complete = $cgi->radio_group( -name     => 'complete',
                                      -default  => $req_comp,
                                      -values   => [ 'All', 'Only "complete"' ],
                                      -override => 1
                                    );

    #
    #  Display the pick list, and options:
    #
    push( @$html, "<BR /><B>Select Genomes to Add</B><BR />\n",
                  "<TABLE>\n",
                  "  <TR VAlign=top>\n",
                  "    <TD>",
                  $cgi->scrolling_list( -name     => 'new_genomes',
                                        -values   => \@new_gids,
                                        -labels   => \%new_orgs,
                                        -size     => 10,
                                        -multiple =>  1,
                                        -override =>  1
                                      ),
                  "    </TD>\n",

                  "    <TD>",
                  join( "<BR />\n", "<b>Order of selection list:</b>", @order_opt,
                                  "<b>Completeness?</b>", @complete
                      ), "\n",
                  "    </TD>\n",

                  "    <TD>&nbsp;&nbsp;&nbsp;</TD>\n",

                  "    <TD>\n",
                  join( "<BR />\n", "<B>Include in selection list:</B>", @domain_checkboxes ), "\n",
                  "    </TD>\n",

                  "  </TR>\n",
                  "</TABLE>\n",
        );

    push @$html, "</SPAN>\n";
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3