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

Diff of /FigWebServices/align_and_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Fri Nov 11 00:21:14 2011 UTC revision 1.2, Sat Nov 12 00:01:44 2011 UTC
# Line 42  Line 42 
42  my $ali_tree_id  = $cgi->param( 'ali_tree_id' );  my $ali_tree_id  = $cgi->param( 'ali_tree_id' );
43  my @ali_tree_ids = $cgi->param( 'at_ids' );  my @ali_tree_ids = $cgi->param( 'at_ids' );
44  my $align_format = $cgi->param( 'align_format' );  my $align_format = $cgi->param( 'align_format' );
45  my $align_id     = $cgi->param( 'align' );  my $align_id     = $cgi->param( 'align_id' );
46  my @checked      = $cgi->param( 'checked' );  my @checked      = $cgi->param( 'checked' );
47  my $color_aln_by = $cgi->param( 'color_aln_by' ) || 'consensus';  my $color_aln_by = $cgi->param( 'color_aln_by' ) || 'consensus';
48  my $fid          = $cgi->param( 'fid' );  my $fid          = $cgi->param( 'fid' );
# Line 50  Line 50 
50  my $show_align   = $cgi->param( 'show_align' );  my $show_align   = $cgi->param( 'show_align' );
51  my $show_tree    = $cgi->param( 'show_tree' );  my $show_tree    = $cgi->param( 'show_tree' );
52  my $tree_format  = $cgi->param( 'tree_format' );  my $tree_format  = $cgi->param( 'tree_format' );
53  my $tree_id      = $cgi->param( 'tree' );  my $tree_id      = $cgi->param( 'tree_id' );
54    
55  #  Let's see if we can work out missing values from other data:  #  Let's see if we can work out missing values from other data:
56    
# Line 176  Line 176 
176  #  #
177  #------------------------------------------------------------------------------  #------------------------------------------------------------------------------
178    
179  my ( $metaH, @uids, %fid_of_uid, @fids, $fid_funcH, $orgH, $aliasH );  my ( $align, $tree, $metaH, @uids, %fid_of_uid, @fids, $fid_funcH, $orgH, $aliasH );
180  if ( $ali_tree_id && ( $show_align || $show_tree ) )  if ( $ali_tree_id && ( $show_align || $show_tree ) )
181  {  {
182        if ( $show_align )
183        {
184            ( $align, $metaH ) = AlignsAndTreesServer::peg_alignment_by_ID( $ali_tree_id );
185        }
186        elsif ( $show_tree )
187        {
188            ( $tree, $metaH ) = AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );
189        }
190        else
191        {
192      $metaH = AlignsAndTreesServer::peg_alignment_metadata( $ali_tree_id );      $metaH = AlignsAndTreesServer::peg_alignment_metadata( $ali_tree_id );
193        }
194    
195      $metaH && %$metaH      $metaH && %$metaH
196          or push @html, cgi->h2( "No data for alignment and tree '$ali_tree_id'." );          or push @html, cgi->h2( "No data for alignment and tree '$ali_tree_id'." );
197    
# Line 194  Line 206 
206      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
207    
208      my $sapObject = SAPserver->new();      my $sapObject = SAPserver->new();
209      my $fid_funcH = $sapObject->ids_to_functions( -ids => \@fids ) || {};      $fid_funcH = $sapObject->ids_to_functions( -ids => \@fids ) || {};
210    
211      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
212      #  Get the organism names:      #  Get the organism names:
213      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
214    
215      my $orgH = $sapObject->ids_to_genomes( -ids => \@fids, -name => 1 );      $orgH = $sapObject->ids_to_genomes( -ids => \@fids, -name => 1 );
216    
217      #------------------------------------------------------------------      #------------------------------------------------------------------
218      #  Aliases      #  Aliases
# Line 208  Line 220 
220      my %alias;      my %alias;
221      if ( $show_aliases ) { 0 }      if ( $show_aliases ) { 0 }
222      $aliasH = \%alias;      $aliasH = \%alias;
223        # push @html, '<PRE>', Dumper( $fid_funcH, $orgH ), '</PRE>';
224  }  }
225    
226    
# Line 218  Line 231 
231  if ( $show_align )  if ( $show_align )
232  {  {
233      #----------------------------------------------------------------------      #----------------------------------------------------------------------
234      #  Get the alignment.      #  Got the alignment above
235      #----------------------------------------------------------------------      #----------------------------------------------------------------------
   
     my $align = AlignsAndTreesServer::peg_alignment_by_ID( $ali_tree_id );  
236      $align && @$align      $align && @$align
237          or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );          or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );
238    
# Line 241  Line 252 
252                                     )                                     )
253                        }                        }
254                    @$align;                    @$align;
255    
256          push @html, join( "\n",          push @html, join( "\n",
257                            "<PRE>",                            "<PRE>",
258                            ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),                            ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),
# Line 255  Line 267 
267    
268      elsif ( $align && @$align )      elsif ( $align && @$align )
269      {      {
         #----------------------------------------------------------------------  
         #  Build a function-to-color translation table based on frequency of  
         #  function. Normally white is reserved for the current function, but  
         #  there is none here. Assign colors until we run out, then go gray.  
         #  Undefined function is not in %func_color, and so is not in  
         #  %formatted_func  
         #----------------------------------------------------------------------  
   
         my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );  
         # my %formatted_func = &FIGgjo::colorize_functions( $fid_funcH );  
   
270          my ( $align2, $legend );          my ( $align2, $legend );
271    
272          #  Color by residue type:          #  Color by residue type:
# Line 286  Line 287 
287    
288          #  Add organism names:          #  Add organism names:
289    
290          foreach ( @$align2 ) { $_->[1] = $orgH->{ $_->[0] } }          foreach ( @$align2 ) { $_->[1] = $orgH->{ $_->[0] || '' } }
291    
292          #  Build a tool tip with organism names and functions:          #  Build a tool tip with organism names and functions:
293    
294          my %tips = map { $_ => [ $_, join( $cgi->hr, $orgH->{ $_ }, $fid_funcH->{ $_ } ) ] }          my %tips = map { $_ => [ $_, join( $cgi->hr, $orgH->{ $_ }, $fid_funcH->{ $_ } ) ] }
295                     @checked;                     map { $_->[0] }
296                       @$align2;
297          $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];          $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];
298          $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];          $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];
299    
300          my %param2 = ( align   => $align2,          my %param2 = ( align   => $align2,
                        ( $legend ? ( legend  => $legend ) : () ),  
301                         tooltip => \%tips                         tooltip => \%tips
302                       );                       );
303            $param2{ legend } = $legend if $legend;
304    
305          push @html, join( "\n",          push @html, join( "\n",
306                             scalar gjoalign2html::alignment_2_html_table( \%param2 ),                             scalar gjoalign2html::alignment_2_html_table( \%param2 ),
# Line 314  Line 316 
316    
317  if ( $show_tree )  if ( $show_tree )
318  {  {
319      my $tree = AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );      $tree ||= AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );
320      $tree or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );      $tree or push @html, cgi->h2( "No data for tree '$ali_tree_id'." );
321    
322      push @html, "<h2>Tree $ali_tree_id</h2>\n"  if $tree;      push @html, "<h2>Tree $ali_tree_id</h2>\n"  if $tree;
323    
     my @tips = $tree ? gjonewicklib::newick_tip_list( $tree ) : ();  
   
324      #------------------------------------------------------------------      #------------------------------------------------------------------
325      #  Newick tree      #  Newick tree
326      #------------------------------------------------------------------      #------------------------------------------------------------------
# Line 342  Line 342 
342                                                           undef                                                           undef
343                                 ) ) )                                 ) ) )
344          {          {
   
345              #------------------------------------------------------------------              #------------------------------------------------------------------
346              #  Formulate the desired labels              #  Formulate the desired labels
347              #------------------------------------------------------------------              #------------------------------------------------------------------
348              my %labels;              my %labels;
349              foreach my $id ( @tips )              foreach my $id ( @uids )
350              {              {
351                  my   $peg = $fid_of_uid{ $id };                  my   $peg = $fid_of_uid{ $id };
352                  my   @label;                  my   @label;
353                  push @label, $id;                  push @label, $id;
                 push @label, "[$orgH->{$peg}]"             if $orgH->{ $peg };  
354                  push @label, $fid_funcH->{ $peg }          if $fid_funcH->{ $peg };                  push @label, $fid_funcH->{ $peg }          if $fid_funcH->{ $peg };
355                    push @label, "[$orgH->{$peg}]"             if $orgH->{ $peg };
356                  push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };                  push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };
357    
358                  $labels{ $id } = join( ' ', @label );                  $labels{ $id } = join( ' ', @label );
# Line 402  Line 401 
401      else      else
402      {      {
403          #------------------------------------------------------------------          #------------------------------------------------------------------
         #  Build checkboxes and radio buttons for appropriate sequences:  
         #------------------------------------------------------------------  
   
         my %check;  
         my @translatable = grep { $fig->translatable( $_ ) } @checked;  
         %check = map { $_ => qq(<INPUT Type=checkbox Name=checked Value="$_">) }  
                  @translatable;  
   
         my %from;  
         if ( $user )  
         {  
             %from = map { m/value=\"([^\"]+)\"/; $1 => $_ }  
                     $cgi->radio_group( -name     => 'from',  
                                        -nolabels => 1,  
                                        -override => 1,  
                                        -values   => [ @translatable ],  
                                        -default  => $fid  
                                     );  
         }  
   
         #------------------------------------------------------------------  
404          #  Formulate the desired labels:          #  Formulate the desired labels:
405          #------------------------------------------------------------------          #------------------------------------------------------------------
406            #  Build a function-to-color translation table based on frequency of
407            #  function. Normally white is reserved for the current function, but
408            #  there is none here. Assign colors until we run out, then go gray.
409            #  Undefined function is not in %func_color, and so is not in
410            #  %formatted_func
411            #----------------------------------------------------------------------
412          my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );          my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );
413    
414          my %labels;          my %labels;
415          foreach my $peg ( @checked )          foreach my $id ( @uids )
416          {          {
417                my   $peg = $fid_of_uid{ $id };
418              my   @label;              my   @label;
419              push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';              push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';
420              push @label, $check{ $peg }                          if $check{ $peg };              push @label, qq(<INPUT Type=checkbox Name=checked Value="$peg">);
421              push @label, $from{ $peg }                           if $from{ $peg };              push @label, qq(<INPUT Type=radio    Name=from    Value="$peg">)  if $fid_funcH->{ $peg };
422              push @label, $formatted_func{ $fid_funcH->{ $peg } } if $fid_funcH->{ $peg };              push @label, $formatted_func{ $fid_funcH->{ $peg } } if $fid_funcH->{ $peg };
423              push @label, "[$orgH->{$peg}]"                       if $orgH->{ $peg };              push @label, "[$orgH->{$peg}]"                       if $orgH->{ $peg };
424              push @label, html_esc( $aliasH->{ $peg } )           if $aliasH->{ $peg };              push @label, html_esc( $aliasH->{ $peg } )           if $aliasH->{ $peg };
425    
426              $labels{ $peg } = join( ' ', @label );              $labels{ $id } = join( ' ', @label );
427          }          }
428    
429          #------------------------------------------------------------------          #------------------------------------------------------------------
# Line 539  Line 525 
525          push @html, $cgi->h2( "Select an Alignment and/or Tree" );          push @html, $cgi->h2( "Select an Alignment and/or Tree" );
526    
527          push @html, join( "\n",          push @html, join( "\n",
528                            'Select an alignment: ',                            'Select an alignment/tree ID: ',
529                            $cgi->start_form( -method => 'post',                            $cgi->start_form( -method => 'post',
530                                              -action => 'align_and_tree.cgi',                                              -action => 'align_and_tree.cgi',
531                                              -name   => 'align_and_tree'                                              -name   => 'align_and_tree'

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3