File Coverage

blib/lib/Paranoid/Data/AVLTree/AVLNode.pm
Criterion Covered Total %
statement 102 114 89.4
branch 19 20 95.0
condition 1 3 33.3
subroutine 31 34 91.1
pod 21 21 100.0
total 174 192 90.6


line stmt bran cond sub pod time code
1             # Paranoid::Data::AVLTree::AVLNode -- AVL Tree Node Object Class
2             #
3             # $Id: lib/Paranoid/Data/AVLTree/AVLNode.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
4             #
5             # This software is free software. Similar to Perl, you can redistribute it
6             # and/or modify it under the terms of either:
7             #
8             # a) the GNU General Public License
9             # as published by the
10             # Free Software Foundation ; either version 1
11             # , or any later version
12             # , or
13             # b) the Artistic License 2.0
14             # ,
15             #
16             # subject to the following additional term: No trademark rights to
17             # "Paranoid" have been or are conveyed under any of the above licenses.
18             # However, "Paranoid" may be used fairly to describe this unmodified
19             # software, in good faith, but not as a trademark.
20             #
21             # (c) 2005 - 2020, Arthur Corliss (corliss@digitalmages.com)
22             # (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
23             #
24             #####################################################################
25              
26             #####################################################################
27             #
28             # Environment definitions
29             #
30             #####################################################################
31              
32             package Paranoid::Data::AVLTree::AVLNode;
33              
34 1     1   15 use 5.008;
  1         3  
35              
36 1     1   6 use strict;
  1         2  
  1         16  
37 1     1   4 use warnings;
  1         2  
  1         31  
38 1     1   5 use vars qw($VERSION);
  1         2  
  1         41  
39 1     1   6 use base qw(Exporter);
  1         1  
  1         52  
40 1     1   5 use Paranoid;
  1         2  
  1         44  
41 1     1   6 use Carp;
  1         2  
  1         76  
42              
43             ($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );
44              
45 1     1   6 use constant AVLKEY => 0;
  1         2  
  1         58  
46 1     1   6 use constant AVLVAL => 1;
  1         1  
  1         54  
47 1     1   6 use constant AVLRIGHT => 2;
  1         1  
  1         38  
48 1     1   4 use constant AVLLEFT => 3;
  1         3  
  1         49  
49 1     1   5 use constant AVLRHEIGHT => 4;
  1         2  
  1         36  
50 1     1   5 use constant AVLLHEIGHT => 5;
  1         2  
  1         789  
