[Bioperl-l] different label colours

Horvath Tamas hota.fin at freemail.hu
Fri Apr 29 11:06:52 EDT 2005


Crabtree, Jonathan wrote:

>Hota-
>
>That's interesting.  I suspect that the problem is actually not in your
>-fontcolor subroutine, but somewhere else in your script.  Can you show
>us the rest of the code?  Either your labeled features aren't getting
>assigned a primary_tag correctly, or perhaps the primary_tag value is
>being erased somehow.  For example, maybe one of your other subroutines
>is accidentally invoking primary_tag as a setter, not a getter, as in
>$feature->primary_tag('') or $feature->primary_tag(undef)
>
>Jonathan
>
>  
>
>>-----Original Message-----
>>From: Horvath Tamas [mailto:hota.fin at freemail.hu] 
>>Sent: Friday, April 29, 2005 10:33 AM
>>To: Crabtree, Jonathan
>>Cc: Bioperl
>>Subject: Re: [Bioperl-l] different label colours
>>
>>
>>Crabtree, Jonathan wrote:
>>
>>    
>>
>>>Hi Hota-
>>>
>>>This should work.  Why don't you try inserting the following line in 
>>>your anonymous sub (after "my $feature = shift;") and then 
>>>      
>>>
>>tell us what 
>>    
>>
>>>(if anything) shows up on STDERR when you run your script:
>>>
>>>print STDERR "tag='", $feature->primary_tag, "'\n";
>>>
>>>Jonathan
>>>
>>> 
>>>
>>>      
>>>
>>>>-----Original Message-----
>>>>From: bioperl-l-bounces at portal.open-bio.org
>>>>[mailto:bioperl-l-bounces at portal.open-bio.org] On Behalf Of 
>>>>Horvath Tamas
>>>>Sent: Thursday, April 28, 2005 8:25 AM
>>>>To: Bioperl
>>>>Subject: [Bioperl-l] different label colours
>>>>
>>>>
>>>>I'm trying to use different label colours in one single
>>>>track, but the  
>>>>'sub {}' does not work for the '-fontcolor' option. Is there 
>>>>a solution? 
>>>>If not yet, where should I look over the code, to implement it?
>>>>
>>>>Hota
>>>>
>>>>PS.:
>>>>
>>>>-fontcolor => sub { my $feature = shift;
>>>>                                        return 'red' if
>>>>$feature->primary_tag =~ /mudr/i;
>>>>                                        return 'blue' if 
>>>>$feature->primary_tag =~ /zn_finger/i;
>>>>                                        return 'orange' if 
>>>>$feature->primary_tag =~ /repeat/i;
>>>>                                        return 'green' if 
>>>>$feature->primary_tag eq 'exon';
>>>>                                   },
>>>>this is how it looks like, but the label color is 
>>>>        
>>>>
>>consistently black 
>>    
>>
>>>>(though if I explicitly use -fontcolor => 'green' then the label is 
>>>>green indeed)
>>>>_______________________________________________
>>>>Bioperl-l mailing list
>>>>Bioperl-l at portal.open-bio.org 
>>>>http://portal.open-> bio.org/mailman/listinfo/bioperl-l
>>>>
>>>>   
>>>>
>>>>        
>>>>
>>>_______________________________________________
>>>Bioperl-l mailing list
>>>Bioperl-l at portal.open-bio.org 
>>>http://portal.open-bio.org/mailman/listinfo/bioperl-l
>>>
>>>
>>> 
>>>
>>>      
>>>
>>Sorry, it's pretty messed up, but anyway, it looks like: (at 
>>font color, 
>>it is always '')
>>
>>tag_at_glyph='mudr_exon'
>>tag_at_glyph='mudr_exon'
>>tag_at_glyph=''
>>tag_at_glyph='zn_finger_exon' 
>>tag_at_glyph='zn_finger_exon'tag_at_connector='
>>'
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='repeat_L'
>>tag_at_strand_arrow='repeat_L'
>>tag_at_bgcolor='repeat_L'
>>tag_at_connector='repeat_R'
>>tag_at_strand_arrow='repeat_R'
>>tag_at_bgcolor='repeat_R'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector=''
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='exon'
>>tag_at_strand_arrow='exon'
>>tag_at_bgcolor='exon'
>>tag_at_connector='last_exon'
>>tag_at_strand_arrow='last_exon'
>>tag_at_bgcolor='last_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_connector='mudr_exon'
>>tag_at_strand_arrow='mudr_exon'
>>tag_at_bgcolor='mudr_exon'
>>tag_at_fontcolor=''
>>tag_at_connector=''
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon' 
>>tag_at_connector='zn_finger_exon' tag_at_strand_arrow='zn_finger_exon'
>>tag_at_bgcolor='zn_finger_exon'
>>tag_at_fontcolor=''
>>
>>
>>    
>>
>
>
>  
>
Here's the cycle that u may need (the code is nod that clean, but... ):

