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

Diff of /FigWebServices/protein.cgi

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

revision 1.17, Fri Mar 19 18:45:37 2004 UTC revision 1.18, Sat Mar 20 02:10:23 2004 UTC
# Line 338  Line 338 
338          my $maxN   = $cgi->param('maxN')                 || 50;   #  Default 50, not 5 (GJO)          my $maxN   = $cgi->param('maxN')                 || 50;   #  Default 50, not 5 (GJO)
339          my $maxP   = $cgi->param('maxP')       ||  1.0e-5;          my $maxP   = $cgi->param('maxP')       ||  1.0e-5;
340          my $ex_raw = $cgi->param('expand_raw') ||  0;   #  Default 0, not 1 (GJO)          my $ex_raw = $cgi->param('expand_raw') ||  0;   #  Default 0, not 1 (GJO)
341            my $just_fig   = $cgi->param('just_fig')   ||  0;
342            my $hide_alias = $cgi->param('hide_alias') ||  0;
343    
344          push( @$html, $cgi->start_form(-action => "protein.cgi"));          push( @$html, $cgi->start_form(-action => "protein.cgi"));
345          if ($cgi->param('translate'))          if ($cgi->param('translate'))
# Line 352  Line 354 
354                        "MaxN: ", $cgi->textfield(-name => 'maxN', -size =>  5, -value => $maxN, -override => 1),                        "MaxN: ", $cgi->textfield(-name => 'maxN', -size =>  5, -value => $maxN, -override => 1),
355                        "Max expand: ", $cgi->textfield(-name => 'max_expand', -size =>  5, -value => $max_expand, -override => 1),                        "Max expand: ", $cgi->textfield(-name => 'max_expand', -size =>  5, -value => $max_expand, -override => 1),
356                        "MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),                        "MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
357                        "Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => 0, -override => 1, -label => ""),                        " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
358                          " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
359                        $cgi->end_form                        $cgi->end_form
360              );              );
361      }      }
# Line 517  Line 520 
520      my($fig,$cgi,$html,$peg) = @_;      my($fig,$cgi,$html,$peg) = @_;
521      my($maxN,$maxP,$expand_groups,$ex_checked);      my($maxN,$maxP,$expand_groups,$ex_checked);
522    
523      my $user = $cgi->param('user');      my $user = $cgi->param('user') || "";
     $user = $user ? $user : "";  
524      my $current_func = &trans_function_of($cgi,$fig,$peg,$user);      my $current_func = &trans_function_of($cgi,$fig,$peg,$user);
525    
526      if (! ($maxN   = $cgi->param('maxN')))      $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;
527      {      $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;
528          $maxN = 5;      $expand_groups = $cgi->param('expand_groups');
529      }      $ex_checked = $expand_groups ? "checked" : "";
530    
531      if (! ($maxP   = $cgi->param('maxP')))      my $max_expand = $cgi->param('max_expand') || 0;
532      {      my $just_fig   = $cgi->param('just_fig')   || 0;
533          $maxP = 1.0e-5;      my $hide_alias = $cgi->param('hide_alias') || 0;
     }  
   
     if ($expand_groups = $cgi->param('expand_groups'))  
     {  
         $ex_checked = "checked";  
     }  
     else  
     {  
         $ex_checked = "";  
     }  
   
   
     my $max_expand = $cgi->param('max_expand');  
     if (! defined($max_expand)) { $max_expand = 0 }  
534    
535      push(@$html,"<hr>\n");      push(@$html,"<hr>\n");
536    
# Line 553  Line 541 
541                   $cgi->hidden(-name => 'fid', -value => $peg),                   $cgi->hidden(-name => 'fid', -value => $peg),
542                   $cgi->hidden(-name => 'user', -value => $user),                   $cgi->hidden(-name => 'user', -value => $user),
543                   $cgi->submit('more similarities'),                   $cgi->submit('more similarities'),
544                     #
545                     # Do we want to stop automatically doubling the maxN value?
546                     # It changes the parameters out from under the user if they just
547                     # want to resubmit with new value of, for example, just_fig. -- GJO
548                     #
549                   "MaxN: ", $cgi->textfield(-name => 'maxN', -size => 5, -value => 2 * $maxN, -override => 1),                   "MaxN: ", $cgi->textfield(-name => 'maxN', -size => 5, -value => 2 * $maxN, -override => 1),
550                   "Max expand: ", $cgi->textfield(-name => 'max_expand', -size => 5, -value => $max_expand, -override => 1),                   "Max expand: ", $cgi->textfield(-name => 'max_expand', -size => 5, -value => $max_expand, -override => 1),
551                   "MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),                   "MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
552  #                "Expand Groups: ", $cgi->checkbox(-name => 'expand_groups', -value => 1, -checked => $ex_checked, -override => 1),                   " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
553                   "Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => 0, -override => 1, -label => ""),                   " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
554                   $cgi->end_form,                   $cgi->end_form,
555    
556                   $cgi->hr                   $cgi->hr
557           );           );
558    
559      my(@sims);      my $select = $just_fig ? "fig" : "all";
560      my $select = $cgi->param('just_fig') ? "fig" : "all";      my @sims = $fig->sims( $peg, $maxN, $maxP, $select, $max_expand );
     @sims = $fig->sims($peg,$maxN,$maxP,$select,$max_expand);  
