line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bio::Gonzales::Range::Cluster; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
115319
|
use Mouse; |
|
1
|
|
|
|
|
28809
|
|
|
1
|
|
|
|
|
4
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
454
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
6
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
23
|
use 5.010; |
|
1
|
|
|
|
|
3
|
|
9
|
1
|
|
|
1
|
|
544
|
use Bio::Gonzales::Range::Util qw/overlaps/; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
78
|
|
10
|
1
|
|
|
1
|
|
7
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
598
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.083'; # VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
has clusters => ( is => 'rw', default => sub { [] }, clearer => 1 ); |
15
|
|
|
|
|
|
|
has _current_cluster => ( is => 'rw', default => sub { [] }, clearer => 1 ); |
16
|
|
|
|
|
|
|
has _last_range => ( is => 'rw' ); |
17
|
|
|
|
|
|
|
has overlap_config => ( is => 'rw' ); |
18
|
|
|
|
|
|
|
has _current_max_end => ( is => 'rw' ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub add_next_range { |
21
|
35
|
|
|
35
|
1
|
112
|
my ( $self, $next_range ) = @_; |
22
|
|
|
|
|
|
|
|
23
|
35
|
100
|
|
|
|
243
|
confess 'supplied range has not start and end coordinates' unless ( @$next_range >= 2 ); |
24
|
34
|
100
|
|
|
|
414
|
confess 'supplied range\'s start is bigger than end coordinate' if ( $next_range->[0] > $next_range->[1] ); |
25
|
|
|
|
|
|
|
|
26
|
33
|
|
|
|
|
63
|
my $current_cluster = $self->_current_cluster; |
27
|
33
|
100
|
|
|
|
66
|
unless ( $self->_last_range ) { |
28
|
3
|
|
|
|
|
11
|
$self->_current_cluster( [$next_range] ); |
29
|
3
|
|
|
|
|
7
|
$self->_last_range($next_range); |
30
|
3
|
|
|
|
|
8
|
return $self; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
30
|
|
|
|
|
50
|
my $range = $self->_last_range; |
34
|
|
|
|
|
|
|
|
35
|
30
|
|
|
|
|
62
|
my $max_end = $self->_current_max_end; |
36
|
30
|
100
|
|
|
|
54
|
unless ( defined $max_end ) { |
37
|
2
|
|
|
|
|
5
|
$max_end = $range->[1]; |
38
|
2
|
|
|
|
|
5
|
$self->_current_max_end($max_end); |
39
|
|
|
|
|
|
|
} |
40
|
30
|
100
|
100
|
|
|
80
|
if ( $next_range->[0] <= $max_end |
41
|
|
|
|
|
|
|
|| overlaps( $range, $next_range, $self->overlap_config ) ) |
42
|
|
|
|
|
|
|
{ |
43
|
25
|
|
|
|
|
45
|
push @$current_cluster, $next_range; |
44
|
|
|
|
|
|
|
|
45
|
25
|
100
|
|
|
|
61
|
$self->_current_max_end( $next_range->[1] ) if ( $next_range->[1] > $max_end ); |
46
|
25
|
|
|
|
|
42
|
$self->_last_range($next_range); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
} else { |
49
|
5
|
|
|
|
|
7
|
push @{ $self->clusters }, $current_cluster; |
|
5
|
|
|
|
|
13
|
|
50
|
5
|
|
|
|
|
17
|
$self->_current_cluster( [$next_range] ); |
51
|
5
|
|
|
|
|
9
|
$self->_last_range($next_range); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
30
|
|
|
|
|
55
|
return $self; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub pick_up_clusters { |
58
|
2
|
|
|
2
|
1
|
8
|
my ($self) = @_; |
59
|
|
|
|
|
|
|
|
60
|
2
|
|
|
|
|
5
|
my $clusters = $self->clusters; |
61
|
2
|
50
|
|
|
|
6
|
if ( @$clusters > 0 ) { |
62
|
2
|
|
|
|
|
6
|
$self->clusters( [] ); |
63
|
2
|
|
|
|
|
17
|
return $clusters; |
64
|
|
|
|
|
|
|
} |
65
|
0
|
|
|
|
|
0
|
return; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub finish { |
69
|
3
|
|
|
3
|
1
|
10
|
my ($self) = @_; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
#add the current cluster, but only if it has elements |
72
|
|
|
|
|
|
|
#special case is a new object with finish called immediately |
73
|
2
|
|
|
|
|
6
|
push @{ $self->clusters }, $self->_current_cluster |
74
|
3
|
100
|
|
|
|
5
|
if ( @{ $self->_current_cluster } > 0 ); |
|
3
|
|
|
|
|
11
|
|
75
|
3
|
|
|
|
|
11
|
return $self; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
1; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
__END__ |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 NAME |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Bio::Gonzales::Range::Cluster - cluster sorted ranges iteratively |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 SYNOPSIS |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
my $cr = Bio::Gonzales::Range::Cluster->new; |
89
|
|
|
|
|
|
|
my @ranges = ( [ 417, '575', 7991 ], [ 537, '829', 7992 ], [ 839, '901', 7993 ], ); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my @sorted_ranges = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @ranges; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
for my $r (@sorted_ranges) { |
94
|
|
|
|
|
|
|
$cr->add_next_range($r); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my $result = $cr->finish->clusters; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 DESCRIPTION |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 OPTIONS |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 METHODS |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=over 4 |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=item B<< $cr = $cr->finish() >> |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item B<< $cr->overlap_config >> |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item B<< $cr->clusters >> |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item B<< $clusters_array_ref = $cr->pick_up_clusters() >> |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=item B<< $cr->add_next_range([ $from, $to, @whatever]) >> |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=back |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head1 SEE ALSO |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=head1 AUTHOR |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
jw bargsten, C<< <jwb at cpan dot org> >> |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |