[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.71, Tue Sep 9 13:58:55 2008 UTC revision 1.78, Thu May 21 17:57:32 2009 UTC
# Line 11  Line 11 
11  use WebConfig;  use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14    use LWP::Simple;
15  #use strict;  #use strict;
16  #use warnings;  #use warnings;
17  use HTML;  use HTML;
# Line 333  Line 334 
334      else{      else{
335          my %domain_classes;          my %domain_classes;
336          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
337          $domain_classes{'CDD'} = 1;          #$domain_classes{'CDD'} = 1;
338          $domain_classes{'PFAM'} = 1;          $domain_classes{'PFAM'} = 1;
339          get_identical_proteins($fid,\@matched_datasets,$fig);          get_identical_proteins($fid,\@matched_datasets,$fig);
340          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
# Line 568  Line 569 
569                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
570                  }                  }
571                  elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){                  elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
572                      $evalue=$raw_evalue;                      #$evalue=$raw_evalue;
573                        my $part2 = 1000 - $1;
574                        my $part1 = $2/100;
575                        $evalue = $part1."e-".$part2;
576    
577                  }                  }
578                  else{                  else{
579                      $evalue = "0.0";                      $evalue = "0.0";
# Line 739  Line 744 
744      }      }
745    
746      my($id, $genome, @genomes, %sims);      my($id, $genome, @genomes, %sims);
747      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);  #    my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand,$sim_filters);
748        my @tmp= $fig->sims($fid,1000000,$max_eval,$db_filter,$max_expand,$sim_filters);
749      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
750      my ($dataset);      my ($dataset);
751    
# Line 755  Line 761 
761      }      }
762    
763      my $seen_sims={};      my $seen_sims={};
764        my $count=1;
765      foreach my $sim (@tmp){      foreach my $sim (@tmp){
766    
767          my $hit = $sim->[1];          my $hit = $sim->[1];
768          next if ($seen_sims->{$hit});          next if ($seen_sims->{$hit});
769            next if ($hit =~ /nmpdr\||gnl\|md5\|/);
770          $seen_sims->{$hit}++;          $seen_sims->{$hit}++;
771    
772            last if ($count>$max_sims);
773            $count++;
774    
775          my $percent = $sim->[2];          my $percent = $sim->[2];
776          my $evalue = $sim->[10];          my $evalue = $sim->[10];
777          my $qfrom = $sim->[6];          my $qfrom = $sim->[6];
# Line 1298  Line 1311 
1311                                  -password => $WebConfig::DBPWD);                                  -password => $WebConfig::DBPWD);
1312    
1313      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1314      if($db eq "CDD"){  
1315          my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );      if($db =~ /PFAM/){
1316          if(!scalar(@$cdd_objs)){          my $new_id;
1317              $name_title = "name";          if ($id =~ /_/){
1318              $name_value = "not available";              ($new_id) = ($id) =~ /(.*?)_/;
             $description_title = "description";  
             $description_value = "not available";  
1319          }          }
1320          else{          else{
1321              my $cdd_obj = $cdd_objs->[0];              $new_id = $id;
             $name_title = "name";  
             $name_value = $cdd_obj->term;  
             $description_title = "description";  
             $description_value = $cdd_obj->description;  
1322          }          }
1323      }  
     elsif($db =~ /PFAM/){  
         my ($new_id) = ($id) =~ /(.*?)_/;  
1324          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );          my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1325          if(!scalar(@$pfam_objs)){          if(!scalar(@$pfam_objs)){
1326              $name_title = "name";              $name_title = "name";
# Line 1371  Line 1376 
1376    
1377      my $link;      my $link;
1378      my $link_url;      my $link_url;
1379      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}  #    if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1380      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}      if($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1381      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1382    
1383      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1401  Line 1406 
1406      my $data = [];      my $data = [];
1407      my $count = 0;      my $count = 0;
1408      my $content;      my $content;
1409        my $seen = {};
1410    
1411      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
1412          next if ($thing->type !~ /dom/);          next if ($thing->type !~ /dom/);
# Line 1416  Line 1422 
1422                                  -password => $WebConfig::DBPWD);                                  -password => $WebConfig::DBPWD);
1423    
1424          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1425          if($db eq "CDD"){  
1426              my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );          my $new_id;
1427              if(!scalar(@$cdd_objs)){          if($db =~ /PFAM/){
1428                  $name_title = "name";              if ($id =~ /_/){
1429                  $name_value = "not available";                  ($new_id) = ($id) =~ /(.*?)_/;
                 $description_title = "description";  
                 $description_value = "not available";  
1430              }              }
1431              else{              else{
1432                  my $cdd_obj = $cdd_objs->[0];                  $new_id = $id;
                 $name_title = "name";  
                 $name_value = $cdd_obj->term;  
                 $description_title = "description";  
                 $description_value = $cdd_obj->description;  
             }  
1433          }          }
1434          elsif($db =~ /PFAM/){  
1435              my ($new_id) = ($id) =~ /(.*?)_/;              next if ($seen->{$new_id});
1436                $seen->{$new_id}=1;
1437    
1438              my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );              my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1439    #           print STDERR "VALUES: " . $pfam_objs . "\n";
1440              if(!scalar(@$pfam_objs)){              if(!scalar(@$pfam_objs)){
1441                  $name_title = "name";                  $name_title = "name";
1442                  $name_value = "not available";                  $name_value = "not available";
# Line 1453  Line 1455 
1455          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1456    
1457          push(@$single_domain,$db);          push(@$single_domain,$db);
1458          push(@$single_domain,$thing->acc);          push(@$single_domain,$new_id);
1459          push(@$single_domain,$name_value);          push(@$single_domain,$name_value);
1460          push(@$single_domain,$location);          push(@$single_domain,$location);
1461          push(@$single_domain,$thing->evalue);          push(@$single_domain,$thing->evalue);
# Line 2252  Line 2254 
2254              $next_org = $next_thing->organism if (defined $next_thing);              $next_org = $next_thing->organism if (defined $next_thing);
2255          }          }
2256    
2257            next if ($id =~ /nmpdr\||gnl\|md5\|/);
2258    
2259          my $single_domain = [];          my $single_domain = [];
2260          $count++;          $count++;
2261    
# Line 2284  Line 2288 
2288          my $anchor_name = "anchor_". $replace_id;          my $anchor_name = "anchor_". $replace_id;
2289          my $checked = "";          my $checked = "";
2290          #$checked = "checked" if ($id eq $query_fid);          #$checked = "checked" if ($id eq $query_fid);
2291          if ($id =~ /^fig\|/){  #       if ($id =~ /^fig\|/){
2292            my $box = qq~<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>~;            my $box = qq~<a name="$anchor_name"></a><input type="checkbox" name="seq" value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');" $checked>~;
2293            $box_cell = { 'data'=>$box, 'highlight'=>$org_color};            $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2294            $tax = $fig->genome_of($id);            $tax = $fig->genome_of($id) if ($id =~ /^fig\|/);
2295          }  #       }
2296          else{  #       else{
2297            my $box = qq(<a name="$anchor_name"></a>);  #         my $box = qq(<a name="$anchor_name"></a>);
2298            $box_cell = { 'data'=>$box, 'highlight'=>$org_color};  #         $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2299          }  #       }
2300    
2301          # create the radio cell for any sequence, not just fig ids          # create the radio cell for any sequence, not just fig ids
2302          my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" onClick="clearText('new_text_function')">);          my $radio = qq(<input type="radio" name="function_select" value="$current_function" id="$field_name" onClick="clearText('new_text_function')">);
2303          $radio_cell = { 'data'=>$radio, 'highlight'=>$white};          $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2304    
2305          # get the linked fig id          # get the linked fig id
2306          my $anchor_link = "graph_" . $replace_id;          my $anchor_link = "graph_" . $replace_id;
2307          my $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;  
2308            my $fig_data;
2309            if ($id =~ /^fig\|/)
2310            {
2311                $fig_data =  "<table><tr><td><a href='?page=Annotation&feature=$id'>$id</a></td>" . "&nbsp;" x 2;
2312            }
2313            else
2314            {
2315                my $url_link = &HTML::set_prot_links($cgi,$id);
2316                $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2317            }
2318          $fig_data .= qq(<td><img height='10px' width='20px' src='$FIG_Config::cgi_url/Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);          $fig_data .= qq(<td><img height='10px' width='20px' src='$FIG_Config::cgi_url/Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2319          my $fig_col = {'data'=> $fig_data,          my $fig_col = {'data'=> $fig_data,
2320                         'highlight'=>$white};                         'highlight'=>$white};
# Line 2519  Line 2533 
2533      my $organism = $fig->org_of($id);      my $organism = $fig->org_of($id);
2534      my $single_domain = [];      my $single_domain = [];
2535    
2536      # organisms cell      # organisms cell comehere2
2537      my ($org, $org_color) = $fig->org_and_color_of($id);      my ($org, $org_color) = $fig->org_and_color_of($id);
2538      my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};      my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2539    
2540      # get the linked fig id      # get the linked fig id
2541      my $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";      my $fig_data;
2542        if ($id =~ /^fig\|/)
2543        {
2544            $fig_data =  "<a href='?page=Annotation&feature=$id'>$id</a>";
2545        }
2546        else
2547        {
2548            my $url_link = &HTML::set_prot_links($cgi,$id);
2549            $fig_data = "<table><tr><td>$url_link</td>". "&nbsp;" x 2;
2550        }
2551    
2552      my $fig_col = {'data'=> $fig_data,      my $fig_col = {'data'=> $fig_data,
2553                     'highlight'=>"#ffffff"};                     'highlight'=>"#ffffff"};
2554    
# Line 2598  Line 2622 
2622      my $figfams = new FFs($figfam_data);      my $figfams = new FFs($figfam_data);
2623    
2624      foreach my $id (@$ids){      foreach my $id (@$ids){
2625          my ($ff) =  $figfams->families_containing_peg($id);          my ($ff);
2626            if ($id =~ /\.peg\./){
2627                ($ff) =  $figfams->families_containing_peg($id);
2628            }
2629          if ($ff){          if ($ff){
2630              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2631          }          }
# Line 2613  Line 2640 
2640  sub get_subsystems_column{  sub get_subsystems_column{
2641      my ($ids,$fig,$cgi,$returnType) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2642    
2643      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids,1);
2644      my ($column, $ss);      my ($column, $ss);
2645      foreach my $id (@$ids){      foreach my $id (@$ids){
2646          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});          my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
# Line 2795  Line 2822 
2822              my $pretty_code = $code->[2];              my $pretty_code = $code->[2];
2823              if ($pretty_code =~ /;/) {              if ($pretty_code =~ /;/) {
2824                  my ($cd, $ss) = split(";", $code->[2]);                  my ($cd, $ss) = split(";", $code->[2]);
                 print STDERR "$id: $cd, $ss\n";  
2825                  if ($cd =~ /ilit|dlit/){                  if ($cd =~ /ilit|dlit/){
2826                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2827                      my $publink = &HTML::alias_url($pubmed_id,'PMID');                      my $publink = &HTML::alias_url($pubmed_id,'PMID');
# Line 2864  Line 2890 
2890                      my @parts = split("::",$code);                      my @parts = split("::",$code);
2891                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";                      my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2892    
2893                      # get the locations for the domain  #                   # get the locations for the domain
2894                      my @locs;  #                   my @locs;
2895                      foreach my $part (@{$attribute_location{$id}{$code}}){  #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2896                          my ($loc) = ($part) =~ /\;(.*)/;  #                       my ($loc) = ($part) =~ /\;(.*)/;
2897                          push (@locs,$loc);  #                       push (@locs,$loc);
2898                      }  #                   }
2899                      my %locsaw;  #                   my %locsaw;
2900                      foreach my $key (@locs) {$locsaw{$key}=1;}  #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2901                      @locs = keys %locsaw;  #                   @locs = keys %locsaw;
2902    #
2903                      my $locations = join (", ", @locs);  #                   my $locations = join (", ", @locs);
2904    #
2905                      if (defined ($description_codes{$parts[1]})){                      if (defined ($description_codes{$parts[1]})){
2906                          push(@pfam_codes, "$parts[1] ($locations)");                          push(@pfam_codes, "$parts[1]");
2907                      }                      }
2908                      else {                      else {
2909                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2910                          $description_codes{$parts[1]} = $description->[0]->{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2911                          push(@pfam_codes, "$pfam_link ($locations)");                          push(@pfam_codes, "$pfam_link");
2912                      }                      }
2913                  }                  }
2914    
# Line 2991  Line 3017 
3017      return $column;      return $column;
3018  }  }
3019    
3020    sub get_aclh_aliases {
3021        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3022        my $db_array;
3023    
3024        my $id_line = join (",", @$ids);
3025        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
3026    
3027    
3028    }
3029    
3030    sub get_id_aliases {
3031        my ($id, $fig) = @_;
3032        my $aliases = {};
3033    
3034        my $org = $fig->org_of($id);
3035        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3036        if ( my $form = &LWP::Simple::get($url) ) {
3037            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3038            foreach my $line (split /\n/, $block){
3039                my @values = split /\t/, $line;
3040                next if ($values[3] eq "Expert");
3041                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3042                    $aliases->{$values[4]} = $values[0];
3043                }
3044            }
3045        }
3046    
3047        return $aliases;
3048    }
3049    
3050  sub get_db_aliases {  sub get_db_aliases {
3051      my ($ids,$fig,$db,$cgi,$returnType) = @_;      my ($ids,$fig,$db,$cgi,$returnType) = @_;
   
3052      my $db_array;      my $db_array;
3053      my $all_aliases = $fig->feature_aliases_bulk($ids);      my $all_aliases = $fig->feature_aliases_bulk($ids);
3054      foreach my $id (@$ids){      foreach my $id (@$ids){
3055    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3056            my $id_org = $fig->org_of($id);
3057    
3058          foreach my $alias (@{$$all_aliases{$id}}){          foreach my $alias (@{$$all_aliases{$id}}){
3059    #       foreach my $alias (@all_aliases){
3060              my $id_db = &Observation::get_database($alias);              my $id_db = &Observation::get_database($alias);
3061              next if ( ($id_db ne $db) && ($db ne 'all') );              next if ( ($id_db ne $db) && ($db ne 'all') );
3062              next if ($aliases->{$id}->{$db});              next if ($aliases->{$id}->{$db});
3063                my $alias_org = $fig->org_of($alias);
3064    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3065                    #push(@funcs, [$id,$id_db,$tmp]);
3066              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3067    #           }
3068          }          }
3069          if (!defined( $aliases->{$id}->{$db})){          if (!defined( $aliases->{$id}->{$db})){
3070              $aliases->{$id}->{$db} = " ";              $aliases->{$id}->{$db} = " ";
# Line 3204  Line 3266 
3266      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3267      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3268      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3269      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs,1);
3270    
3271      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3272          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];

Legend:
Removed from v.1.71  
changed lines
  Added in v.1.78

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3