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

Annotation of /FigKernelPackages/SapCompareRegions.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : olson 1.1
2 : parrello 1.2 package SapCompareRegions;
3 :    
4 : olson 1.1 use strict;
5 :     use SeedUtils;
6 : parrello 1.2 use ServerThing;
7 :     use Tracer;
8 : olson 1.1 use Data::Dumper;
9 :    
10 :     sub get_pin
11 :     {
12 :     my($self, $args) = @_;
13 :    
14 :     my $sap = $self->{db};
15 :    
16 :     my $peg = $args->{-focus};
17 :     my $cutoff = $args->{-cutoff};
18 :     my $count = $args->{-count};
19 :    
20 :     $cutoff = 1e-5 unless defined($cutoff);
21 :    
22 :     my $pegged_genomes = ServerThing::GetIdList(-genomes => $args, 1);
23 :     my %pegged_genomes;
24 :     $pegged_genomes{$_}++ for @$pegged_genomes;
25 :    
26 :     my @sims = SeedUtils::sims($peg,
27 :     $count * 10,
28 :     $cutoff,
29 :     'fig');
30 :    
31 :     @sims = map { [$_, SeedUtils::genome_of($_->id2)] } @sims;
32 :     my $ex = $self->exists({ -ids => [map { $_->[1] } @sims], -type => 'Genome'});
33 :     @sims = grep { $ex->{$_->[1]} } @sims;
34 :    
35 :     if (%pegged_genomes)
36 :     {
37 :     @sims = grep { $pegged_genomes{$_->[1]} } @sims;
38 :     }
39 :    
40 :     if (@sims > $count)
41 :     {
42 :     $#sims = $count-1;
43 :     }
44 :    
45 :     return [map { $_->[0]->id2 } @sims];
46 :     }
47 :    
48 :     sub get_context
49 :     {
50 :     my($self, $args) = @_;
51 :    
52 :     my $focus = $args->{-focus};
53 :     my $pin = $args->{-pin};
54 :     my $extent = $args->{-extent};
55 :    
56 :     my @pegs = ($focus, @$pin);
57 :    
58 :     my $locs = $self->fid_locations({ -ids => [@pegs], -boundaries => 1 });
59 :     # print Dumper($locs);
60 :    
61 :     my %peg_to_reg;
62 :     my %peg_to_ctg;
63 :     for my $peg (@pegs)
64 :     {
65 :     my($ctg, $beg, $end, $dir) = SeedUtils::parse_location($locs->{$peg});
66 :    
67 :     $beg -= $extent;
68 :     $beg = 1 if $beg < 1;
69 :    
70 :     $end += $extent;
71 :    
72 :     my $rloc = SeedUtils::location_string($ctg, $beg, $end);
73 :    
74 :     $peg_to_ctg{$peg} = $ctg;
75 :     $peg_to_reg{$peg} = $rloc;
76 :     }
77 :    
78 :     my $regions = $self->genes_in_region({ -locations => [ values %peg_to_reg ]});
79 :    
80 :     my @all_pegs = map { @$_ } values %$regions;
81 :     my $all_locs = $self->fid_locations({-ids => \@all_pegs, -boundaries => 1});
82 :    
83 :     my $all_fams = $self->ids_to_figfams({-ids => \@all_pegs});
84 :     my $all_funcs = $self->ids_to_functions({-ids => \@all_pegs});
85 :    
86 :    
87 :     # print Dumper($all_locs, $all_fams, $all_funcs);
88 :    
89 :     my @result;
90 :     my $row = 0;
91 : olson 1.3
92 :     my $names = $self->genome_names({-ids => [ map { SeedUtils::genome_of($_) } @pegs ]});
93 : olson 1.1
94 :     for my $peg (@pegs)
95 :     {
96 :     my $genome = SeedUtils::genome_of($peg);
97 :    
98 :     my $reg = $regions->{$peg_to_reg{$peg}};
99 :    
100 :     my @row_data = map { my($ctg, $beg, $end, $dir) = SeedUtils::parse_location($all_locs->{$_});
101 :     my $fams = $all_fams->{$_};
102 :     [$_, $all_funcs->{$_},
103 :     (ref($fams) ? join(",", @$fams) : ""),
104 :     $ctg, $beg, $end, $dir, $row]; } @$reg;
105 :    
106 :     @row_data = sort { $a->[5] <=> $b->[5] } @row_data;
107 : olson 1.3 push(@result, {
108 :     genome_id => $genome,
109 :     genome_name => $names->{$genome},
110 :     row_id => $row,
111 :     features => \@row_data,
112 :     });
113 : olson 1.1 $row++;
114 :     }
115 :     return \@result;
116 :     }
117 :    
118 :     sub cluster_by_function
119 :     {
120 :     my($self, $args) = @_;
121 :    
122 :     my $context = $args->{-context};
123 :    
124 :     #
125 :     # Now cluster by function.
126 :     #
127 :    
128 :     my $next = 1;
129 :     my %group;
130 :     my %group_count;
131 :     for my $row (@$context)
132 :     {
133 : olson 1.3 for my $ent (@{$row->{features}})
134 : olson 1.1 {
135 :     my($peg, $func, $fam, $ctg, $beg, $end, $dir, $rownum) = @$ent;
136 :     next unless defined($func);
137 :     $func =~ s/\s+#.*$//;
138 :     my $group = $group{$func};
139 :     if (!defined($group))
140 :     {
141 :     $group = $next++;
142 :     $group{$func} = $group;
143 :     }
144 :    
145 :     $group_count{$group}++;
146 :     $ent->[8] = $group;
147 :     }
148 :     }
149 :    
150 :     return $context;
151 :     }
152 :    
153 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3