561    
562      if (@sims)      if (@sims)
563      {      {
# Line 575  Line 567 
567                                       -values => ["",$peg,map { $_->id2 } @sims]);                                       -values => ["",$peg,map { $_->id2 } @sims]);
568    
569          my $target = "window$$";          my $target = "window$$";
570          push(@$html,          push( @$html, $cgi->start_form( -method => 'post',
                  $cgi->start_form(-method => 'post',  
571                                    -target => $target,                                    -target => $target,
572                                    -action => 'fid_checked.cgi'                                    -action => 'fid_checked.cgi'
573                                    ),                                    ),
574                   $cgi->hidden(-name => 'fid', -value => $peg),                   $cgi->hidden(-name => 'fid', -value => $peg),
575                   $cgi->hidden(-name => 'user', -value => $user),                   $cgi->hidden(-name => 'user', -value => $user),
576                   $cgi->br,                   $cgi->br,
577                   "CHECKED: ", $cgi->submit('align'),                        "For Selected (checked) sequences: ",
578                                $cgi->submit('view annotations'),$cgi->submit('show regions'));                             $cgi->submit('align'),
579                               $cgi->submit('view annotations'),
580                               $cgi->submit('show regions')
581                );
582    
583          if ($user)          if ($user)
584          {   #  Changed by GJO to derive help url from current url, not that in config          {   my $help_url = "Html/help_for_assignments_and_rules.html";
             my $help_url = $cgi->url;  
             $help_url =~ s/protein.cgi/Html\/help_for_assignments_and_rules.html/;  
585              push ( @$html, $cgi->br, $cgi->br,              push ( @$html, $cgi->br, $cgi->br,
586                             "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",                             "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",
587                             $cgi->br, $cgi->br,                             $cgi->br, $cgi->br,
# Line 615  Line 607 
607              );              );
608    
609          my $col_hdrs;          my $col_hdrs;
610            my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";
611          if ($user && $cgi->param('translate'))          if ($user && $cgi->param('translate'))
612          {          {
613              push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,              push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
614                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,
615                            "ASSIGN from/Translate to current PEG: ", shift @from                            "ASSIGN from/Translate to current PEG: ", shift @from
616                  );                  );
617              $col_hdrs = [ "ASSIGN to<br>--------<br>Translate from",              $col_hdrs = [ "ASSIGN to<hr>Translate from",
618                            "family",                            $expand_groups ? "family" : (),
619                            "size",                            $expand_groups ? "size" : (),
620                            "Similar sequence",                            "Similar sequence",
621                            "sc",                            "E-val",
622                            "region in similar sequence",                            "region in<br>similar sequence<br>$color_help",
623                            "region in $peg",                            "region in<br>$peg<br>$color_help",
624                            "ASSIGN from<br>----------<br>Translate to",                            "ASSIGN from<hr>Translate to",
625                            "Function",                            "Function",
626                            "Organism",                            "Organism",
627                            "Aliases"                            ! $hide_alias ? "Aliases" : ()
628                          ];                          ];
629          }          }
630          elsif ($user)          elsif ($user)
# Line 640  Line 633 
633                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,
634                            "ASSIGN from current PEG: ", shift @from                            "ASSIGN from current PEG: ", shift @from
635                  );                  );
636              $col_hdrs = [ "ASSIGN to<br>--------<br>SELECT",              $col_hdrs = [ "ASSIGN to<hr>SELECT",
637                            "family",                            $expand_groups ? "family" : (),
638                            "size",                            $expand_groups ? "size" : (),
639                            "Similar sequence",                            "Similar sequence",
640                            "sc",                            "E-val",
641                            "region in similar sequence",                            "region in<br>similar sequence<br>$color_help",
642                            "region in $peg",                            "region in<br>$peg<br>$color_help",
643                            "ASSIGN from",                            "ASSIGN from",
644                            "Function",                            "Function",
645                            "Organism",                            "Organism",
646                            "Aliases"                            ! $hide_alias ? "Aliases" : ()
647                          ];                          ];
648          }          }
649          else          else
650          {          {
651              push(@$html, " SELECT current PEG", $cgi->br );              push(@$html, " SELECT current PEG", $cgi->br );
652              $col_hdrs = [ "SELECT",              $col_hdrs = [ "SELECT",
653                            "family",                            $expand_groups ? "family" : (),
654                            "size",                            $expand_groups ? "size" : (),
655                            "Similar sequence",                            "Similar sequence",
656                            "sc",                            "E-val",
657                            "region in similar sequence",                            "region in<br>similar sequence<br>$color_help",
658                            "region in $peg",                            "region in<br>$peg<br>$color_help",
659                            "Function",                            "Function",
660                            "Organism",                            "Organism",
661                            "Aliases"                            ! $hide_alias ? "Aliases" : ()
662                          ];                          ];
663          }          }
664    
665          my $tab   = [];          #
666          my $title = "Similarities";          # Total rewrite of sim table code: cleaner program flow; omitting
667            # empty columns; colorizing region-of-similarity cells -- GJO
668            #
669            # Start the similarity table with "Caption" and header row
670    
671            my $ncol = @$col_hdrs;
672            push( @$html, "<TABLE border cols=$ncol>\n",
673                          "\t<Caption><h2>Similarities</h2></Caption>\n",
674                          "\t<TR>\n\t\t<TH>",
675                          join( "</TH>\n\t\t<TH>", @$col_hdrs ),
676                          "</TH>\n\t</TR>\n"
677                );
678    
679            #  Add the table data, row-by-row
680    
681            my $alia = ! $hide_alias;
682          my $sim;          my $sim;
683          foreach $sim ( @sims )          foreach $sim ( @sims )
684          {          {
685              my($psc,$family,$sz,$funcF,$id2);              my $id2  = $sim->id2;
686              $psc = $sim->psc;              my $cbox = $fig->translatable($id2) ?
687              if ($expand_groups)                         qq(<input type=checkbox name=checked value="$id2">) : "";
688              {  
689                  $id2   = $sim->id2;              my( $family, $sz, $funcF, $fam_link );
690                  if (($id2 =~ /^fig\|/) && ($family = $fig->in_family($id2)))              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = $fig->in_family($id2)))
691                  {                  {
692                      $sz     = $fig->sz_family($family);                      $sz     = $fig->sz_family($family);
693                      $funcF  = $fig->family_function($family);                  $funcF    = html_enc( $fig->family_function($family) );
694                    $fam_link = scalar &HTML::family_link( $family, $user );
695                  }                  }
696                  else                  else
697                  {                  {
698                      $sz = $funcF = "";                  $family = $sz = $funcF = $fam_link = "";
                 }  
             }  
             else  
             {  
                 ($family,$sz,$funcF) = ("","","");  
699              }              }
700    
701                my $id2_link = &HTML::set_prot_links($cgi,$id2);
702                chomp $id2_link;
703                my $psc     = $sim->psc;
704              my $ln1   = $sim->ln1;              my $ln1   = $sim->ln1;
                $id2   = $sim->id2;  
