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

Diff of /FigKernelPackages/ChromosomalClusters.pm

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

revision 1.7, Thu Jun 29 00:18:40 2006 UTC revision 1.10, Mon Sep 17 19:52:10 2007 UTC
# Line 241  Line 241 
241              my $func_ref = [ $func_entry, "td" ];              my $func_ref = [ $func_entry, "td" ];
242              my $uni_ref  = undef;              my $uni_ref  = undef;
243              my $uni_func = undef;              my $uni_func = undef;
244              my $ev = join("<br>",$fig->evidence_codes($fid));              # my $ev = join("<br>",$fig->evidence_codes($fid));
245                my $ev = '';
246    
247              if ($cgi->param('uni'))              if ($cgi->param('uni'))
248              {              {
# Line 487  Line 488 
488  #               print STDERR &Dumper($feat);  #               print STDERR &Dumper($feat);
489                  foreach $fid (@$feat)                  foreach $fid (@$feat)
490                  {                  {
491                      ($contig1,$beg1,$end1) = &FIG::boundaries_of($fig->feature_location($fid));                      ($contig1,$beg1,$end1) = $fig->boundaries_of($fig->feature_location($fid));
492  #                   print STDERR "contig1=$contig1 beg1=$beg1 end1=$end1\n";  #                   print STDERR "contig1=$contig1 beg1=$beg1 end1=$end1\n";
493  #                   print STDERR &Dumper([$fid,$fig->feature_location($fid),$fig->boundaries_of($fig->feature_location($fid))]);  #                   print STDERR &Dumper([$fid,$fig->feature_location($fid),$fig->boundaries_of($fig->feature_location($fid))]);
494                      $beg1 = &in_bounds($min,$max,$beg1);                      $beg1 = &in_bounds($min,$max,$beg1);
# Line 495  Line 496 
496    
497                      #  Build the pop-up information for the gene:                      #  Build the pop-up information for the gene:
498    
499                        if (0)
500                        {
501    
502                      my $function = $fig->function_of($fid);                      my $function = $fig->function_of($fid);
503                      my $aliases1 = $fig->feature_aliases($fid);                      my $aliases1 = $fig->feature_aliases($fid);
504                      my ( $uniprot ) = $aliases1 =~ /(uni\|[^,]+)/;                      my ( $uniprot ) = $aliases1 =~ /(uni\|[^,]+)/;
# Line 514  Line 518 
518                          my ($gotpeg,$gottag,$val, $url)=@$eachattr;                          my ($gotpeg,$gottag,$val, $url)=@$eachattr;
519                          $info .= "<br/><b>Attribute:</b> $gottag $val $url";                          $info .= "<br/><b>Attribute:</b> $gottag $val $url";
520                      }                      }
521                    }
522                        my $info = '';
523    
524                      push( @$genes, [ &FIG::min($beg1,$end1),                      push( @$genes, [ &FIG::min($beg1,$end1),
525                                       &FIG::max($beg1,$end1),                                       &FIG::max($beg1,$end1),
# Line 627  Line 633 
633      my %pos_of;  #  maps representative id to indexes in @$all_pegs, and original id to its index      my %pos_of;  #  maps representative id to indexes in @$all_pegs, and original id to its index
634      my @rep_ids; #  list of representative ids (product of all maps_to_id)      my @rep_ids; #  list of representative ids (product of all maps_to_id)
635    
636        #
637        # Expt: pull from sims server.
638        #
639        my $ua = LWP::UserAgent->new();
640        my %args = ();
641        $args{id} = $all_pegs;
642        $args{mapping} = 1;
643    
644        my %maps_to_id;
645        my %reps;
646        my $res = $ua->post("http://bio-ppc-44/simserver/perl/sims2.pl", \%args);
647        if (!$res->is_success)
648        {
649            die "getreps failed: " . $res->code . " " . $res->status_line . "\n";
650        }
651        my $c = $res->content;
652        while ($c =~ /(.*)\n/g)
653        {
654            my($rep, @list) = split(/\t/, $1);
655            $reps{$rep} = {};
656    
657            map { my($id, $len) = split(/,/, $_);  $maps_to_id{$id} = $rep;  } @list;
658        }
659    
660        #
661        # get the sims too.
662        #
663        my @sims = $fig->sims($all_pegs, 500, $sim_cutoff, 'raw');
664        my %sims;
665        map { push(@{$sims{$_->id1}}, $_) } @sims;
666    
667    
668      my ( $i, $id_i );      my ( $i, $id_i );
669      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++)
670      {      {
671          $id_i = $all_pegs->[$i];          $id_i = $all_pegs->[$i];
672          $peg2i{ $id_i } = $i;          $peg2i{ $id_i } = $i;
673    
674          my $rep = $fig->maps_to_id($id_i );          my $rep = $maps_to_id{$id_i};
675          defined( $pos_of{ $rep } ) or push @rep_ids, $rep;          defined( $pos_of{ $rep } ) or push @rep_ids, $rep;
676          push @{ $pos_of{ $rep } }, $i;          push @{ $pos_of{ $rep } }, $i;
677          if ( $rep ne $id_i )          if ( $rep ne $id_i )
# Line 665  Line 703 
703              #  We get $sim_cutoff as a global var (ouch)              #  We get $sim_cutoff as a global var (ouch)
704    
705              $conn{ $rep } = [ map { defined( $pos_of{ $id2 = $_->id2 } ) ? $id2 : () }              $conn{ $rep } = [ map { defined( $pos_of{ $id2 = $_->id2 } ) ? $id2 : () }
706                                $fig->sims($rep, 500, $sim_cutoff, "raw" )                                @{$sims{$rep}}
707                              ];                              ];
708          }          }
709          # print STDERR &Dumper(\%conn);          # print STDERR &Dumper(\%conn);
# Line 1103  Line 1141 
1141    
1142      my($peg2,%pinned_to,$tuple);      my($peg2,%pinned_to,$tuple);
1143    
1144      if ($fig->table_exists('pchs') &&      if ($fig->is_complete($fig->genome_of($peg)))
         $fig->is_complete($fig->genome_of($peg)))  
1145      {      {
1146          foreach $peg2 (map { $_->[0] } $fig->coupled_to($peg))          foreach $peg2 (map { $_->[0] } $fig->coupled_to($peg))
1147          {          {
# Line 1175  Line 1212 
1212      if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }      if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }
1213    
1214      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);
1215      return (@codes > 0) ? map { $_->[2] } @codes : ();      my @pretty_codes = ();
1216        foreach my $code (@codes) {
1217            my $pretty_code = $code->[2];
1218            if ($pretty_code =~ /;/) {
1219                my ($cd, $ss) = split(";", $code->[2]);
1220                $ss =~ s/_/ /g;
1221                $pretty_code = $cd . " in " . $ss;
1222            }
1223            push(@pretty_codes, $pretty_code);
1224  }  }
1225        return @pretty_codes;
1226    }
1227    
1228    
1229    
1230  #####################################################################  #####################################################################

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.10

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3