foreach my $record (@$pretty) {
     my $features;
     next unless $record->{R_TIR_START}; #this is only true if the 
record is valid
 
     my $track = $panel->add_track(
           -glyph  => sub { my $feature = shift;
                                         print STDERR "tag_at_glyph='", 
$feature->primary_tag, "'\n";
                                         if ($feature->primary_tag =~ 
/mudr/i || $feature->primary_tag =~ /zn_finger/i)
                                         { return 'generic'} else { 
return 'segments';}
                                    },
                   -bgcolor =>  sub { my $feature = shift;
                                         print STDERR 
"tag_at_bgcolor='", $feature->primary_tag, "'\n";
                                         if ($feature->primary_tag =~ 
/exon/) {
                                             if ($feature->primary_tag 
=~ /mudr/) {return 'red';}
                                             elsif 
($feature->primary_tag =~ /zn_finger/i) {return 'blue';}
                                             else {return 'green';};
                                            }
                                         else {return 'orange';}
                                    },
                  -fgcolor => 'black',
                  -connector => sub { my $feature = shift;
                                         print STDERR 
"tag_at_connector='", $feature->primary_tag, "'\n";
                                         $feature->primary_tag =~ /exon/
                                         ? return 'hat' : return 'dashed';
                                           
                                    },
                  -height => 15,
                  -bump => 0,
           -label  => 1,
                  -orient => sub    { my $feature = shift;
                                         print STDERR "tag_at_orient='", 
$feature->primary_tag, "'\n";
                                         $feature->primary_tag eq 'repeat_L'
                                         ? 'E' : 'W';
                                    },
                  -fontcolor => sub { my $feature = shift;
                                         print STDERR 
"tag_at_fontcolor='", $feature->primary_tag, "'\n";
                                         return 'red' if 
$feature->primary_tag =~ /mudr/i;
                                         return 'blue' if 
$feature->primary_tag =~ /zn_finger/i;
                                         return 'orange' if 
$feature->primary_tag =~ /repeat/i;
                                         return 'green' if 
$feature->primary_tag eq 'exon';
                                    },
                  -font2color => 'green',
                  -point => 0,
                  -strand_arrow => sub  { my $feature = shift;
                                            print STDERR 
"tag_at_strand_arrow='", $feature->primary_tag, "'\n";
                                            if ($feature->primary_tag eq 
'last_exon' or $feature->primary_tag =~ /repeat/i)
                                            {return 1;} else {return 0};
                                        },
                  -description => sub {
                                   my $feature = shift;
                                   return unless 
$feature->has_tag('description');
                                   my ($description) = 
$feature->each_tag_value('description');
                                   return $description;
                                  }
          );
     print '.';
   
    $features =  new Bio::SeqFeature::Generic  (-display_name => ' ');
    $subfeature = new Bio::SeqFeature::Generic(-start   => 
$record->{L_TIR_START},
                                       -end     => $record->{L_TIR_END},
                                       -primary => 'repeat_L',
                                       -source  => 'internal',
                                       -strand => 1);
    $features->add_sub_SeqFeature( $subfeature , 'EXPAND');
    $subfeature = new Bio::SeqFeature::Generic(-start   => 
$record->{R_TIR_START},
                                       -end     => $record->{R_TIR_END},
                                       -primary => 'repeat_R',
                                       -source  => 'internal',
                                       -strand => -1,);
     $features->add_sub_SeqFeature( $subfeature , 'EXPAND');
    
     $track->add_feature($features);
     undef $features;
    my $description = $record->{SEQ_ID};
    my @starts = ();
    my @startx = ();
    my $lastend = 1;
    my $s = $record->{L_TIR_START}; my $e = $record->{R_TIR_END}; my $l 
= $record->{L_TIR_END} - $record->{L_TIR_START};
    my $ps = ${$record->{EXON_LIST}->[0]->{START}};
    my $pe = ${$record->{EXON_LIST}->[$#{$record->{EXON_LIST}}]->{START}};
    my $sc = $record->{SCORE};
   
    $description .= ", GW score: $sc, sequence $s - $e, TIR app.: $l, 
prot.: $ps - $pe ";
    
     $features = new Bio::SeqFeature::Generic  (-display_name => ' ',
                                                -tag     => {
                                                              
description => $description
                                                             }
                                                );
     my @exonlist = @{$record->{EXON_LIST}};
     my $last_exon = pop @{$record->{EXON_LIST}};
     my @prot = ();
     my $pps = 0;
     my $ppe = 0;
     my $xs = 1;
     my $xe = 1;
    
     foreach $exon (@{$record->{EXON_LIST}}) {
         my $start = ${$exon->{START}};
         push @startx , $start;
         $start -= $lastend;
         push @starts , $start;
         $lastend = ${$exon->{END}};
        
         $pps =  ${$exon->{START}}; $ppe = ${$exon->{END}};
         $xs = $xe;
         $xe = $xs + int( ($ppe - $pps)/3);
         push(@prot , "$xs - $xe");
        
        
         $subfeature = new Bio::SeqFeature::Generic  (-start   => 
${$exon->{START}},
                                                         -end     => 
${$exon->{END}},
                                                         -primary => 'exon',
                                                         -source  => 
'internal',
                                                         -strand => 1,
                                                        );
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
         my $s = ${$exon->{START}};my $e = ${$exon->{END}};print"$s - $e..";
        }
     $subfeature = new Bio::SeqFeature::Generic  (-start   => 
${$last_exon->{START}},
                                                         -end     => 
${$last_exon->{END}},
                                                         -primary => 
'last_exon',
                                                         -source  => 
'internal',
                                                         -strand => 1,
                                                        );
         $pps =  ${$last_exon->{START}}; $ppe = ${$last_exon->{END}};
         $xs = $xe;
         $xe = $xs + int( ($ppe - $pps)/3);
         push(@prot , "$xs - $xe");
        
         my $protstat = join ( ".." , @prot);
         print "\n$protstat\n";
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
           
      print "\n";
      $track->add_feature($features);
      undef $features;
      my $ms = $record->{DOMAINS}->{MUDR}->{START};
      my $me = $record->{DOMAINS}->{MUDR}->{END};
      print "!$ms !$me\n";
      my @mudr_exons = @{&calc_domain_exons($ms,$me,\@exonlist)};
      print 1;
     
      my $label = "MuDR:$ms - $me";
     
      $features = new Bio::SeqFeature::Generic  (-display_name => $label);
     
     foreach $exon (@mudr_exons) {
         $subfeature = new Bio::SeqFeature::Generic  (-start   => 
$exon->{START},
                                                         -end     => 
$exon->{END},
                                                         -primary => 
'mudr_exon',
                                                         -source  => 
'internal',
                                                         -strand => 1,
                                                        );
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
         my $s = $exon->{START};my $e = $exon->{END};print"M$s - $e..";
        }
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
           
      print "\n";
      $track->add_feature($features);
     undef $features;
     
      $ms = 0;
      $ms = 0;
     
      $ms = $record->{DOMAINS}->{Zn_finger}->{START};
      $me = $record->{DOMAINS}->{Zn_finger}->{END};
      print "!$ms !$me\n";
      @mudr_exons = @{&calc_domain_exons($ms,$me,\@exonlist)};
      print 1;
     
      $label = "Zn:$ms - $me";
     
      $features = new Bio::SeqFeature::Generic  (-display_name => $label);
     
     foreach $exon (@mudr_exons) {
         $subfeature = new Bio::SeqFeature::Generic  (-start   => 
$exon->{START},
                                                         -end     => 
$exon->{END},
                                                         -primary => 
'zn_finger_exon',
                                                         -source  => 
'internal',
                                                         -strand => 1,
                                                        );
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
         my $s = $exon->{START};my $e = $exon->{END};print"Z$s - $e..";
        }
         $features->add_sub_SeqFeature($subfeature,'EXPAND');
           
      print "\n";
      $track->add_feature($features) if $ms;
     undef $features;
    
    
    }


More information about the Bioperl-l mailing list