705              my $ln2   = $sim->ln2;              my $ln2   = $sim->ln2;
706              my $b1    = $sim->b1;              my $b1    = $sim->b1;
707              my $e1    = $sim->e1;              my $e1    = $sim->e1;
# Line 705  Line 710 
710              my $d1    = abs($e1 - $b1) + 1;              my $d1    = abs($e1 - $b1) + 1;
711              my $d2    = abs($e2 - $b2) + 1;              my $d2    = abs($e2 - $b2) + 1;
712              my $reg1  = "$b1-$e1 (<b>$d1/$ln1</b>)";              my $reg1  = "$b1-$e1 (<b>$d1/$ln1</b>)";
713                my $color1  = match_color( $b1, $e1, $ln1 );
714              my $reg2  = "$b2-$e2 (<b>$d2/$ln2</b>)";              my $reg2  = "$b2-$e2 (<b>$d2/$ln2</b>)";
715              my $func2 = &trans_function_of( $cgi, $fig, $id2, $user );              my $color2  = match_color( $b2, $e2, $ln2 );
716                my $radio   = $user ? shift @from : undef;
717              if ( defined( $family ) )              my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig, $id2, $user ) );
             {  
                 # Add $funcF test to get rid of blank line -- GJO  
718                  if ($funcF && $funcF ne $func2) { $func2 = "$funcF<br>$func2" }                  if ($funcF && $funcF ne $func2) { $func2 = "$funcF<br>$func2" }
719              }              my $org     = html_enc( $fig->org_of( $id2 ) );
720              else              my $aliases = $alia ? html_enc( join( ", ", $fig->feature_aliases($id2) ) )
721              {                                  : undef;
722                  $sz     = "";  
723                  $family = "";              #  Okay, everything is calculated, let's "print" the row datum-by-datum:
724    
725                push( @$html, "\t<TR>\n",
726                              "\t\t<TD Align=center>$cbox</TD>\n",
727                              $expand_groups ? "\t\t<TD>$fam_link</TD>/n" : (),
728                              $expand_groups ? "\t\t<TD>$sz</TD>\n" : (),
729                              "\t\t<TD Nowrap>$id2_link</TD>\n",
730                              "\t\t<TD Nowrap>$psc</TD>\n",
731                              "\t\t<TD Nowrap Bgcolor=$color2>$reg2</TD>\n",
732                              "\t\t<TD Nowrap Bgcolor=$color1>$reg1</TD>\n",
733                              $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),
734                              "\t\t<TD>$func2</TD>\n",
735                              "\t\t<TD>$org</TD>\n",
736                              $alia ? "\t\t<TD>$aliases</TD>\n" : (),
737                              "\t</TR>\n"
738                    );
739              }              }
740    
741              my $cbox = $fig->translatable($id2) ?          push( @$html, "</TABLE>\n" );
742                         qq(<input type="checkbox" name="checked" value="$id2">) : "";          push( @$html, $cgi->end_form );
743        }
744              my $assign_link = &assign_link($cgi,$func2,$current_func);  }
             my $id2_link = &HTML::set_prot_links($cgi,$id2);  
