line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Algorithm::Prefixspan; |
2
|
3
|
|
|
3
|
|
31549
|
use 5.008001; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
94
|
|
3
|
3
|
|
|
3
|
|
13
|
use strict; |
|
3
|
|
|
|
|
2
|
|
|
3
|
|
|
|
|
91
|
|
4
|
3
|
|
|
3
|
|
21
|
use warnings; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
90
|
|
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
1455
|
use Moo; |
|
3
|
|
|
|
|
36071
|
|
|
3
|
|
|
|
|
16
|
|
7
|
3
|
|
|
3
|
|
5396
|
use MooX::Types::MooseLike::Base qw( ArrayRef HashRef Num Int Str ); |
|
3
|
|
|
|
|
15542
|
|
|
3
|
|
|
|
|
268
|
|
8
|
3
|
|
|
3
|
|
1505
|
use namespace::clean; |
|
3
|
|
|
|
|
29222
|
|
|
3
|
|
|
|
|
19
|
|
9
|
3
|
|
|
3
|
|
696
|
use Carp; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
1883
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.04"; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
has data => ( |
14
|
|
|
|
|
|
|
is => 'rw', |
15
|
|
|
|
|
|
|
isa => ArrayRef, |
16
|
|
|
|
|
|
|
required => 1, |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
has out => ( |
20
|
|
|
|
|
|
|
is => 'rw', |
21
|
|
|
|
|
|
|
isa => HashRef, |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
has minsup => ( |
25
|
|
|
|
|
|
|
is => 'rw', |
26
|
|
|
|
|
|
|
isa => Int, |
27
|
|
|
|
|
|
|
default => sub { 2 }, |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has len => ( |
31
|
|
|
|
|
|
|
is => 'rw', |
32
|
|
|
|
|
|
|
isa => Int, |
33
|
|
|
|
|
|
|
default => sub { 1 }, |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub run { |
37
|
1
|
|
|
1
|
0
|
31
|
my $self = shift; |
38
|
|
|
|
|
|
|
|
39
|
1
|
|
|
|
|
5
|
$self->prefixspan("", $self->{data}); |
40
|
|
|
|
|
|
|
|
41
|
1
|
|
|
|
|
4
|
return $self->{out}; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub prefixspan { |
46
|
6
|
|
|
6
|
0
|
7
|
my $self = shift; |
47
|
6
|
|
|
|
|
6
|
my $prefix = shift; |
48
|
6
|
|
|
|
|
5
|
my $seq = shift; |
49
|
|
|
|
|
|
|
|
50
|
6
|
50
|
|
|
|
15
|
if (ref $seq eq "ARRAY") { |
51
|
6
|
|
|
|
|
10
|
my $pattern = $self->extract($self->{minsup}, $seq); |
52
|
6
|
50
|
|
|
|
11
|
if (ref $pattern eq "HASH") { |
53
|
|
|
|
|
|
|
|
54
|
6
|
|
|
|
|
5
|
foreach my $i (keys %{$pattern}) { |
|
6
|
|
|
|
|
18
|
|
55
|
5
|
|
|
|
|
5
|
my $p = $i; |
56
|
5
|
100
|
|
|
|
7
|
if ($prefix ne "") { |
57
|
2
|
|
|
|
|
3
|
$p = join " ", ($prefix, $i); |
58
|
|
|
|
|
|
|
} |
59
|
5
|
|
|
|
|
17
|
my $count = (() = $p =~ /\s+/g); |
60
|
5
|
50
|
|
|
|
10
|
if ($count >= $self->{len} - 1) { |
61
|
5
|
|
|
|
|
9
|
$self->{out}{"$p"} = $pattern->{$i}; |
62
|
|
|
|
|
|
|
} |
63
|
5
|
|
|
|
|
8
|
my $j = $self->projection($seq, $i); |
64
|
5
|
|
|
|
|
15
|
$self->prefixspan($p, $j); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub extract { |
71
|
6
|
|
|
6
|
0
|
7
|
my $self = shift; |
72
|
6
|
|
|
|
|
5
|
my $minsup = shift; |
73
|
6
|
|
|
|
|
5
|
my $seq = shift; |
74
|
6
|
|
|
|
|
5
|
my $h; |
75
|
|
|
|
|
|
|
|
76
|
6
|
|
|
|
|
11
|
for (my $i = 0; $i < @$seq; $i++) { |
77
|
13
|
|
|
|
|
25
|
my @dist = split /\s+/, $seq->[$i]; |
78
|
13
|
|
|
|
|
11
|
map {$h->{$_}++} @dist; |
|
25
|
|
|
|
|
44
|
|
79
|
|
|
|
|
|
|
} |
80
|
6
|
|
|
|
|
5
|
foreach my $i (keys %{$h}) { |
|
6
|
|
|
|
|
13
|
|
81
|
15
|
100
|
|
|
|
22
|
if ($h->{$i} < $minsup) { |
82
|
10
|
|
|
|
|
15
|
delete $h->{$i}; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
6
|
|
|
|
|
11
|
return $h; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub projection { |
90
|
5
|
|
|
5
|
0
|
19
|
my $self = shift; |
91
|
5
|
|
|
|
|
5
|
my $seq = shift; |
92
|
5
|
|
|
|
|
5
|
my $b = shift; |
93
|
5
|
|
|
|
|
3
|
my $h; |
94
|
|
|
|
|
|
|
|
95
|
5
|
|
|
|
|
3
|
foreach my $i (@{$seq}) { |
|
5
|
|
|
|
|
8
|
|
96
|
18
|
|
|
|
|
25
|
my @list = split /\s+/, $i; |
97
|
18
|
|
|
|
|
34
|
for (my $j = 0; $j < @list; $j++) { |
98
|
39
|
100
|
|
|
|
72
|
if ($list[$j] eq $b) { |
99
|
14
|
|
|
|
|
16
|
splice @list, 0, ($j +1); |
100
|
14
|
100
|
|
|
|
29
|
if (@list > 0) { |
101
|
9
|
|
|
|
|
5
|
push @{$h}, join " ", @list; |
|
9
|
|
|
|
|
28
|
|
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
5
|
|
|
|
|
8
|
return $h; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
1; |
112
|
|
|
|
|
|
|
__END__ |