51              
52             #####################################################################
53             #
54             # Module code follows
55             #
56             #####################################################################
57              
58             sub new {
59              
60             # Purpose: Instantiates an AVLNode object
61             # Returns: Object reference if successful, undef otherwise
62             # Usage: $obj = Paranoid::Data::AVLTree::AVLNode->new(
63             # $key, $val
64             # );
65              
66 25     25 1 32 my $class = shift;
67 25         39 my $key = shift;
68 25         30 my $val = shift;
69 25         35 my $self = [];
70              
71 25         37 bless $self, $class;
72 25 50 33     84 if ( defined $key and length $key ) {
73 25         59 $$self[AVLKEY] = $key;
74 25         32 $$self[AVLVAL] = $val;
75 25         37 $$self[AVLRHEIGHT] = 0;
76 25         44 $$self[AVLLHEIGHT] = 0;
77             } else {
78 0         0 $self = undef;
79             }
80              
81 25         49 return $self;
82             }
83              
84             sub key {
85              
86             # Purpose: Returns the node key
87             # Returns: String
88             # Usage: $key = $obj->key;
89              
90 855     855 1 1008 my $self = shift;
91 855         2003 return $$self[AVLKEY];
92             }
93              
94             sub val {
95              
96             # Purpose: Returns the node value
97             # Returns: Scalar/undef
98             # Usage: $val = $node->val;
99              
100 35     35 1 52 my $self = shift;
101 35         95 return $$self[AVLVAL];
102             }
103              
104             sub setVal {
105              
106             # Purpose: Sets the node value
107             # Returns: Boolean
108             # Usage: $rv = $obj->setVal($val);
109              
110 0     0 1 0 my $self = shift;
111 0         0 my $val = shift;
112              
113 0         0 $$self[AVLVAL] = $val;
114              
115 0         0 return 1;
116             }
117              
118             sub right {
119              
120             # Purpose: Returns the right-side node reference
121             # Returns: AVLNode ref/undef
122             # Usage: $ref = $obj->right;
123              
124 256     256 1 322 my $self = shift;
125 256         617 return $$self[AVLRIGHT];
126             }
127              
128             sub setRight {
129              
130             # Purpose: Sets the right-side node reference
131             # Returns: Boolean
132             # Usage: $rv = $obj->setRight($node);
133              
134 34     34 1 46 my $self = shift;
135 34         42 my $val = shift;
136              
137 34         43 $$self[AVLRIGHT] = $val;
138 34 100       65 $$self[AVLRHEIGHT] = defined $val ? $val->height : 0;
139              
140 34         58 return 1;
141             }
142              
143             sub left {
144              
145             # Purpose: Returns the left-side node reference
146             # Returns: AVLNode ref/undef
147             # Usage: $ref = $obj->left;
148              
149 185     185 1 247 my $self = shift;
150 185         446 return $$self[AVLLEFT];
151             }
152              
153             sub setLeft {
154              
155             # Purpose: Sets the left-side node reference
156             # Returns: Boolean
157             # Usage: $rv = $obj->setLeft($node);
158              
159 25     25 1 34 my $self = shift;
160 25         28 my $val = shift;
161              
162 25         33 $$self[AVLLEFT] = $val;
163 25 100       56 $$self[AVLLHEIGHT] = defined $val ? $val->height : 0;
164              
165 25         54 return 1;
166             }
167              
168             sub incrRHeight {
169              
170             # Purpose: Increments the right-side branch height
171             # Returns: Boolean
172             # Usage: $rv = $obj->incrRHeight;
173              
174 30     30 1 39 my $self = shift;
175              
176 30         35 $$self[AVLRHEIGHT]++;
177              
178 30         57 return 1;
179             }
180              
181             sub incrLHeight {
182              
183             # Purpose: Increments the left-side branch height
184             # Returns: Boolean
185             # Usage: $rv = $obj->incrLHeight;
186              
187 18     18 1 25 my $self = shift;
188              
189 18         23 $$self[AVLLHEIGHT]++;
190              
191 18         36 return 1;
192             }
193              
194             sub addRHeight {
195              
196             # Purpose: Adds the passed value to the right-side height
197             # Returns: Boolean
198             # Usage: $rv = $obj->addRHeight($n);
199              
200 0     0 1 0 my $self = shift;
201 0         0 my $n = shift;
202              
203 0         0 $$self[AVLRHEIGHT] += $n;
204              
205 0         0 return 1;
206             }
207              
208             sub addLHeight {
209              
210             # Purpose: Adds the passed value to the left-side height
211             # Returns: Boolean
212             # Usage: $rv = $obj->addLHeight($n);
213              
214 2     2 1 3 my $self = shift;
215 2         3 my $n = shift;
216              
217 2         2 $$self[AVLLHEIGHT] += $n;
218              
219 2         6 return 1;
220             }
221              
222             sub decrRHeight {
223              
224             # Purpose: Decrements the right-side branch height
225             # Returns: Boolean
226             # Usage: $rv = $obj->decrRHeight;
227              
228 2     2 1 3 my $self = shift;
229              
230 2         3 $$self[AVLRHEIGHT]--;
231              
232 2         5 return 1;
233             }
234              
235             sub decrLHeight {
236              
237             # Purpose: Decrements the left-side branch height
238             # Returns: Boolean
239             # Usage: $rv = $obj->decrLHeight;
240              
241 0     0 1 0 my $self = shift;
242              
243 0         0 $$self[AVLLHEIGHT]--;
244              
245 0         0 return 1;
246             }
247              
248             sub balance {
249              
250             # Purpose: Returns the current balance of right/left-side branch heights
251             # Returns: Integer
252             # Usage: $balance = $obj->balance;
253              
254 196     196 1 241 my $self = shift;
255              
256 196         484 return $$self[AVLRHEIGHT] - $$self[AVLLHEIGHT];
257             }
258              
259             sub count {
260              
261             # Purpose: Returns the count of nodes from this node and its sub-branches
262             # Returns: Integer
263             # Usage: $count = $obj->count;
264              
265 41     41 1 45 my $self = shift;
266 41         44 my $rv = 1;
267              
268 41 100       81 $rv += $$self[AVLRIGHT]->count if defined $$self[AVLRIGHT];
269 41 100       64 $rv += $$self[AVLLEFT]->count if defined $$self[AVLLEFT];
270              
271 41         82 return $rv;
272             }
273              
274             sub height {
275              
276             # Purpose: Returns the height of this node and its longest sub-branch
277             # Returns: Integer
278             # Usage: $height = $obj->height;
279              
280 128     128 1 151 my $self = shift;
281              
282 128 100       252 return 1 + (
283             $$self[AVLRHEIGHT] > $$self[AVLLHEIGHT]
284             ? $$self[AVLRHEIGHT]
285             : $$self[AVLLHEIGHT] );
286             }
287              
288             sub rHeight {
289              
290             # Purpose: Returns the height of the right-side sub-branch
291             # Returns: Integer
292             # Usage: $height = $obj->rHeight;
293              
294 7     7 1 8 my $self = shift;
295              
296 7         30 return $$self[AVLRHEIGHT];
297             }
298              
299             sub lHeight {
300              
301             # Purpose: Returns the height of the left-side sub-branch
302             # Returns: Integer
303             # Usage: $height = $obj->lHeight;
304              
305 4     4 1 5 my $self = shift;
306              
307 4         9 return $$self[AVLLHEIGHT];
308             }
309              
310             sub updtHeights {
311              
312             # Purpose: Brute force method of recalculating all sub-branch heights
313             # Returns: Boolean
314             # Usage: $rv = $obj->updtHeights;
315              
316 42     42 1 52 my $self = shift;
317              
318 42 100       75 $$self[AVLRHEIGHT] =
319             defined $$self[AVLRIGHT]
320             ? $$self[AVLRIGHT]->height
321             : 0;
322 42 100       72 $$self[AVLLHEIGHT] =
323             defined $$self[AVLLEFT] ? $$self[AVLLEFT]->height : 0;
324              
325 42         62 return 1;
326             }
327              
328             sub children {
329              
330             # Purpose: Returns all nodes linked to from this node
331             # Returns: Array of AVLNode refs
332             # Usage: @crefs = $obj->children;
333              
334 5     5 1 10 my $self = shift;
335 5         6 my @rv;
336              
337 5 100       14 push @rv, $$self[AVLRIGHT] if defined $$self[AVLRIGHT];
338 5 100       10 push @rv, $$self[AVLLEFT] if defined $$self[AVLLEFT];
339              
340 5         14 return @rv;
341             }
342              
343             1;
344              
345             __END__