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

Diff of /FigKernelPackages/raedraw.pm

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

revision 1.5, Fri Feb 4 00:38:17 2005 UTC revision 1.6, Fri Feb 4 06:59:46 2005 UTC
# Line 54  Line 54 
54  -scalefactor    ([tag, scale])                  An array of tuples on which to scale the numbers in tag/value pairs. Should end up so max no. is 1.  -scalefactor    ([tag, scale])                  An array of tuples on which to scale the numbers in tag/value pairs. Should end up so max no. is 1.
55    
56  Other things  Other things
57  -abrrev         <boolean>                       Use abbreviated names (default=1)  -abbrev         <boolean>                       Use abbreviated names (default=1)
58  -stopshort      <peg count>          Stop after drawing <peg count> pegs (just for development)  -stopshort      <peg count>          Stop after drawing <peg count> pegs (just for development)
59    
60    
# Line 71  Line 71 
71    
72   # parse out the arguments that are handed in   # parse out the arguments that are handed in
73   foreach my $arg (qw[genome width margin top_marg bottom_marg box_height rows show_function stopshort box_no_score tick_mark_height   foreach my $arg (qw[genome width margin top_marg bottom_marg box_height rows show_function stopshort box_no_score tick_mark_height
74   genome_lines maxn maxp bluescale]) {   genome_lines maxn maxp bluescale user]) {
75    $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})    $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})
76   }   }
77   foreach my $arg (qw[box_score abrrev twostrands]) {   foreach my $arg (qw[box_score abbrev twostrands]) {
78    if (defined $args{"-".$arg}) {$self->{$arg}=$args{"-".$arg}} else {$self->{$arg}=$args{"-".$arg}=1}    if (defined $args{"-".$arg}) {$self->{$arg}=$args{"-".$arg}} else {$self->{$arg}=$args{"-".$arg}=1}
79   }   }
80    
# Line 97  Line 97 
97   $self->{'maxp'}        =1e-5   unless (defined $self->{'maxp'});   $self->{'maxp'}        =1e-5   unless (defined $self->{'maxp'});
98    
99    
100     # predefine some color things
101     $self->{'brightness'}=100;
102     $self->{'saturation'}=100;
103     $self->{'maxhue'}=0;
104    
105   # each genome gets 3 box heights, and we have 2 top/bottom margins   # each genome gets 3 box heights, and we have 2 top/bottom margins
106   # we also need to add room for the target genome track.   # we also need to add room for the target genome track.
107   $self->{'height'}=(3 * $self->{'box_height'}* (scalar @{$self->compareto()} +1)) + ($self->{'top_marg'} + $self->{'bot_marg'});   $self->{'height'}=(3 * $self->{'box_height'}* (scalar @{$self->compareto()} +1)) + ($self->{'top_marg'} + $self->{'bot_marg'});
# Line 203  Line 208 
208     if (ref($test_gen) eq "ARRAY") {     if (ref($test_gen) eq "ARRAY") {
209      # it is a reference to an array (hence tag val pairs, so we want the 2nd item      # it is a reference to an array (hence tag val pairs, so we want the 2nd item
210      $test_gen=$test_gen->[1];      $test_gen=$test_gen->[1];
211      $an=$test_gen;      if ($test_gen eq "pirsf") {$an = "PIR Superfamilies"}
212        else {$an=uc($test_gen)}
213       }
214       elsif ($test_gen eq "subsystems") {
215        $an = "FIG Subsystems";
216     }     }
217     $self->{'track'}->{$test_gen}=$self->{'svg'}->group(id=>"${test_gen}_group");     $self->{'track'}->{$test_gen}=$self->{'svg'}->group(id=>"${test_gen}_group");
218     $self->{'trackposn'}->{$test_gen}=$gp;     $self->{'trackposn'}->{$test_gen}=$gp;
# Line 324  Line 333 
333   foreach my $peg ($fig->pegs_of($self->{'genome'})) {   foreach my $peg ($fig->pegs_of($self->{'genome'})) {
334    $pegcount++;    $pegcount++;
335    last if ($self->{'stopshort'} && $self->{'stopshort'} == $pegcount);    last if ($self->{'stopshort'} && $self->{'stopshort'} == $pegcount);
336      if ($self->{'user'} eq "master:RobE") {unless ($pegcount % 100) {print STDERR "Pegs done: $pegcount\n"}}
337    # Define the location of the box once per peg    # Define the location of the box once per peg
338    # also use this to figure out which row to add it to    # also use this to figure out which row to add it to
339    my @loc=$fig->feature_location($peg);    my @loc=$fig->feature_location($peg);
# Line 379  Line 389 
389     next unless ($match);     next unless ($match);
390     if (ref($match) eq "ARRAY" && $match->[0] eq "tagvalue") {     if (ref($match) eq "ARRAY" && $match->[0] eq "tagvalue") {
391      # deal with tag value pairs      # deal with tag value pairs
392      $self->_plot_tag_value($peg, $x, $boxwidth, $row, $comp, $match);      $self->_plot_tag_value($peg, $x, $boxwidth, $row, $match);
393       }
394       elsif ($match eq "subsystems") {
395        $self->_plot_subsystems($peg, $x, $boxwidth, $row, $match);
396     }     }
397     elsif ($match =~ /^\d+\.\d+/) {     elsif ($match =~ /^\d+\.\d+/) {
398      # it is a genome      # it is a genome
# Line 421  Line 434 
434  }  }
435    
436    
437    =head2 _plot_subsystems
438    
439     An internal method to plot a box if the peg is in a subsystem
440     Takes the following as arguments:
441       peg, position (x) where to draw the box, width of the box to draw, row (y group)
442    
443     I am going to try and color the box based on some factor of the subsystems. I will keep saturation and brightness at 50%
444     and then vary the hue from 0-360
445    
446    =cut
447    
448    sub _plot_subsystems {
449     my ($self, $peg, $x, $boxwidth, $row)=@_;
450     my $y=$self->{'trackposn'}->{'subsystems'} - (0.5 * $self->{'box_height'});
451    
452     unless (defined $self->{'maxhue'}) {$self->{'maxhue'}=-5}
453     if ($self->{'maxhue'} > 360) {
454      $self->{'maxhue'}=-5;
455      $self->{'brightness'}-=10;
456      if ($self->{'brightness'} < 0) {
457       $self->{'brightness'}=100;
458       $self->{'saturation'}-=10;
459      }
460     }
461    
462     foreach my $ss (sort $fig->subsystems_for_peg($peg))
463     {
464      next if ($ss->[0] =~ /essential/i);
465      next if ($self->{'subsystems'}->{$peg}->{$ss->[0]});
466      $self->{'subsystems'}->{$peg}->{$ss->[0]}=1;
467      unless ($self->{'hue'}->{$ss->[0]}) {$self->{'hue'}->{$ss->[0]}=$self->{'maxhue'}+5; $self->{'maxhue'}+=5}
468      my @color=($self->{'hue'}, $self->{'saturation'}, $self->{'brightness'});
469      if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
470      if ($self->{'box_score'}) {
471       $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
472            width=>$boxwidth, id=>$ss->[0].".".$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
473      } else {
474        $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
475            width=>$boxwidth, id=>$ss->[0].$peg, style => {stroke => "none", fill => "rgb(@color)"});
476      }
477     }
478    }
479    
480  =head2 _plot_tag_value  =head2 _plot_tag_value
481    
482   An internal method to plot tag value pairs.   An internal method to plot tag value pairs.
483   Takes the following as arguments:   Takes the following as arguments:
484     peg, position (x) where to draw the box, width of the box to draw, row (y group) , flag for whether to put below the line (complement essentially),     peg, position (x) where to draw the box, width of the box to draw, row (y group)
485     and then a reference to the tagvalue pairs     and then a reference to the tagvalue pairs
486    
487     The last element must be a reference to an array with the following four items:     The last element must be a reference to an array with the following four items:
# Line 437  Line 493 
493  =cut  =cut
494    
495  sub _plot_tag_value {  sub _plot_tag_value {
496   my ($self, $peg, $x, $boxwidth, $row, $comp, $tv)=@_;   my ($self, $peg, $x, $boxwidth, $row, $tv)=@_;
497   my $y=$self->{'trackposn'}->{$tv->[1]};   my $y=$self->{'trackposn'}->{$tv->[1]} - (0.5 * $self->{'box_height'});
498   if ($comp) {$y-=$self->{'box_height'}}  
499   my $min=$tv->[2] if ($tv->[2]);   my $min=$tv->[2] if ($tv->[2]);
500   my $max=$tv->[3] if ($tv->[3]);   my $max=$tv->[3] if ($tv->[3]);
501    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3