File Coverage

blib/lib/Data/Freq/Node.pm
Criterion Covered Total %
statement 41 42 97.6
branch 7 8 87.5
condition 3 6 50.0
subroutine 16 17 94.1
pod 13 13 100.0
total 80 86 93.0


line stmt bran cond sub pod time code
1 3     3   65 use 5.006;
  3         11  
  3         124  
2 3     3   26 use strict;
  3         6  
  3         95  
3 3     3   17 use warnings;
  3         6  
  3         122  
4              
5             package Data::Freq::Node;
6              
7             =head1 NAME
8              
9             Data::Freq::Node - Represents a node of the result tree constructed by Data::Freq
10              
11             =cut
12              
13 3     3   18 use List::Util;
  3         6  
  3         1806  
14              
15             =head1 METHODS
16              
17             =head2 new
18              
19             Usage:
20              
21             my $root_node = Data::Freq::Node->new();
22              
23             Constructs a node object in the L.
24              
25             =cut
26              
27             sub new {
28 81     81 1 123 my ($class, $value, $parent) = @_;
29            
30 81 100       187 if (ref $class) {
31 68   33     136 $parent ||= $class;
32 68         110 $class = ref $class;
33             }
34            
35 81         98 my $depth = 0;
36            
37 81 100       157 if ($parent) {
38 68         125 $depth = $parent->depth + 1;
39 68         106 $parent->{unique}++;
40             }
41            
42 81         814 return bless {
43             # For this node's own
44             count => 0,
45             value => $value,
46            
47             # Parent & children
48             parent => $parent,
49             children => {},
50             first => undef,
51             last => undef,
52             unique => 0,
53            
54             # Depth from root
55             depth => $depth,
56             }, $class;
57             }
58              
59             =head2 add_subnode
60              
61             Usage:
62              
63             my $child_node = $parent_node->add_subnode('normalized text');
64              
65             Adds a normalized value and returns the corresponding subnode.
66              
67             If the normalized text appears for the first time under the parent node,
68             a new node is created. Otherwise, the existing node is returned with its count
69             incremented by 1.
70              
71             =cut
72              
73             sub add_subnode {
74 233     233 1 322 my ($self, $value) = @_;
75 233   66     437 my $child = ($self->children->{$value} ||= $self->new($value, $self));
76            
77 233 100       444 $child->{first} = $self->count if $child->count == 0;
78 233         441 $child->{last} = $self->count;
79            
80 233         319 $child->{count}++;
81            
82 233         1238 return $child;
83             }
84              
85             =head2 count
86              
87             Retrieves the count for the normalized text.
88              
89             =head2 value
90              
91             Retrieves the normalized value.
92              
93             =head2 parent
94              
95             Retrieves the parent node in the L.
96              
97             For the root node, C is returned.
98              
99             =head2 children
100              
101             Retrieves a hash ref of the raw counting results under this node,
102             where the key is the normalized text and the value is the corresponding subnode.
103              
104             =head2 unique
105              
106             Retrieves the number of the child nodes.
107              
108             =head2 max
109              
110             Calculates the maximum count of the child nodes.
111              
112             =head2 min
113              
114             Calculates the minimum count of the child nodes.
115              
116             =head2 average
117              
118             Calculates the average count of the child nodes.
119              
120             =head2 first
121              
122             Retrieves the first occurrence index of this node under its parent node.
123              
124             The index is the count of the parent node at the time this child node is created.
125              
126             =head2 last
127              
128             Retrieves the last occurrence index of this node under its parent node.
129              
130             The index is the count of the parent node at the last time this child node is added or created.
131              
132             =head2 depth
133              
134             Retrieves the depth in the L.
135              
136             The depth of the root node is 0.
137              
138             =cut
139              
140 604     604 1 1463 sub count {$_[0]->{count }}
141 140     140 1 443 sub value {$_[0]->{value }}
142 0     0 1 0 sub parent {$_[0]->{parent }}
143 260     260 1 952 sub children {$_[0]->{children}}
144 18     18 1 53 sub unique {$_[0]->{unique }}
145 6     6 1 8 sub max {List::Util::max(map {$_->count} values %{$_[0]->children})}
  12         20  
  6         12  
146 6     6 1 9 sub min {List::Util::min(map {$_->count} values %{$_[0]->children})}
  12         24  
  6         13  
147 6 50   6 1 12 sub average {$_[0]->unique > 0 ? ($_[0]->count / $_[0]->unique) : undef};
148 174     174 1 707 sub first {$_[0]->{first }}
149 6     6 1 19 sub last {$_[0]->{last }}
150 140     140 1 464 sub depth {$_[0]->{depth }}
151              
152             =head1 AUTHOR
153              
154             Mahiro Ando, C<< >>
155              
156             =head1 LICENSE AND COPYRIGHT
157              
158             Copyright 2012 Mahiro Ando.
159              
160             This program is free software; you can redistribute it and/or modify it
161             under the terms of either: the GNU General Public License as published
162             by the Free Software Foundation; or the Artistic License.
163              
164             See http://dev.perl.org/licenses/ for more information.
165              
166             =cut
167              
168             1;