| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Algorithm::Prefixspan; | 
| 2 | 3 |  |  | 3 |  | 49726 | use 5.008001; | 
|  | 3 |  |  |  |  | 12 |  | 
|  | 3 |  |  |  |  | 243 |  | 
| 3 | 3 |  |  | 3 |  | 22 | use strict; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 148 |  | 
| 4 | 3 |  |  | 3 |  | 30 | use warnings; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 124 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 3 |  |  | 3 |  | 2335 | use Moo; | 
|  | 3 |  |  |  |  | 57799 |  | 
|  | 3 |  |  |  |  | 20 |  | 
| 7 | 3 |  |  | 3 |  | 8627 | use MooX::Types::MooseLike::Base qw( ArrayRef HashRef Num Int Str ); | 
|  | 3 |  |  |  |  | 23901 |  | 
|  | 3 |  |  |  |  | 476 |  | 
| 8 | 3 |  |  | 3 |  | 2447 | use namespace::clean; | 
|  | 3 |  |  |  |  | 44956 |  | 
|  | 3 |  |  |  |  | 24 |  | 
| 9 | 3 |  |  | 3 |  | 1217 | use Carp; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 2586 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | our $VERSION = "0.03"; | 
| 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 | 52 | 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 | 8 | my $self = shift; | 
| 47 | 6 |  |  |  |  | 10 | my $prefix = shift; | 
| 48 | 6 |  |  |  |  | 7 | my $seq = shift; | 
| 49 |  |  |  |  |  |  |  | 
| 50 | 6 | 50 |  |  |  | 17 | if (ref $seq eq "ARRAY") { | 
| 51 | 6 |  |  |  |  | 18 | my $pattern = $self->extract($self->{minsup}, $seq); | 
| 52 | 6 | 50 |  |  |  | 17 | if (ref $pattern eq "HASH") { | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 6 |  |  |  |  | 6 | foreach my $i (keys %{$pattern}) { | 
|  | 6 |  |  |  |  | 27 |  | 
| 55 | 5 |  |  |  |  | 6 | my $p = $i; | 
| 56 | 5 | 100 |  |  |  | 11 | if ($prefix ne "") { | 
| 57 | 2 |  |  |  |  | 5 | $p = join " ", ($prefix, $i); | 
| 58 |  |  |  |  |  |  | } | 
| 59 | 5 |  |  |  |  | 20 | my $count = (() = $p =~ /\s+/g); | 
| 60 | 5 | 50 |  |  |  | 21 | if ($count >= $self->{len} - 1) { | 
| 61 | 5 |  |  |  |  | 12 | $self->{out}{"$p"} = $pattern->{$i}; | 
| 62 |  |  |  |  |  |  | } | 
| 63 | 5 |  |  |  |  | 11 | my $j = $self->projection($seq, $i); | 
| 64 | 5 |  |  |  |  | 23 | $self->prefixspan($p, $j); | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | sub extract { | 
| 71 | 6 |  |  | 6 | 0 | 8 | my $self = shift; | 
| 72 | 6 |  |  |  |  | 7 | my $minsup = shift; | 
| 73 | 6 |  |  |  |  | 5 | my $seq = shift; | 
| 74 | 6 |  |  |  |  | 6 | my $h; | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 6 |  |  |  |  | 17 | for (my $i = 0; $i < @$seq; $i++) { | 
| 77 | 13 |  |  |  |  | 34 | my @dist = split /\s+/, $seq->[$i]; | 
| 78 | 13 |  |  |  |  | 18 | map {$h->{$_}++} @dist; | 
|  | 25 |  |  |  |  | 68 |  | 
| 79 |  |  |  |  |  |  | } | 
| 80 | 6 |  |  |  |  | 9 | foreach my $i (keys %{$h}) { | 
|  | 6 |  |  |  |  | 19 |  | 
| 81 | 15 | 100 |  |  |  | 34 | if ($h->{$i} < $minsup) { | 
| 82 | 10 |  |  |  |  | 20 | delete $h->{$i}; | 
| 83 |  |  |  |  |  |  | } | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 | 6 |  |  |  |  | 13 | return $h; | 
| 87 |  |  |  |  |  |  | } | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | sub projection { | 
| 90 | 5 |  |  | 5 | 0 | 23 | my $self = shift; | 
| 91 | 5 |  |  |  |  | 5 | my $seq = shift; | 
| 92 | 5 |  |  |  |  | 6 | my $b = shift; | 
| 93 | 5 |  |  |  |  | 5 | my $h; | 
| 94 |  |  |  |  |  |  |  | 
| 95 | 5 |  |  |  |  | 6 | foreach my $i (@{$seq}) { | 
|  | 5 |  |  |  |  | 8 |  | 
| 96 | 18 |  |  |  |  | 45 | my @list = split /\s+/, $i; | 
| 97 | 18 |  |  |  |  | 43 | for (my $j = 0; $j < @list; $j++) { | 
| 98 | 39 | 100 |  |  |  | 101 | if ($list[$j] eq $b) { | 
| 99 | 14 |  |  |  |  | 21 | splice @list, 0, ($j +1); | 
| 100 | 14 | 100 |  |  |  | 37 | if (@list > 0) { | 
| 101 | 9 |  |  |  |  | 9 | push @{$h}, join " ", @list; | 
|  | 9 |  |  |  |  | 37 |  | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 5 |  |  |  |  | 10 | return $h; | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | 1; | 
| 112 |  |  |  |  |  |  | __END__ |