line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Set::IntSpan::Partition; |
2
|
3
|
|
|
3
|
|
195680
|
use 5.008000; |
|
3
|
|
|
|
|
28
|
|
3
|
3
|
|
|
3
|
|
14
|
use strict; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
51
|
|
4
|
3
|
|
|
3
|
|
13
|
use warnings; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
84
|
|
5
|
3
|
|
|
3
|
|
21
|
use base qw(Exporter); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
354
|
|
6
|
3
|
|
|
3
|
|
17
|
use List::Util qw/min max/; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
303
|
|
7
|
3
|
|
|
3
|
|
1497
|
use List::MoreUtils qw/uniq/; |
|
3
|
|
|
|
|
31367
|
|
|
3
|
|
|
|
|
18
|
|
8
|
3
|
|
|
3
|
|
3959
|
use List::UtilsBy qw/partition_by nsort_by/; |
|
3
|
|
|
|
|
4797
|
|
|
3
|
|
|
|
|
188
|
|
9
|
3
|
|
|
3
|
|
1083
|
use List::StackBy; |
|
3
|
|
|
|
|
1096
|
|
|
3
|
|
|
|
|
127
|
|
10
|
3
|
|
|
3
|
|
548
|
use Set::IntSpan; |
|
3
|
|
|
|
|
9658
|
|
|
3
|
|
|
|
|
2299
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [ qw( |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
) ] ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @EXPORT = qw( |
21
|
|
|
|
|
|
|
intspan_partition |
22
|
|
|
|
|
|
|
intspan_partition_map |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub _uniq (@) { |
26
|
1001
|
|
|
1001
|
|
1745
|
my %h; |
27
|
1001
|
50
|
|
|
|
2234
|
return map { $h{$_}++ == 0 ? $_ : () } @_; |
|
25338
|
|
|
|
|
700150
|
|
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub _add { |
31
|
4493
|
|
|
4493
|
|
8397
|
my $rest = shift; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my @parts = map { |
34
|
4493
|
|
|
|
|
9448
|
my $old = $_; |
|
46308
|
|
|
|
|
290453
|
|
35
|
|
|
|
|
|
|
|
36
|
46308
|
|
|
|
|
89920
|
my $right = $rest->diff($old); |
37
|
46308
|
|
|
|
|
9489860
|
my $left = $old->diff($rest); |
38
|
46308
|
|
|
|
|
9235494
|
my $both = $old->intersect($rest); |
39
|
|
|
|
|
|
|
|
40
|
46308
|
|
|
|
|
9129664
|
$rest = $right; |
41
|
|
|
|
|
|
|
|
42
|
46308
|
|
|
|
|
82903
|
grep { !$_->empty } $left, $both |
|
92616
|
|
|
|
|
405177
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
} @_; |
45
|
|
|
|
|
|
|
|
46
|
4493
|
100
|
|
|
|
36931
|
push @parts, $rest unless $rest->empty; |
47
|
4493
|
|
|
|
|
99380
|
return @parts; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub intspan_partition { |
51
|
1001
|
|
|
1001
|
1
|
17394549
|
my @parts = (); |
52
|
|
|
|
|
|
|
|
53
|
1001
|
|
|
|
|
4711
|
@parts = _add($_, @parts) for @_; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# TODO: It's not really possible to get non-unique |
56
|
|
|
|
|
|
|
# items into the list? But play it safe for now. |
57
|
1001
|
|
|
|
|
3970
|
return _uniq @parts; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub intspan_partition_map { |
61
|
|
|
|
|
|
|
|
62
|
1000
|
|
|
1000
|
1
|
8059971
|
my @intspans = @_; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my @stacks = |
65
|
91201
|
|
|
91201
|
|
769442
|
stack_by { $_->[0] } |
66
|
359135
|
|
|
|
|
431642
|
sort { $a->[0] <=> $b->[0] } |
67
|
|
|
|
|
|
|
map { |
68
|
1000
|
|
|
|
|
7289
|
my $ix = $_; |
|
4487
|
|
|
|
|
7089
|
|
69
|
4487
|
|
|
|
|
11909
|
map { [ @$_, $ix ] } $intspans[$_]->spans |
|
91201
|
|
|
|
|
527146
|
|
70
|
|
|
|
|
|
|
} 0 .. $#intspans; |
71
|
|
|
|
|
|
|
|
72
|
1000
|
100
|
|
|
|
21743
|
return unless @stacks; |
73
|
|
|
|
|
|
|
|
74
|
893
|
|
|
|
|
2617
|
my $min_overall = min(map { $_->[0] } map { @$_ } @stacks); |
|
91201
|
|
|
|
|
117540
|
|
|
55808
|
|
|
|
|
71358
|
|
75
|
893
|
|
|
|
|
6174
|
my $max_overall = max(map { $_->[1] } map { @$_ } @stacks); |
|
91201
|
|
|
|
|
115969
|
|
|
55808
|
|
|
|
|
70271
|
|
76
|
|
|
|
|
|
|
|
77
|
893
|
|
|
|
|
5067
|
push @{ $stacks[0] }, |
|
893
|
|
|
|
|
3924
|
|
78
|
|
|
|
|
|
|
[ $min_overall, |
79
|
|
|
|
|
|
|
$max_overall + 1, '' ]; |
80
|
|
|
|
|
|
|
|
81
|
893
|
|
|
|
|
3406
|
push @stacks,[ |
82
|
|
|
|
|
|
|
[ $max_overall + 1, |
83
|
|
|
|
|
|
|
$max_overall + 1, '' ] ]; |
84
|
|
|
|
|
|
|
|
85
|
893
|
|
|
|
|
4035
|
for (my $ix = 0; $ix < @stacks - 1; ++$ix) { |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $max = min( |
88
|
|
|
|
|
|
|
$stacks[$ix+1][0][0] - 1, |
89
|
75041
|
|
|
|
|
119316
|
map { $_->[1] } @{ $stacks[$ix] }, |
|
231936
|
|
|
|
|
349079
|
|
|
75041
|
|
|
|
|
106381
|
|
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my @current_stack = |
93
|
231936
|
|
|
|
|
475571
|
map { [ $_->[0], min($_->[1], $max), $_->[2] ] } |
94
|
75041
|
|
|
|
|
105462
|
@{ $stacks[$ix] }; |
|
75041
|
|
|
|
|
105428
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
my @new_stack = |
97
|
231936
|
|
|
|
|
402712
|
grep { $_->[0] <= $_->[1] } |
98
|
231936
|
|
|
|
|
410537
|
map { [ $max + 1, $_->[1], $_->[2] ] } |
99
|
75041
|
|
|
|
|
101482
|
@{ $stacks[$ix] }; |
|
75041
|
|
|
|
|
105661
|
|
100
|
|
|
|
|
|
|
|
101
|
75041
|
|
|
|
|
153777
|
$stacks[$ix] = \@current_stack; |
102
|
|
|
|
|
|
|
|
103
|
75041
|
100
|
|
|
|
135561
|
if ($max + 1 == $stacks[$ix+1][0][0]) { |
104
|
55808
|
|
|
|
|
67609
|
push @{ $stacks[$ix+1] }, @new_stack; |
|
55808
|
|
|
|
|
139539
|
|
105
|
|
|
|
|
|
|
} else { |
106
|
19233
|
|
|
|
|
48984
|
splice @stacks, $ix+1, 0, \@new_stack; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my %h = partition_by { |
112
|
75934
|
|
|
75934
|
|
255624
|
join ',', sort { $a cmp $b } uniq map { $_->[2] } @$_ |
|
215869
|
|
|
|
|
470289
|
|
|
233722
|
|
|
|
|
495386
|
|
113
|
|
|
|
|
|
|
} grep { |
114
|
893
|
|
|
|
|
5315
|
scalar @$_ |
|
75934
|
|
|
|
|
92842
|
|
115
|
|
|
|
|
|
|
} @stacks; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# TODO(bh): this could be nicer: |
118
|
|
|
|
|
|
|
|
119
|
893
|
|
|
|
|
19879
|
my %map; |
120
|
893
|
|
|
|
|
5129
|
while (my ($k, $v) = each %h) { |
121
|
26225
|
|
|
|
|
73595
|
for my $in (split/,/, $k) { |
122
|
|
|
|
|
|
|
my $class = Set::IntSpan->new([map { |
123
|
223146
|
|
|
|
|
510009
|
[ $_->[0], $_->[1] ] |
124
|
101420
|
|
|
|
|
164175
|
} grep { $_->[2] eq $in } map { @$_ } @$v]); |
|
856672
|
|
|
|
|
1410660
|
|
|
223146
|
|
|
|
|
377786
|
|
125
|
101420
|
|
|
|
|
6758166
|
push @{ $map{$in} }, $class; |
|
101420
|
|
|
|
|
289905
|
|
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
893
|
|
|
|
|
24791
|
delete $map{''}; |
130
|
|
|
|
|
|
|
|
131
|
893
|
|
|
|
|
96430
|
return %map; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
1; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
__END__ |