[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.2, Wed Feb 2 22:08:56 2005 UTC revision 1.3, Thu Feb 3 19:36:47 2005 UTC
# Line 49  Line 49 
49  -show_function  <peg number>                    Show function every <peg number> pegs in target genome  -show_function  <peg number>                    Show function every <peg number> pegs in target genome
50  -tick_mark_height <pixels>                      Height of the tick marks to show (default=3)  -tick_mark_height <pixels>                      Height of the tick marks to show (default=3)
51  -genome_lines   <boolean>                       Draw lines where the genome should be  -genome_lines   <boolean>                       Draw lines where the genome should be
52    -twostrands     <boolean>                       Put the boxes on two different strands for fwd and reverse (complement)
53    -bluescale      <boolean>                       The default is to have darkest be a red color. This will make it a blue color
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.
55    
56  Other things  Other things
57  -abrrev         <boolean>                       Use abbreviated names (default=1)  -abrrev         <boolean>                       Use abbreviated names (default=1)
# Line 67  Line 70 
70   my $self = bless{},$class;   my $self = bless{},$class;
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 genome_lines]) {   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]) {
75    $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})    $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})
76   }   }
77   foreach my $arg (qw[box_score abrrev]) {   foreach my $arg (qw[box_score abrrev 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    
81     foreach my $arr ($args{"-scalefactor"}) {
82      $self->{'scale'}->{$arr->[0]}=$arr->[1];
83     }
84    
85    
86   $args{'-compare_to'} && $self->compareto($args{'-compare_to'});   $args{'-compare_to'} && $self->compareto($args{'-compare_to'});
87    
88   # predefined things   # predefined things
# Line 84  Line 93 
93   $self->{'bot_marg'}    =20     unless (defined $self->{'bot_marg'});   $self->{'bot_marg'}    =20     unless (defined $self->{'bot_marg'});
94   $self->{'rows'}                =1      unless (defined $self->{'rows'});   $self->{'rows'}                =1      unless (defined $self->{'rows'});
95   $self->{'tick_mark_height'}    =3      unless (defined $self->{'tick_mark_height'});   $self->{'tick_mark_height'}    =3      unless (defined $self->{'tick_mark_height'});
96     $self->{'maxn'}        =50     unless (defined $self->{'maxn'});
97     $self->{'maxp'}        =1e-5   unless (defined $self->{'maxp'});
98    
99   # 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
100   # we also need to add room for the target genome track.   # we also need to add room for the target genome track.
# Line 105  Line 116 
116   args:          A reference to an array of things to add to the comparisons   args:          A reference to an array of things to add to the comparisons
117   returns:       A reference to an array  of things that we will compare to   returns:       A reference to an array  of things that we will compare to
118    
119     Things we understand are:
120            genome number \d+\.\d+
121            tagvalue pairs: must be as a ref to an array, and the first element MUST be 'tagvalue'
122                    the second element must be the tag, and the optional third and fourth elements
123                    are cutoff values - anything below the third cutoff and above the fourth cutoff
124                    will not be shown.
125    
126  =cut  =cut
127    
128  sub compareto {  sub compareto {
129   my ($self, $ct)=@_;   my ($self, $ct)=@_;
130   if ($ct) {   push (@{$self->{'compareto'}}, @$ct) if ($ct);
   if (ref($ct) eq "ARRAY") {push (@{$self->{'compareto'}}, @$ct)}  
   else {push (@{$self->{'compareto'}}, $ct)}  
  }  
131   return $self->{'compareto'};   return $self->{'compareto'};
132  }  }
133    
# Line 181  Line 196 
196   {   {
197    my $gp=$self->{'top_marg'}+$self->{'box_height'};    my $gp=$self->{'top_marg'}+$self->{'box_height'};
198    foreach my $simgen ($self->{'genome'}, @{$self->{'compareto'}}) {    foreach my $simgen ($self->{'genome'}, @{$self->{'compareto'}}) {
199     $self->{'track'}->{$simgen}=$self->{'svg'}->group(id=>"${simgen}_group");     # we have to copy this so we don't alter the one in the array
200     $self->{'trackposn'}->{$simgen}=$gp;     my $test_gen=$simgen;
201     my $an=$fig->genus_species($simgen);     my $an;
202     if ($an =~ /salmonella/i) {$an =~ s/Salmonella/S/; $an =~ s/\s+enterica subsp. enterica serovar\s+/ /}     if (ref($test_gen) eq "ARRAY") {
203        # it is a reference to an array (hence tag val pairs, so we want the 2nd item
204     if ($self->{'abbrev'}) {$an=$fig->abbrev($fig->genus_species($simgen))}      $test_gen=$test_gen->[1];
205     $self->{'label'}->{$simgen}=$an;      $an=$test_gen;
206       }
207       $self->{'track'}->{$test_gen}=$self->{'svg'}->group(id=>"${test_gen}_group");
208       $self->{'trackposn'}->{$test_gen}=$gp;
209    
210       # if testgen is a genome (an is not defined) so we need to get the genome name
211    
212       if (!$an && $self->{'abbrev'}) {$an=$fig->abbrev($fig->genus_species($test_gen))}
213       elsif (!$an) {$an=$fig->genus_species($test_gen)}
214       $self->{'label'}->{$test_gen}=$an;
215     $gp+=3*$self->{'box_height'};     $gp+=3*$self->{'box_height'};
216    }    }
217   }   }
# Line 349  Line 373 
373    }    }
374    
375    # now for each peg we need to figure out what we need to add    # now for each peg we need to figure out what we need to add
376      # figure out the strand
377      my $comp=0;
378      if ($self->{'twostrands'} && $start > $stop) {$comp=1}
379    foreach my $match (@{$self->compareto()}) {    foreach my $match (@{$self->compareto()}) {
380     if ($match =~ /^\d+\.\d+/) {     next unless ($match);
381       if (ref($match) eq "ARRAY" && $match->[0] eq "tagvalue") {
382        # deal with tag value pairs
383        $self->_plot_tag_value($peg, $x, $boxwidth, $row, $comp, $match);
384       }
385       elsif ($match =~ /^\d+\.\d+/) {
386      # it is a genome      # it is a genome
     my $comp=0;  
     if ($start > $stop) {$comp=1}  
387      $self->_plot_sims($peg, $x, $boxwidth, $row, $match, $comp);      $self->_plot_sims($peg, $x, $boxwidth, $row, $match, $comp);
388     }     }
389     else {     else {
# Line 392  Line 422 
422  }  }
423    
424    
425    =head2 _plot_tag_value
426    
427     An internal method to plot tag value pairs.
428     Takes the following as arguments:
429       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),
430       and then a reference to the tagvalue pairs
431    
432       The last element must be a reference to an array with the following four items:
433       'tagvalue' (ignored - just a boolean for this)
434       'tag' -- tag that is used for the plot
435       'minimum' -- optional, if supplied minimum cutoff
436       'maximum' -- optional, if supplied maximum cutoff
437    
438    =cut
439    
440    sub _plot_tag_value {
441     my ($self, $peg, $x, $boxwidth, $row, $comp, $tv)=@_;
442     my $y=$self->{'trackposn'}->{$tv->[1]};
443     if ($comp) {$y-=$self->{'box_height'}}
444     my $min=$tv->[2] if ($tv->[2]);
445     my $max=$tv->[3] if ($tv->[3]);
446    
447     my @attr = $fig->feature_attributes($peg);
448     if (@attr > 0) {
449      foreach $_ (@attr) {
450       my($tag,$val,$url) = @$_;
451       next unless ($tag eq $tv->[1]);
452    
453       # we are going to test if it is a number. If it is not a number, we don't want to check min/max
454       my $number=1;
455       eval {
456        use warnings; # make sure we warn
457        local $SIG{__WARN__} = sub {die $_[0]}; # die if there is a warning
458        $val+=0; # generate the warning
459       };
460       undef $number if ($@);
461    
462       next if ($number && $min && $val < $min);
463       next if ($number && $max && $val > $max);
464    
465       # now color the box. We can do this based on the number. We should probably have a scale factor here, but I don't know what it is
466       # so we'll let people supply it.
467       my @color=(0,1,1); # maybe 1,1,1?
468       if ($number) {
469        @color=map {int(255 * $_)} my_color($number * $self->{'scale'}->{$tv->[1]});
470       }
471       if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
472       if ($self->{'box_score'}) {
473       $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
474            width=>$boxwidth, id=>$tv->[1].$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
475       } else {
476        $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
477            width=>$boxwidth, id=>$tv->[1].$peg, style => {stroke => "none", fill => "rgb(@color)"});
478       }
479      }
480     }
481    }
482    
483    
484    
485  =head2 _plot_sims  =head2 _plot_sims
486    
487   An internal method to add the similarities to the image   An internal method to add the similarities to the image
# Line 406  Line 496 
496   ##### PLOT SIMS #####   ##### PLOT SIMS #####
497   # find the sims for the genomes that we need   # find the sims for the genomes that we need
498   my ($self, $peg, $x, $boxwidth, $row, $simgen, $comp)=@_;   my ($self, $peg, $x, $boxwidth, $row, $simgen, $comp)=@_;
  my ($maxN, $maxP)=(50, 1e-5);  
499   my %seensims; #  genomes we have seen sims from for this peg. So we only get the best hit   my %seensims; #  genomes we have seen sims from for this peg. So we only get the best hit
500   foreach my $sim ($fig->sims($peg, $maxN, $maxP, 'fig')) {   foreach my $sim ($fig->sims($peg, $self->{'maxn'}, $self->{'maxp'}, 'fig')) {
501    next unless ($fig->genome_of($$sim[1]) == $simgen && defined $self->{'trackposn'}->{$fig->genome_of($$sim[1])});    next unless ($fig->genome_of($$sim[1]) == $simgen && defined $self->{'trackposn'}->{$fig->genome_of($$sim[1])});
502    # figure out the y posn    # figure out the y posn
503    my $y=$self->{'trackposn'}->{$simgen};    my $y=$self->{'trackposn'}->{$simgen};
# Line 418  Line 507 
507    # color at the moment is on a red based scale, but I'd rather have it on a blue based scale as i am in a blue mood    # color at the moment is on a red based scale, but I'd rather have it on a blue based scale as i am in a blue mood
508    # (though not down in the dumps, I just like the color blue)    # (though not down in the dumps, I just like the color blue)
509    # swap r and b, leave g the same    # swap r and b, leave g the same
510    ($color[0], $color[3])=($color[3], $color[0]);    if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
511    
512    #now we need to make a box:    #now we need to make a box:
513    #x from $x length $boxwidth    #x from $x length $boxwidth
# Line 451  Line 540 
540   for (my $row=0; $row <= $self->{'rowcount'}; $row++) {   for (my $row=0; $row <= $self->{'rowcount'}; $row++) {
541    foreach my $contig (keys %{$self->{'rowinfo'}->{$row}}) {    foreach my $contig (keys %{$self->{'rowinfo'}->{$row}}) {
542     my ($start, $end)=($self->{'rowinfo'}->{$row}->{$contig}->{'start'}, $self->{'rowinfo'}->{$row}->{$contig}->{'end'});     my ($start, $end)=($self->{'rowinfo'}->{$row}->{$contig}->{'start'}, $self->{'rowinfo'}->{$row}->{$contig}->{'end'});
    print STDERR "Working on $contig in $row line is from $start to $end\n";  
543     foreach my $simgen (keys %{$self->{'trackposn'}}) {     foreach my $simgen (keys %{$self->{'trackposn'}}) {
544      $self->{'rowgroup'}->{$row}->line(id=>"line_${simgen}_${contig}_$row",      $self->{'rowgroup'}->{$row}->line(id=>"line_${simgen}_${contig}_$row",
545           x1=>$start, x2=>$end, y1=>$self->{'trackposn'}->{$simgen}, y2=>$self->{'trackposn'}->{$simgen});           x1=>$start, x2=>$end, y1=>$self->{'trackposn'}->{$simgen}, y2=>$self->{'trackposn'}->{$simgen});

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3