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

Diff of /FigWebServices/subsys.cgi

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

revision 1.84, Thu Jul 7 16:31:12 2005 UTC revision 1.85, Fri Jul 8 17:03:52 2005 UTC
# Line 1364  Line 1364 
1364    
1365          my $tab = [];          my $tab = [];
1366          my($genome,@pegs,@cells,$set,$peg_set,$pair,$role,$suffix,$row,$peg,$color_of,$cell,%count,$color,@colors);          my($genome,@pegs,@cells,$set,$peg_set,$pair,$role,$suffix,$row,$peg,$color_of,$cell,%count,$color,@colors);
         foreach $genome (grep { $activeR{$_} } @in)  
         {  
             my($genomeV,$vcodeV,$vcode_value);  
             $vcode_value = $subsystem->get_variant_code($subsystem->get_genome_index($genome));  
             $row = [$genome, &ext_genus_species($fig,$genome),$vcode_value];  
   
             @pegs = ();  
             @cells = ();  
1367    
1368             my $skip = 0;          #
1369             my $good = 0;          #  Simplified code for checking variants -- GJO
1370             my $v;          #  If specific variants are requested, make a hash of those to keep:
1371            #
1372            my $variant_list = undef;
1373             if ($cgi->param('include_these_variants'))             if ($cgi->param('include_these_variants'))
1374             {             {
1375                 my @variant_list = split(',',$cgi->param('include_these_variants'));              $variant_list = { map { ($_, 1) } split( /\s*,\s*/, $cgi->param( 'include_these_variants' ) ) };
                foreach $v (@variant_list)  
                {  
                 if ($v == $vcode_value)  
                  {  
                     $good = 1;  
                  }  
1376                 }                 }
1377                 if($good == 0)  
1378            foreach $genome (grep { $activeR{$_} } @in)
1379                 {                 {
1380                     $skip = 1;              my($genomeV,$vcodeV,$vcode_value);
                }  
1381    
1382             }              #  Get (and if necessary check) the variant code:
1383    
1384             next if ($skip);              $vcode_value = $subsystem->get_variant_code( $subsystem->get_genome_index( $genome ) );
1385                next if ( $variant_list && ( ! $variant_list->{ $vcode_value } ) );
1386    
1387                $row = [$genome, &ext_genus_species($fig,$genome),$vcode_value];
1388    
1389                @pegs = ();
1390                @cells = ();
1391    
1392              foreach $set (@row_guide)              foreach $set (@row_guide)
1393              {              {
# Line 1473  Line 1466 
1466              {              {
1467               ($color_of, $superscript, $tagvalcolor) = color_by_tag($fig, \@pegs, $color_of, $tagvalcolor, $cgi->param("color_by_peg_tag"));               ($color_of, $superscript, $tagvalcolor) = color_by_tag($fig, \@pegs, $color_of, $tagvalcolor, $cgi->param("color_by_peg_tag"));
1468              }              }
1469              foreach $cell (@cells)              foreach $cell ( @cells )  #  $cell = [peg, suffix]
1470              {              {
1471                  undef %count;                  #  Deal with the trivial case (no pegs) at the start
1472                  foreach $_ (@$cell)  
1473                    if ( ! @$cell )
1474                  {                  {
1475                      if (($color = $color_of->{$_->[0]}) ne '#FFFFFF')                      #  Push an empty cell onto the row
1476    
1477                        push @$row, '@bgcolor="#FFFFFF":   ';
1478                        next;
1479                    }
1480    
1481                    #  Figure out html text for each peg and cluster by color.
1482    
1483                    my ( $peg, $suffix, $txt, $color );
1484                    my @colors = ();
1485                    my %text_by_color;   #  Gather like-colored peg text
1486                    foreach ( @$cell )
1487                      {                      {
1488                          $count{$color}++;                      ( $peg, $suffix ) = @$_;
1489                        #  Hyperlink each peg, and add its suffix:
1490                        $txt = ( $cgi->param('ext_ids') ? external_id($fig,$cgi,$peg)
1491                                                        : HTML::fid_link($cgi,$peg, "local") )
1492                             . ( $suffix ? $suffix : '' );
1493                        $color = $color_of->{ $peg };
1494                        defined( $text_by_color{ $color } ) or push @colors, $color;
1495                        push @{ $text_by_color{ $color } }, $txt;
1496                      }                      }
1497                    my $ncolors = @colors;
1498    
1499                    #  Join text strings within a color (and remove last comma):
1500    
1501                    my @str_by_color = map { [ $_, join( ', ', @{ $text_by_color{$_} }, '' ) ] } @colors;
1502                    $str_by_color[-1]->[1] =~ s/, $//;
1503    
1504                    #  Build the "superscript" string:
1505    
1506                    my $sscript = "";
1507                    if ( $superscript && @$cell )
1508                    {
1509                        my ( %sscript, $ss);
1510                        foreach my $cv ( @$cell )  #  Should this be flattened across all pegs?
1511                        {
1512                            next unless ( $ss = $superscript->{ $cv->[0] } );
1513                            my %flatten = map { ( $_, 1 ) } @$ss;
1514                            $sscript{ join ",", sort { $a <=> $b } keys %flatten } = 1;  #  string of all values for peg
1515                        }
1516                        if (scalar keys %sscript) { $sscript = "&nbsp;<sup>[" . join( ", ", keys %sscript) . "]</sup>" }
1517                  }                  }
1518                  @colors = sort { $count{$b} <=> $count{$a} } keys(%count);  
1519                  $color = (@colors > 0) ? $colors[0] : '#FFFFFF';                  my $cell_data;
1520                  my $cell_data="\@bgcolor=\"$color\":";  
1521                  $cell_data .= join(", ",map { ($cgi->param('ext_ids') ? &external_id($fig,$cgi,$_->[0]) : &HTML::fid_link($cgi,$_->[0],"local")) . $_->[1] } @$cell);                  #  If there is one color, just write a unicolor cell.
1522                  if ($superscript)  
1523                    if ( $ncolors == 1 )
1524                  {                  {
1525                   # flatten this                      my ( $color, $txt ) = @{ shift @str_by_color };
1526                   my %sscript;                      $cell_data = qq(\@bgcolor="$color":) . $txt . $sscript;
                  foreach my $cv (@$cell) {  
                   next unless ($superscript->{$cv->[0]});  
                   my %flatten;  
                   foreach my $value (@{$superscript->{$cv->[0]}}) {$flatten{$value}=1}  
                   $sscript{join ",", sort {$a <=> $b} keys %flatten}=1;  
1527                   }                   }
1528                   if (scalar keys %sscript) {$cell_data .= " &nbsp; <sup> [" . (join ", ", keys %sscript) . "] </sup> "}  
1529                    #  Otherwise, write pegs into a subtable with one cell per color.
1530    
1531                    else
1532                    {
1533                        $cell_data = '<table><tr valign=bottom>'
1534                                   . join( '', map { ( $color, $txt ) = @$_ ; qq(<td bgcolor="$color">$txt</td>) } @str_by_color )
1535                                   . ( $sscript ? '<td>$sscript</td>' : '' )
1536                                   . '</tr></table>';
1537                  }                  }
1538                  if (!$cell_data || $cell_data eq '<td bgcolor="#FFFFFF"></td>') {$cell_data = '<td bgcolor="#FFFFFF"> &nbsp; </td>'}  
1539                    #  Push the cell data onto the row:
1540    
1541                  push(@$row, $cell_data);                  push(@$row, $cell_data);
                 #push(@$row,"\@bgcolor=\"$color\":" . join(", ",map { ($cgi->param('ext_ids') ? &external_id($fig,$cgi,$_->[0]) : &HTML::fid_link($cgi,$_->[0],"local")) . $_->[1] } @$cell));  
1542              }              }
1543              push(@$tab,$row);              push(@$tab,$row);
1544          }          }
# Line 1612  Line 1649 
1649    
1650      if ($cgi->param('show_clusters'))      if ($cgi->param('show_clusters'))
1651      {      {
1652          @pegs = keys(%$color_of);          @pegs = keys(%$color_of);  #  Use of keys makes @pegs entries unique
1653    
1654          foreach $peg (@pegs)          foreach $peg (@pegs)
1655          {          {

Legend:
Removed from v.1.84  
changed lines
  Added in v.1.85

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3