[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.70, Wed Sep 3 20:30:22 2008 UTC revision 1.80, Mon Jun 29 16:49:01 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 882  Line 895 
895      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
896    
897      # get the fc data      # get the fc data
898      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);      my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff);
899    
900      # retrieve data      # retrieve data
901      my @rows = map { ($sc,$neigh) = @$_;      my @rows = map { ($sc,$neigh) = @$_;
# 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          }  
1435          elsif($db =~ /PFAM/){              next if ($seen->{$new_id});
1436              my ($new_id) = ($id) =~ /(.*?)_/;              $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 2357  Line 2371 
2371    
2372          if ( ( $application->session->user) ){          if ( ( $application->session->user) ){
2373              my $user = $application->session->user;              my $user = $application->session->user;
2374              if ($user && $user->has_right(undef, 'annotate', 'genome', $fig->genome_of($id))) {              if ($user && $user->has_right(undef, 'annotate', 'genome')) {
2375                  push (@$single_domain,$radio_cell);                  push (@$single_domain,$radio_cell);
2376              }              }
2377          }          }
# 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    
2555        # get sequence length
2556        my $length_col = {'data'=> $fig->translation_length($id),
2557                          'highlight'=>"#ffffff"};
2558    
2559      # function cell      # function cell
2560      $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};      $function_cell = {'data'=>$current_function, 'highlight'=> "#ffffff"};
2561    
2562      # insert data      # insert data
2563      push (@$single_domain, $fig_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);      push (@$single_domain, $fig_col, $length_col, $org_cell, {'data'=>$subsystems_column->{$id},'highlight'=>"#ffffff"}, $function_cell);
2564    
2565      foreach my $col (@$scroll_list){      foreach my $col (@$scroll_list){
2566        my $highlight_color = "#ffffff";        my $highlight_color = "#ffffff";
# Line 2598  Line 2626 
2626      my $figfams = new FFs($figfam_data);      my $figfams = new FFs($figfam_data);
2627    
2628      foreach my $id (@$ids){      foreach my $id (@$ids){
2629          my ($ff) =  $figfams->families_containing_peg($id);          my ($ff);
2630            if ($id =~ /\.peg\./){
2631                ($ff) =  $figfams->families_containing_peg($id);
2632            }
2633          if ($ff){          if ($ff){
2634              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");              push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2635          }          }
# Line 2613  Line 2644 
2644  sub get_subsystems_column{  sub get_subsystems_column{
2645      my ($ids,$fig,$cgi,$returnType) = @_;      my ($ids,$fig,$cgi,$returnType) = @_;
2646    
2647      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids,1);
2648      my ($column, $ss);      my ($column, $ss);
2649      foreach my $id (@$ids){      foreach my $id (@$ids){
2650          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 2826 
2826              my $pretty_code = $code->[2];              my $pretty_code = $code->[2];
2827              if ($pretty_code =~ /;/) {              if ($pretty_code =~ /;/) {
2828                  my ($cd, $ss) = split(";", $code->[2]);                  my ($cd, $ss) = split(";", $code->[2]);
                 print STDERR "$id: $cd, $ss\n";  
2829                  if ($cd =~ /ilit|dlit/){                  if ($cd =~ /ilit|dlit/){
2830                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;                      my ($type,$pubmed_id) = ($cd) =~ /(.*?)\((.*)\)/;
2831                      my $publink = &HTML::alias_url($pubmed_id,'PMID');                      my $publink = &HTML::alias_url($pubmed_id,'PMID');
# Line 2864  Line 2894 
2894                      my @parts = split("::",$code);                      my @parts = split("::",$code);
2895                      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>";
2896    
2897                      # get the locations for the domain  #                   # get the locations for the domain
2898                      my @locs;  #                   my @locs;
2899                      foreach my $part (@{$attribute_location{$id}{$code}}){  #                   foreach my $part (@{$attribute_location{$id}{$code}}){
2900                          my ($loc) = ($part) =~ /\;(.*)/;  #                       my ($loc) = ($part) =~ /\;(.*)/;
2901                          push (@locs,$loc);  #                       push (@locs,$loc);
2902                      }  #                   }
2903                      my %locsaw;  #                   my %locsaw;
2904                      foreach my $key (@locs) {$locsaw{$key}=1;}  #                   foreach my $key (@locs) {$locsaw{$key}=1;}
2905                      @locs = keys %locsaw;  #                   @locs = keys %locsaw;
2906    #
2907                      my $locations = join (", ", @locs);  #                   my $locations = join (", ", @locs);
2908    #
2909                      if (defined ($description_codes{$parts[1]})){                      if (defined ($description_codes{$parts[1]})){
2910                          push(@pfam_codes, "$parts[1] ($locations)");                          push(@pfam_codes, "$parts[1]");
2911                      }                      }
2912                      else {                      else {
2913                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );                          my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2914                          $description_codes{$parts[1]} = $description->[0]->{term};                          $description_codes{$parts[1]} = $description->[0]->{term};
2915                          push(@pfam_codes, "$pfam_link ($locations)");                          push(@pfam_codes, "$pfam_link");
2916                      }                      }
2917                  }                  }
2918    
# Line 2991  Line 3021 
3021      return $column;      return $column;
3022  }  }
3023    
3024    sub get_aclh_aliases {
3025        my ($ids,$fig,$db,$cgi,$returnType) = @_;
3026        my $db_array;
3027    
3028        my $id_line = join (",", @$ids);
3029        my $aclh_url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=" . $id_line;
3030    
3031    
3032    }
3033    
3034    sub get_id_aliases {
3035        my ($id, $fig) = @_;
3036        my $aliases = {};
3037    
3038        my $org = $fig->org_of($id);
3039        my $url = "http://clearinghouse.nmpdr.org/aclh.cgi?page=SearchResults&raw_dump=1&query=$id";
3040        if ( my $form = &LWP::Simple::get($url) ) {
3041            my ($block) = ($form) =~ /<pre>(.*)<\/pre>/s;
3042            foreach my $line (split /\n/, $block){
3043                my @values = split /\t/, $line;
3044                next if ($values[3] eq "Expert");
3045                if (($values[1] =~ /$org/) || ($org =~ /$values[1]/) && (! defined $aliases->{$values[4]}) ){
3046                    $aliases->{$values[4]} = $values[0];
3047                }
3048            }
3049        }
3050    
3051        return $aliases;
3052    }
3053    
3054  sub get_db_aliases {  sub get_db_aliases {
3055      my ($ids,$fig,$db,$cgi,$returnType) = @_;      my ($ids,$fig,$db,$cgi,$returnType) = @_;
   
3056      my $db_array;      my $db_array;
3057      my $all_aliases = $fig->feature_aliases_bulk($ids);      my $all_aliases = $fig->feature_aliases_bulk($ids);
3058      foreach my $id (@$ids){      foreach my $id (@$ids){
3059    #       my @all_aliases = grep { $_ ne $id and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($id);
3060            my $id_org = $fig->org_of($id);
3061    
3062          foreach my $alias (@{$$all_aliases{$id}}){          foreach my $alias (@{$$all_aliases{$id}}){
3063    #       foreach my $alias (@all_aliases){
3064              my $id_db = &Observation::get_database($alias);              my $id_db = &Observation::get_database($alias);
3065              next if ( ($id_db ne $db) && ($db ne 'all') );              next if ( ($id_db ne $db) && ($db ne 'all') );
3066              next if ($aliases->{$id}->{$db});              next if ($aliases->{$id}->{$db});
3067                my $alias_org = $fig->org_of($alias);
3068    #           if (($id ne $peg) && ( ($alias_org =~ /$id_org/) || ($id_org =~ /$alias_org/)) ) {
3069                    #push(@funcs, [$id,$id_db,$tmp]);
3070              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
3071    #           }
3072          }          }
3073          if (!defined( $aliases->{$id}->{$db})){          if (!defined( $aliases->{$id}->{$db})){
3074              $aliases->{$id}->{$db} = " ";              $aliases->{$id}->{$db} = " ";
# Line 3204  Line 3270 
3270      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
3271      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
3272      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;      #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
3273      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);      my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs,1);
3274    
3275      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
3276          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];

Legend:
Removed from v.1.70  
changed lines
  Added in v.1.80

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3