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

Diff of /FigKernelPackages/Observation.pm

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

revision 1.4, Wed Jun 13 16:40:25 2007 UTC revision 1.11, Thu Jun 21 21:15:23 2007 UTC
# Line 5  Line 5 
5    
6  use strict;  use strict;
7  use warnings;  use warnings;
8    use HTML;
9    
10  1;  1;
11    
# Line 23  Line 24 
24    
25  Example:  Example:
26    
27    
28  use FIG;  use FIG;
29  use Observation;  use Observation;
30    
# Line 88  Line 90 
90  sub description {  sub description {
91    my ($self) = @_;    my ($self) = @_;
92    
93    return $self->{acc};    return $self->{description};
94  }  }
95    
96  =head3 class()  =head3 class()
# Line 100  Line 102 
102    
103  =over 9  =over 9
104    
105    =item IDENTICAL (seq)
106    
107  =item SIM (seq)  =item SIM (seq)
108    
109  =item BBH (seq)  =item BBH (seq)
# Line 182  Line 186 
186    return $self->{stop};    return $self->{stop};
187  }  }
188    
189    =head3 start()
190    
191    Start of hit in query sequence.
192    
193    =cut
194    
195    sub qstart {
196        my ($self) = @_;
197    
198        return $self->{qstart};
199    }
200    
201    =head3 qstop()
202    
203    End of the hit in query sequence.
204    
205    =cut
206    
207    sub qstop {
208        my ($self) = @_;
209    
210        return $self->{qstop};
211    }
212    
213    =head3 hstart()
214    
215    Start of hit in hit sequence.
216    
217    =cut
218    
219    sub hstart {
220        my ($self) = @_;
221    
222        return $self->{hstart};
223    }
224    
225    =head3 end()
226    
227    End of the hit in hit sequence.
228    
229    =cut
230    
231    sub hstop {
232        my ($self) = @_;
233    
234        return $self->{hstop};
235    }
236    
237    =head3 qlength()
238    
239    length of the query sequence in similarities
240    
241    =cut
242    
243    sub qlength {
244        my ($self) = @_;
245    
246        return $self->{qlength};
247    }
248    
249    =head3 hlength()
250    
251    length of the hit sequence in similarities
252    
253    =cut
254    
255    sub hlength {
256        my ($self) = @_;
257    
258        return $self->{hlength};
259    }
260    
261    
262    
263  =head3 evalue()  =head3 evalue()
264    
265  E-value or P-Value if present.  E-value or P-Value if present.
# Line 205  Line 283 
283    
284  sub score {  sub score {
285    my ($self) = @_;    my ($self) = @_;
   
286    return $self->{score};    return $self->{score};
287  }  }
288    
# Line 220  Line 297 
297    
298  =cut  =cut
299    
300  sub display_method {  sub display {
   my ($self) = @_;  
301    
302    # add code here    die "Abstract Method Called\n";
303    
   return $self->{display_method};  
304  }  }
305    
306    
307  =head3 rank()  =head3 rank()
308    
309  Returns an integer from 1 - 10 indicating the importance of this observations.  Returns an integer from 1 - 10 indicating the importance of this observations.
# Line 297  Line 373 
373  - get attributes (there is code for this that in get_attribute_based_observations  - get attributes (there is code for this that in get_attribute_based_observations
374  - get_attributes_based_observations returns an array of arrays of hashes like this"  - get_attributes_based_observations returns an array of arrays of hashes like this"
375    
376    my $datasets =    my $dataset
377       [       [
378         [ { name => 'acc', value => '1234' },         [ { name => 'acc', value => '1234' },
379          { name => 'from', value => '4' },          { name => 'from', value => '4' },
# Line 319  Line 395 
395  =cut  =cut
396    
397  sub get_objects {  sub get_objects {
398      my ($self,$fid) = @_;      my ($self,$fid,$classes) = @_;
399    
400    
401    my $objects = [];    my $objects = [];
402    my @matched_datasets=();    my @matched_datasets=();
403    
404    # call function that fetches attribute based observations    # call function that fetches attribute based observations
405    # returns an array of arrays of hashes    # returns an array of arrays of hashes
406    #  
407        if(scalar(@$classes) < 1){
408    get_attribute_based_observations($fid,\@matched_datasets);    get_attribute_based_observations($fid,\@matched_datasets);
409            get_sims_observations($fid,\@matched_datasets);
410            get_identical_proteins($fid,\@matched_datasets);
411            get_functional_coupling($fid,\@matched_datasets);
412        }
413        else{
414            #IPR,CDD,CELLO,PFAM,SIGNALP - attribute based
415            my %domain_classes;
416            my $identical_flag=0;
417            my $pch_flag=0;
418            my $sims_flag=0;
419            foreach my $class (@$classes){
420                if($class =~ /(IPR|CDD|PFAM)/){
421                    $domain_classes{$class} = 1;
422                }
423                elsif ($class eq "IDENTICAL")
424                {
425                    $identical_flag = 1;
426                }
427                elsif ($class eq "PCH")
428                {
429                    $pch_flag = 1;
430                }
431                elsif ($class eq "SIM")
432                {
433                    $sims_flag = 1;
434                }
435            }
436    
437    # read sims          if ($identical_flag ==1)
438            {
439                get_identical_proteins($fid,\@matched_datasets);
440            }
441            if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {
442                get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);
443            }
444            if ($pch_flag == 1)
445            {
446                get_functional_coupling($fid,\@matched_datasets);
447            }
448            if ($sims_flag == 1)
449            {
450    get_sims_observations($fid,\@matched_datasets);    get_sims_observations($fid,\@matched_datasets);
451            }
452    
453    # read sims + bbh (enrich BBHs with sims coordindates etc)          #add CELLO and SignalP later
454    # read pchs      }
   # read figfam match data from 48hr directory (BobO knows how do do this!)  
   # what sources of evidence did I miss?  
455    
456    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
457      my $object = $self->new();          my $object;
458      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
459        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
460            }
461            if($dataset->{'class'} eq "PCH"){
462                $object = Observation::FC->new($dataset);
463            }
464            if ($dataset->{'class'} eq "IDENTICAL"){
465                $object = Observation::Identical->new($dataset);
466            }
467            if ($dataset->{'class'} eq "SIM"){
468                $object = Observation::Sims->new($dataset);
469      }      }
 #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};  
470      push (@$objects, $object);      push (@$objects, $object);
471      }      }
472    
   
473    return $objects;    return $objects;
474    
475  }  }
476    
477  =head1 Internal Methods  =head1 Internal Methods
# Line 418  Line 542 
542       return undef;       return undef;
543  }  }
544    
545    
546    sub get_attribute_based_domain_observations{
547    
548        # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
549        my ($fid,$domain_classes,$datasets_ref) = (@_);
550    
551        my $fig = new FIG;
552    
553        foreach my $attr_ref ($fig->get_attributes($fid)) {
554            my $key = @$attr_ref[1];
555            my @parts = split("::",$key);
556            my $class = $parts[0];
557    
558            if($domain_classes->{$parts[0]}){
559                my $val = @$attr_ref[2];
560                if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
561                    my $raw_evalue = $1;
562                    my $from = $2;
563                    my $to = $3;
564                    my $evalue;
565                    if($raw_evalue =~/(\d+)\.(\d+)/){
566                        my $part2 = 1000 - $1;
567                        my $part1 = $2/100;
568                        $evalue = $part1."e-".$part2;
569                    }
570                    else{
571                        $evalue = "0.0";
572                    }
573    
574                    my $dataset = {'class' => $class,
575                                   'acc' => $key,
576                                   'type' => "dom" ,
577                                   'evalue' => $evalue,
578                                   'start' => $from,
579                                   'stop' => $to
580                                   };
581    
582                    push (@{$datasets_ref} ,$dataset);
583                }
584            }
585        }
586    }
587    
588  =head3 get_attribute_based_evidence (internal)  =head3 get_attribute_based_evidence (internal)
589    
590  This method retrieves evidence from the attribute server  This method retrieves evidence from the attribute server
# Line 500  Line 667 
667    
668      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref) = (@_);
669      my $fig = new FIG;      my $fig = new FIG;
670      my @sims= $fig->nsims($fid,100,1e-20,"fig");  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");
671        my @sims= $fig->nsims($fid,100,1e-20,"all");
672      my ($dataset);      my ($dataset);
673      foreach my $sim (@sims){      foreach my $sim (@sims){
674          my $hit = $sim->[1];          my $hit = $sim->[1];
675            my $percent = $sim->[2];
676          my $evalue = $sim->[10];          my $evalue = $sim->[10];
677          my $from = $sim->[8];          my $qfrom = $sim->[6];
678          my $to = $sim->[9];          my $qto = $sim->[7];
679          $dataset = [ { name => 'class', value => "SIM" },          my $hfrom = $sim->[8];
680                          { name => 'acc' , value => $hit},          my $hto = $sim->[9];
681                          { name => 'type', value => "seq"} ,          my $qlength = $sim->[12];
682                          { name => 'evalue', value => $evalue },          my $hlength = $sim->[13];
683                          { name => 'start', value => $from},          my $db = get_database($hit);
684                          { name => 'stop' , value => $to}          my $func = $fig->function_of($hit);
685                          ];          my $organism = $fig->org_of($hit);
686    
687            $dataset = {'class' => 'SIM',
688                        'acc' => $hit,
689                        'identity' => $percent,
690                        'type' => 'seq',
691                        'evalue' => $evalue,
692                        'qstart' => $qfrom,
693                        'qstop' => $qto,
694                        'hstart' => $hfrom,
695                        'hstop' => $hto,
696                        'database' => $db,
697                        'organism' => $organism,
698                        'function' => $func,
699                        'qlength' => $qlength,
700                        'hlength' => $hlength
701                        };
702    
703            push (@{$datasets_ref} ,$dataset);
704        }
705    }
706    
707    =head3 get_database (internal)
708    This method gets the database association from the sequence id
709    
710    =cut
711    
712    sub get_database{
713        my ($id) = (@_);
714    
715        my ($db);
716        if ($id =~ /^fig\|/)              { $db = "FIG" }
717        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
718        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
719        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
720        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
721        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
722        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
723        elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }
724        elsif ($id =~ /^tr\|/)            { $db = "TrEMBL" }
725        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
726        elsif ($id =~ /^img\|/)           { $db = "JGI" }
727    
728        return ($db);
729    
730    }
731    
732    =head3 get_identical_proteins() (internal)
733    
734    This methods retrieves sims fills the internal data structures.
735    
736    =cut
737    
738    sub get_identical_proteins{
739    
740        my ($fid,$datasets_ref) = (@_);
741        my $fig = new FIG;
742        my @funcs = ();
743    
744        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
745    
746        foreach my $id (@maps_to) {
747            my ($tmp, $who);
748            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
749                $who = &get_database($id);
750                push(@funcs, [$id,$who,$tmp]);
751            }
752        }
753    
754        my ($dataset);
755        foreach my $row (@funcs){
756            my $id = $row->[0];
757            my $organism = $fig->org_of($fid);
758            my $who = $row->[1];
759            my $assignment = $row->[2];
760    
761            my $dataset = {'class' => 'IDENTICAL',
762                           'id' => $id,
763                           'organism' => $organism,
764                           'type' => 'seq',
765                           'database' => $who,
766                           'function' => $assignment
767                           };
768    
769            push (@{$datasets_ref} ,$dataset);
770        }
771    
772    }
773    
774    =head3 get_functional_coupling() (internal)
775    
776    This methods retrieves the functional coupling of a protein given a peg ID
777    
778    =cut
779    
780    sub get_functional_coupling{
781    
782        my ($fid,$datasets_ref) = (@_);
783        my $fig = new FIG;
784        my @funcs = ();
785    
786        # initialize some variables
787        my($sc,$neigh);
788    
789        # set default parameters for coupling and evidence
790        my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
791    
792        # get the fc data
793        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
794    
795        # retrieve data
796        my @rows = map { ($sc,$neigh) = @$_;
797                         [$sc,$neigh,scalar $fig->function_of($neigh)]
798                      } @fc_data;
799    
800        my ($dataset);
801        foreach my $row (@rows){
802            my $id = $row->[1];
803            my $score = $row->[0];
804            my $description = $row->[2];
805            my $dataset = {'class' => 'PCH',
806                           'score' => $score,
807                           'id' => $id,
808                           'type' => 'fc',
809                           'function' => $description
810                           };
811    
812      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
813      }      }
814  }  }
# Line 570  Line 865 
865  =cut  =cut
866    
867  sub new {  sub new {
868    my ($self) = @_;    my ($class,$dataset) = @_;
869    
870    
871      #$self = { acc => '',
872    #           description => '',
873    #           class => '',
874    #           type => '',
875    #           start => '',
876    #           stop => '',
877    #           evalue => '',
878    #           score => '',
879    #           display_method => '',
880    #           feature_id => '',
881    #           rank => '',
882    #           supports_annotation => '',
883    #           id => '',
884    #            organism => '',
885    #            who => ''
886    #         };
887    
888    $self = { acc => '',    my $self = { class => $dataset->{'class'},
889              description => '',                 type => $dataset->{'type'}
             class => '',  
             type => '',  
             start => '',  
             stop => '',  
             evalue => '',  
             score => '',  
             display_method => '',  
             feature_id => '',  
             rank => '',  
             supports_annotation => ''  
890            };            };
891    
892    bless($self, 'Observation');    bless($self,$class);
893    
894    return $self;    return $self;
895  }  }
896    
897    =head3 identity (internal)
898    
899    Returns the % identity of the similar sequence
900    
901    =cut
902    
903    sub identity {
904        my ($self) = @_;
905    
906        return $self->{identity};
907    }
908    
909  =head3 feature_id (internal)  =head3 feature_id (internal)
910    
 Returns the ID  of the feature these Observations belong to.  
