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

Diff of /FigWebServices/heat_map.cgi

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

revision 1.14, Tue Jun 20 03:56:31 2006 UTC revision 1.15, Tue Jun 20 16:09:03 2006 UTC
# Line 120  Line 120 
120  }  }
121    
122  my @data;  my @data;
123  foreach my $ss (keys %$scores)  foreach my $arr (&right_classification([keys %$scores]))
 {  
     my @class=@{$fig->subsystem_classification($ss)};  
     if (  
         (  
             $cgi->param('limit') &&  
             ($cgi->param('limit') eq "unclassified" && !$class[0]) ||  
             ($cgi->param('limit') eq $class[0])  
         ) ||  
         !$cgi->param('limit')  
       )  
124      {      {
125        my $ss=$arr->[2];
126          foreach my $sc (@{$scores->{$ss}}) {($sc > $max) ? ($max=$sc) : 1}          foreach my $sc (@{$scores->{$ss}}) {($sc > $max) ? ($max=$sc) : 1}
127          push @data, [@class, $ss, @{$scores->{$ss}}];      push @data, [@$arr, @{$scores->{$ss}}];
     }  
128  }  }
129    
130  #fix the effective maximum if we have set it  #fix the effective maximum if we have set it
# Line 294  Line 284 
284    
285    
286      # read the xipe attribute for significant differences      # read the xipe attribute for significant differences
287      my $xipe; my $seen;      my $xipe; my $seen; my @allss;
288      foreach my $i (0 .. $#genomes)      foreach my $i (0 .. $#genomes)
289      {      {
290          foreach my $attr (sort {lc($a->[2]) cmp lc($b->[2])} $fig->get_attributes($genomes[$i], "xipe"))          foreach my $attr (sort {lc($a->[2]) cmp lc($b->[2])} $fig->get_attributes($genomes[$i], "xipe"))
# Line 305  Line 295 
295              # this is a hack to ignore things with > 1 entry. We should clean this up and show based on confidence              # this is a hack to ignore things with > 1 entry. We should clean this up and show based on confidence
296              next if ($seen->{$genomes[$i]}->{$pieces[0]}->{$pieces[1]});              next if ($seen->{$genomes[$i]}->{$pieces[0]}->{$pieces[1]});
297              $seen->{$genomes[$i]}->{$pieces[0]}->{$pieces[1]}=1;              $seen->{$genomes[$i]}->{$pieces[0]}->{$pieces[1]}=1;
298                push @allss, $pieces[1];
299              push @{$xipe->{$genomes[$i]}->[$idx->{$pieces[0]}]}, $pieces[1];              push @{$xipe->{$genomes[$i]}->[$idx->{$pieces[0]}]}, $pieces[1];
300          }          }
301      }      }
302    
303        my %wantedss; # limit by classification choice
304        map {$wantedss{$_->[2]}=1} &right_classification(\@allss);
305    
306        # we want to make a table where the first column in the table is the genome name and the other columns are the ss, one per line
307        # the problem is that we don't know which column has the most ss and we don't know which ones we'll ignore yet.
308        # so we use added to determine whether any column in that row has data, and we use more to see whether any genome has potential data
309        # left in it. This allows us to trim based on selected ss.
310      my $tab;      my $tab;
311      foreach my $genome (keys %$xipe)      foreach my $genome (keys %$xipe)
312      {      {
313          my $added=1;          my $added; my $more=1;
314          while ($added)          while ($more)
315          {          {
316              undef $added;              undef $more;
317              my $row=[[$fig->genus_species($genome) . " <br />\n ($genome)", "td class=\"bordered\""]];              my $row=[[$fig->genus_species($genome) . " <br />\n ($genome)", "td class=\"bordered\""]];
318              for (my $i=1; $i<=$#genomes+1; $i++)              for (my $i=1; $i<=$#genomes+1; $i++)
319              {              {
320                  my $cell=shift @{$xipe->{$genome}->[$i]};                  my $cell=shift @{$xipe->{$genome}->[$i]};
321                  if ($cell) {$row->[$i]=[$cell, "td class=\"bordered\""]; $added=1}                  if ($cell) {$more=1}
322                    undef ($cell) unless ($wantedss{$cell});
323                    if ($cell)
324                    {
325                        $row->[$i]=[$cell, "td class=\"bordered\""];
326                        $added=1;
327                    }
328                  else {$row->[$i]=" &nbsp; "}                  else {$row->[$i]=" &nbsp; "}
329              }              }
330              if ($added) {push @$tab, $row}              if ($added) {push @$tab, $row; undef $added}
331          }          }
332      }      }
333    
# Line 346  Line 349 
349      #$raelib->tab2excel($hdrs, $texttab, "SigDiff", \%options, $options{"excelfile"});      #$raelib->tab2excel($hdrs, $texttab, "SigDiff", \%options, $options{"excelfile"});
350  }  }
351    
352    # take a reference to an array of subsystems and only return those ones that we are interested in
353    
354    sub right_classification {
355        my $arr=shift;
356        my @data;
357        foreach my $ss (@$arr)
358        {
359            my @class=@{$fig->subsystem_classification($ss)};
360            if (
361                    (
362                     $cgi->param('limit') &&
363                     ($cgi->param('limit') eq "unclassified" && !$class[0]) ||
364                     ($cgi->param('limit') eq $class[0])
365                    ) ||
366                    !$cgi->param('limit')
367               )
368            {
369                push @data, [@class, $ss];
370            }
371        }
372        return @data;
373    }
374    

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3