[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.32, Tue Aug 21 22:45:54 2007 UTC revision 1.33, Wed Aug 22 22:05:35 2007 UTC
# Line 320  Line 320 
320          my %domain_classes;          my %domain_classes;
321          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
322          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
323          #get_identical_proteins($fid,\@matched_datasets);          get_identical_proteins($fid,\@matched_datasets);
324          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);
325          get_sims_observations($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets);
326          get_functional_coupling($fid,\@matched_datasets);          get_functional_coupling($fid,\@matched_datasets);
# Line 739  Line 739 
739      my $fig = new FIG;      my $fig = new FIG;
740      my $funcs_ref;      my $funcs_ref;
741    
742      my %id_list;  #    my %id_list;
743      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
744      my @aliases = $fig->feature_aliases($fid);  #    my @aliases = $fig->feature_aliases($fid);
745      foreach my $alias (@aliases){  #    foreach my $alias (@aliases){
746          $id_list{$alias} = 1;  #       $id_list{$alias} = 1;
747      }  #    }
748    
749      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
750          my ($tmp, $who);          my ($tmp, $who);
751          if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
752    #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {
753              $who = &get_database($id);              $who = &get_database($id);
754              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
755          }          }
# Line 1741  Line 1742 
1742          elsif ($col eq "evidence"){          elsif ($col eq "evidence"){
1743              %evidence_column = &get_evidence_column(\@ids);              %evidence_column = &get_evidence_column(\@ids);
1744          }          }
1745            # get the column for pfam_domain
1746            elsif ($col eq "pfam_domains"){
1747                %pfam_column = &get_pfam_column(\@ids);
1748            }
1749      }      }
1750    
1751      my %e_identical = &get_essentially_identical($query_fid);      my %e_identical = &get_essentially_identical($query_fid);
1752        my $all_aliases = $fig->feature_aliases_bulk(\@ids);
1753    
1754      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1755          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
# Line 1789  Line 1795 
1795          foreach my $col (@$columns){          foreach my $col (@$columns){
1796              (push(@$single_domain,$subsystems_column{$id}) && (next)) if ($col eq "subsystem");              (push(@$single_domain,$subsystems_column{$id}) && (next)) if ($col eq "subsystem");
1797              (push(@$single_domain,$evidence_column{$id}) && (next)) if ($col eq "evidence");              (push(@$single_domain,$evidence_column{$id}) && (next)) if ($col eq "evidence");
1798              (push(@$single_domain,&get_prefer($thing->acc, 'NCBI')) && (next)) if ($col eq "ncbi_id");              (push(@$single_domain,$pfam_column{$id}) && (next)) if ($col eq "pfam_domains");
1799              (push(@$single_domain,&get_prefer($thing->acc, 'RefSeq')) && (next)) if ($col eq "refseq_id");  #           (push(@$single_domain,@{$$all_aliases{$id}}[0]) && (next)) if ($col eq "ncbi_id");
1800              (push(@$single_domain,&get_prefer($thing->acc, 'SwissProt')) && (next)) if ($col eq "swissprot_id");              (push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases)) && (next)) if ($col eq "ncbi_id");
1801              (push(@$single_domain,&get_prefer($thing->acc, 'UniProt')) && (next)) if ($col eq "uniprot_id");              (push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases)) && (next)) if ($col eq "refseq_id");
1802              (push(@$single_domain,&get_prefer($thing->acc, 'TIGR')) && (next)) if ($col eq "tigr_id");              (push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases)) && (next)) if ($col eq "swissprot_id");
1803              (push(@$single_domain,&get_prefer($thing->acc, 'PIR')) && (next)) if ($col eq "pir_id");              (push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases)) && (next)) if ($col eq "uniprot_id");
1804              (push(@$single_domain,&get_prefer($thing->acc, 'KEGG')) && (next)) if ($col eq "kegg_id");              (push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases)) && (next)) if ($col eq "tigr_id");
1805              (push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL')) && (next)) if ($col eq "trembl_id");              (push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases)) && (next)) if ($col eq "pir_id");
1806              (push(@$single_domain,&get_prefer($thing->acc, 'ASAP')) && (next)) if ($col eq "asap_id");              (push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases)) && (next)) if ($col eq "kegg_id");
1807              (push(@$single_domain,&get_prefer($thing->acc, 'JGI')) && (next)) if ($col eq "jgi_id");              (push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases)) && (next)) if ($col eq "trembl_id");
1808                (push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases)) && (next)) if ($col eq "asap_id");
1809                (push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases)) && (next)) if ($col eq "jgi_id");
1810          }          }
1811          push(@$data,$single_domain);          push(@$data,$single_domain);
1812      }      }
# Line 1907  Line 1915 
1915      return (%column);      return (%column);
1916  }  }
1917    
1918  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub get_pfam_column{
1919        my ($ids) = @_;
1920        my $fig = new FIG;
1921        my $cgi = new CGI;
1922        my (%column, %code_attributes);
1923        my $dbmaster = DBMaster->new(-database =>'Ontology');
1924    
1925        my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);
1926        foreach my $key (@codes){
1927            push (@{$code_attributes{$$key[0]}}, $$key[1]);
1928        }
1929    
1930        foreach my $id (@$ids){
1931            # add evidence code with tool tip
1932            my $pfam_codes=" &nbsp; ";
1933            my @pfam_codes = "";
1934            my %description_codes;
1935    
1936            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
1937                my @codes;
1938                @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
1939                @pfam_codes = ();
1940                foreach my $code (@codes) {
1941                    my @parts = split("::",$code);
1942                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
1943                    if (defined ($description_codes{$parts[1]})){
1944                        push(@pfam_codes, "$description_codes{$parts[1]} ($parts[1])");
1945                    }
1946                    else {
1947                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
1948                        $description_codes{$parts[1]} = ${$$description[0]}{term};
1949                        push(@pfam_codes, "${$$description[0]}{term} ($pfam_link)");
1950                    }
1951                }
1952            }
1953    
1954            $column{$id}=join("<br><br>", @pfam_codes);
1955        }
1956        return (%column);
1957    
1958    }
1959    
1960  sub get_prefer {  sub get_prefer {
1961      my ($fid, $db) = @_;      my ($fid, $db, $all_aliases) = @_;
1962      my $fig = new FIG;      my $fig = new FIG;
1963      my $cgi = new CGI;      my $cgi = new CGI;
1964    
1965      my @aliases = $fig->feature_aliases($fid);      foreach my $alias (@{$$all_aliases{$fid}}){
   
     foreach my $alias (@aliases){  
1966          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
1967          if ($id_db eq $db){          if ($id_db eq $db){
1968              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              my $acc_col .= &HTML::set_prot_links($cgi,$alias);
# Line 1926  Line 1972 
1972      return (" ");      return (" ");
1973  }  }
1974    
1975    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1976    
1977  sub color {  sub color {
1978      my ($evalue) = @_;      my ($evalue) = @_;
1979    

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3