745    
746              #  Modifed by GJO to get rid of empty column when user is not defined  #
747              push( @$tab, [ $cbox,  #  Support functions for writing the similarities
748                             scalar &HTML::family_link( $family, $user ),  #
749                             $sz,  #  This is a sufficient set of escaping for text in HTML:
750                             $id2_link,  #
751                             $psc,  
752                             $reg2,  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
753                             $reg1,  
754                             ( $user ? shift @from : () ),  #
755                             $func2,  #  Make a background color that reflects the position and extent of a
756                             $fig->org_of($id2),  #  matching region.
757                             join( ",", $fig->feature_aliases($id2) )  #
758                           ]  #      Left side is red; right side is blue.
759    #      Long match is white or pastel; short match is saturated color.
760    #
761    
762    sub match_color {
763        my ( $b, $e, $n ) = @_;
764        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
765        # my $hue = 3/4 * 0.5*($l+$r)/$n - 1/24;
766        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
767        my $cov = ( $r - $l + 1 ) / $n;
768        my $sat = 1 - 10 * $cov / 9;
769        # my $br  = 0.8 + 0.2 * $cov;
770        my $br  = 1;
771        rgb2html( hsb2rgb( $hue, $sat, $br ) );
772    }
773    
774    #
775    #  Convert HSB to RGB.  Hue is taken to be in range 0 - 1 (red to red);
776    #
777    
778    sub hsb2rgb {
779        my ( $h, $s, $br ) = @_;
780        $h = 6 * ($h - floor($h));      # Hue is made cyclic modulo 1
781        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
782        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
783        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
784                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
785                                          :               ( 0,      1,      $h - 2 )
786                                          )
787                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
788                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
789                                          :               ( 1,      0,      6 - $h )
790                  );                  );
791        ( ( $r * $s + 1 - $s ) * $br,
792          ( $g * $s + 1 - $s ) * $br,
793          ( $b * $s + 1 - $s ) * $br
794        )
795          }          }
796    
797          push(@$html,&HTML::make_table($col_hdrs,$tab,$title,["nowrap"]));  #
798          push(@$html,$cgi->end_form);  #  Convert an RGB value to an HTML color string:
799      }  #
800    
801    sub rgb2html {
802        my ( $r, $g, $b ) = @_;
803        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
804        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
805        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
806        sprintf("\"#%02x%02x%02x\"", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
807    }
808    
809    #
810    #  floor could be gotten from POSIX::, but why bother?
811    #
812    
813    sub floor {
814        my $x = $_[0];
815        defined( $x ) || return undef;
816        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
817  }  }
818    
819    
820  ################# Context on the Chromosome ############################  ################# Context on the Chromosome ############################
821    
822  sub print_context {  sub print_context {
# Line 866  Line 937 
937      my $user = $cgi->param('user');      my $user = $cgi->param('user');
938      $user = defined($user) ? $user : "";      $user = defined($user) ? $user : "";
939    
940      my $cluster_url  = &FIG::cgi_url . "/chromosomal_clusters.cgi?prot=$peg&user=$user";      my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user";
941      my $cluster_link = "<a href=\"$cluster_url\">*</a>";      my $cluster_link = "<a href=\"$cluster_url\">*</a>";
942      return $cluster_link;      return $cluster_link;
943  }  }

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3