911    
912  =cut  =cut
913    
# Line 602  Line 916 
916    
917    return $self->{feature_id};    return $self->{feature_id};
918  }  }
919    
920    =head3 id (internal)
921    
922    Returns the ID  of the identical sequence
923    
924    =cut
925    
926    sub id {
927        my ($self) = @_;
928    
929        return $self->{id};
930    }
931    
932    =head3 organism (internal)
933    
934    Returns the organism  of the identical sequence
935    
936    =cut
937    
938    sub organism {
939        my ($self) = @_;
940    
941        return $self->{organism};
942    }
943    
944    =head3 function (internal)
945    
946    Returns the function of the identical sequence
947    
948    =cut
949    
950    sub function {
951        my ($self) = @_;
952    
953        return $self->{function};
954    }
955    
956    =head3 database (internal)
957    
958    Returns the database of the identical sequence
959    
960    =cut
961    
962    sub database {
963        my ($self) = @_;
964    
965        return $self->{database};
966    }
967    
968    
969    
970    ############################################################
971    ############################################################
972    package Observation::Identical;
973    
974    use base qw(Observation);
975    
976    sub new {
977    
978        my ($class,$dataset) = @_;
979        my $self = $class->SUPER::new($dataset);
980        $self->{id} = $dataset->{'id'};
981        $self->{organism} = $dataset->{'organism'};
982        $self->{function} = $dataset->{'function'};
983        $self->{database} = $dataset->{'database'};
984    
985        bless($self,$class);
986        return $self;
987    }
988    
989    =head3 display()
990    
991    If available use the function specified here to display the "raw" observation.
992    This code will display a table for the identical protein
993    
994    
995    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi
996    dence.
997    
998    =cut
999    
1000    sub display{
1001        my ($self, $cgi, $dataset) = @_;
1002    
1003        my $all_domains = [];
1004        my $count_identical = 0;
1005        my $content;
1006        foreach my $thing (@$dataset) {
1007            next if ($thing->class ne "IDENTICAL");
1008            my $single_domain = [];
1009            push(@$single_domain,$thing->database);
1010            my $id = $thing->id;
1011            $count_identical++;
1012            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1013            push(@$single_domain,$thing->organism);
1014            #push(@$single_domain,$thing->type);
1015            push(@$single_domain,$thing->function);
1016            push(@$all_domains,$single_domain);
1017        }
1018    
1019        if ($count_identical >0){
1020            $content = $all_domains;
1021        }
1022        else{
1023            $content = "<p>This PEG does not have any essentially identical proteins</p>";
1024        }
1025        return ($content);
1026    }
1027    
1028    1;
1029    
1030    
1031    #########################################
1032    #########################################
1033    package Observation::FC;
1034    1;
1035    
1036    use base qw(Observation);
1037    
1038    sub new {
1039    
1040        my ($class,$dataset) = @_;
1041        my $self = $class->SUPER::new($dataset);
1042        $self->{score} = $dataset->{'score'};
1043        $self->{id} = $dataset->{'id'};
1044        $self->{function} = $dataset->{'function'};
1045    
1046        bless($self,$class);
1047        return $self;
1048    }
1049    
1050    =head3 display()
1051    
1052    If available use the function specified here to display the "raw" observation.
1053    This code will display a table for the identical protein
1054    
1055    
1056    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi
1057    dence.
1058    
1059    =cut
1060    
1061    sub display {
1062        my ($self,$cgi,$dataset, $fid) = @_;
1063    
1064        my $functional_data = [];
1065        my $count = 0;
1066        my $content;
1067    
1068        foreach my $thing (@$dataset) {
1069            my $single_domain = [];
1070            next if ($thing->class ne "PCH");
1071            $count++;
1072    
1073            # construct the score link
1074            my $score = $thing->score;
1075            my $toid = $thing->id;
1076            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1077            my $sc_link = "<a href=$link>$score</a>";
1078    
1079            push(@$single_domain,$sc_link);
1080            push(@$single_domain,$thing->id);
1081            push(@$single_domain,$thing->function);
1082            push(@$functional_data,$single_domain);
1083        }
1084    
1085        if ($count >0){
1086            $content = $functional_data;
1087        }
1088        else
1089        {
1090            $content = "<p>This PEG does not have any functional coupling</p>";
1091        }
1092        return ($content);
1093    }
1094    
1095    
1096    #########################################
1097    #########################################
1098    package Observation::Domain;
1099    
1100    use base qw(Observation);
1101    
1102    sub new {
1103    
1104        my ($class,$dataset) = @_;
1105        my $self = $class->SUPER::new($dataset);
1106        $self->{evalue} = $dataset->{'evalue'};
1107        $self->{acc} = $dataset->{'acc'};
1108        $self->{start} = $dataset->{'start'};
1109        $self->{stop} = $dataset->{'stop'};
1110    
1111        bless($self,$class);
1112        return $self;
1113    }
1114    
1115    sub display {
1116        my ($thing,$gd) = @_;
1117        my $lines = [];
1118        my $line_config = { 'title' => $thing->acc,
1119                            'short_title' => $thing->type,
1120                            'basepair_offset' => '1' };
1121        my $color = "4";
1122    
1123        my $line_data = [];
1124        my $links_list = [];
1125        my $descriptions = [];
1126    
1127        my $description_function;
1128        $description_function = {"title" => $thing->class,
1129                                 "value" => $thing->acc};
1130    
1131        push(@$descriptions,$description_function);
1132    
1133        my $score;
1134        $score = {"title" => "score",
1135                  "value" => $thing->evalue};
1136        push(@$descriptions,$score);
1137    
1138        my $link_id;
1139        if ($thing->acc =~/CDD::(\d+)/){
1140            $link_id = $1;
1141        }
1142    
1143        my $link;
1144        $link = {"link_title" => $thing->acc,
1145                 "link" => "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"};
1146        push(@$links_list,$link);
1147    
1148        my $element_hash = {
1149            "title" => $thing->type,
1150            "start" => $thing->start,
1151            "end" =>  $thing->stop,
1152            "color"=> $color,
1153            "zlayer" => '2',
1154            "links_list" => $links_list,
1155            "description" => $descriptions};
1156    
1157        push(@$line_data,$element_hash);
1158        $gd->add_line($line_data, $line_config);
1159    
1160        return $gd;
1161    
1162    }
1163    
1164    #########################################
1165    #########################################
1166    package Observation::Sims;
1167    
1168    use base qw(Observation);
1169    
1170    sub new {
1171    
1172        my ($class,$dataset) = @_;
1173        my $self = $class->SUPER::new($dataset);
1174        $self->{identity} = $dataset->{'identity'};
1175        $self->{acc} = $dataset->{'acc'};
1176        $self->{evalue} = $dataset->{'evalue'};
1177        $self->{qstart} = $dataset->{'qstart'};
1178        $self->{qstop} = $dataset->{'qstop'};
1179        $self->{hstart} = $dataset->{'hstart'};
1180        $self->{hstop} = $dataset->{'hstop'};
1181        $self->{database} = $dataset->{'database'};
1182        $self->{organism} = $dataset->{'organism'};
1183        $self->{function} = $dataset->{'function'};
1184        $self->{qlength} = $dataset->{'qlength'};
1185        $self->{hlength} = $dataset->{'hlength'};
1186    
1187        bless($self,$class);
1188        return $self;
1189    }
1190    
1191    =head3 display()
1192    
1193    If available use the function specified here to display the "raw" observation.
1194    This code will display a table for the similarities protein
1195    
1196    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
1197    
1198    =cut
1199    
1200    sub display {
1201        my ($self,$cgi,$dataset) = @_;
1202    
1203        my $data = [];
1204        my $count = 0;
1205        my $content;
1206        my $fig = new FIG;
1207    
1208        foreach my $thing (@$dataset) {
1209            my $single_domain = [];
1210            next if ($thing->class ne "SIM");
1211            $count++;
1212    
1213            my $id = $thing->acc;
1214    
1215            # add the subsystem information
1216            my @in_sub  = $fig->peg_to_subsystems($id);
1217            my $in_sub;
1218    
1219            if (@in_sub > 0) {
1220                $in_sub = @in_sub;
1221    
1222                # RAE: add a javascript popup with all the subsystems
1223                my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;
1224                $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);
1225            } else {
1226                $in_sub = "&nbsp;";
1227            }
1228    
1229            # add evidence code with tool tip
1230            my $ev_codes=" &nbsp; ";
1231            my @ev_codes = "";
1232            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1233                my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);
1234                @ev_codes = ();
1235                foreach my $code (@codes) {
1236                    my $pretty_code = $code->[2];
1237                    if ($pretty_code =~ /;/) {
1238                        my ($cd, $ss) = split(";", $code->[2]);
1239                        $ss =~ s/_/ /g;
1240                        $pretty_code = $cd;# . " in " . $ss;
1241                    }
1242                    push(@ev_codes, $pretty_code);
1243                }
1244            }
1245    
1246            if (scalar(@ev_codes) && $ev_codes[0]) {
1247                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
1248                $ev_codes = $cgi->a(
1249                                    {
1250                                        id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
1251            }
1252    
1253            # add the aliases
1254            my $aliases = undef;
1255            $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );
1256            $aliases = &HTML::set_prot_links( $cgi, $aliases );
1257            $aliases ||= "&nbsp;";
1258    
1259            my $iden    = $thing->identity;
1260            my $ln1     = $thing->qlength;
1261            my $ln2     = $thing->hlength;
1262            my $b1      = $thing->qstart;
1263            my $e1      = $thing->qstop;
1264            my $b2      = $thing->hstart;
1265            my $e2      = $thing->hstop;
1266            my $d1      = abs($e1 - $b1) + 1;
1267            my $d2      = abs($e2 - $b2) + 1;
1268            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1269            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1270    
1271    
1272            push(@$single_domain,$thing->database);
1273            push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));
1274            push(@$single_domain,$thing->evalue);
1275            push(@$single_domain,"$iden\%");
1276            push(@$single_domain,$reg1);
1277            push(@$single_domain,$reg2);
1278            push(@$single_domain,$in_sub);
1279            push(@$single_domain,$ev_codes);
1280            push(@$single_domain,$thing->organism);
1281            push(@$single_domain,$thing->function);
1282            push(@$single_domain,$aliases);
1283            push(@$data,$single_domain);
1284        }
1285    
1286        if ($count >0){
1287            $content = $data;
1288        }
1289        else
1290        {
1291            $content = "<p>This PEG does not have any similarities</p>";
1292        }
1293        return ($content);
1294    }
1295    
1296    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3