File Coverage

lib/Class/STL/Algorithms.pm
Criterion Covered Total %
statement 365 416 87.7
branch 105 166 63.2
condition 117 190 61.5
subroutine 53 56 94.6
pod 0 39 0.0
total 640 867 73.8


line stmt bran cond sub pod time code
1             # vim:ts=4 sw=4
2             # ----------------------------------------------------------------------------------------------------
3             # Name : Class::STL::Alogorithms.pm
4             # Created : 22 February 2006
5             # Author : Mario Gaffiero (gaffie)
6             #
7             # Copyright 2006-2007 Mario Gaffiero.
8             #
9             # This file is part of Class::STL::Containers(TM).
10             #
11             # Class::STL::Containers is free software; you can redistribute it and/or modify
12             # it under the terms of the GNU General Public License as published by
13             # the Free Software Foundation; version 2 of the License.
14             #
15             # Class::STL::Containers is distributed in the hope that it will be useful,
16             # but WITHOUT ANY WARRANTY; without even the implied warranty of
17             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18             # GNU General Public License for more details.
19             #
20             # You should have received a copy of the GNU General Public License
21             # along with Class::STL::Containers; if not, write to the Free Software
22             # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
23             # ----------------------------------------------------------------------------------------------------
24             # Modification History
25             # When Version Who What
26             # ----------------------------------------------------------------------------------------------------
27             # TO DO:
28             # ----------------------------------------------------------------------------------------------------
29             require 5.005_62;
30 7     7   47 use strict;
  7         14  
  7         217  
31 7     7   3208 use attributes qw(get reftype);
  7         7793  
  7         39  
32 7     7   416 use warnings;
  7         20  
  7         221  
33 7     7   39 use vars qw($VERSION $BUILD);
  7         13  
  7         359  
34             $VERSION = '0.22';
35             # ----------------------------------------------------------------------------------------------------
36             {
37             package Class::STL::Algorithms;
38 7     7   39 use UNIVERSAL;
  7         16  
  7         39  
39 7     7   185 use vars qw( @ISA @EXPORT_OK %EXPORT_TAGS );
  7         14  
  7         835  
40             require Exporter;
41             @ISA = 'Exporter';
42             my @export_names = qw(
43             find
44             find_if
45             for_each
46             transform
47             count
48             count_if
49             copy
50             copy_backward
51             remove
52             remove_if
53             remove_copy
54             remove_copy_if
55             replace
56             replace_if
57             replace_copy
58             replace_copy_if
59             generate
60             generate_n
61             fill
62             fill_n
63             equal
64             reverse
65             reverse_copy
66             rotate
67             rotate_copy
68             partition
69             stable_partition
70             min_element
71             max_element
72             unique
73             unique_copy
74             adjacent_find
75             _sort
76             stable_sort
77             qsort
78             stable_qsort
79             accumulate
80             );
81             @EXPORT_OK = (@export_names);
82             %EXPORT_TAGS = ( all => [@export_names] );
83             sub new
84             {
85 7     7   54 use Carp qw(confess);
  7         13  
  7         2405  
86 0     0 0 0 confess "@{[ __PACKAGE__ ]} contains STATIC functions only!\n";
  0         0  
87             }
88             sub accumulate # (iterator-start, iterator-finish, element [, binary-function ] )
89             {
90 3     3 0 11 my $iter_start = shift;
91 3         8 my $iter_finish = shift;
92 3         6 my $element = shift;
93 3   100     23 my $binary_op = shift || undef;
94 3         75 $element = $iter_start->p_container()->factory($element);
95 3 100       24 defined($binary_op)
96             ? _usage_check('accumulate', 'IIEB', $iter_start, $iter_finish, $element, $binary_op)
97             : _usage_check('accumulate', 'IIE', $iter_start, $iter_finish, $element);
98 3         74 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
99             {
100 28 50 33     77 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
101             {
102 0         0 accumulate($iter->p_element()->begin(), $iter->p_element()->end(), $element, $binary_op); # its a tree -- recurse
103             }
104             else
105             {
106 28 100       89 defined($binary_op)
107             ? $element = $binary_op->function_operator($element, $iter->p_element())
108             : $element->add($iter->p_element());
109             }
110             }
111 3         69 return $element;
112             }
113             sub BEGIN
114             {
115 7     7   515 eval "use sort qw(stable)";
  7     7   3015  
  7         3821  
  7         39  
116 7         207 my $have_sort = !$@;
117 7         16 my $eval =
118             "
119             sub qsort # (iterator-start, iterator-finish [, binary-function ] )
120             {
121 7 50       43 @{[ $have_sort ? 'use sort qw(_qsort);' : '' ]}
122             _sort(\@_);
123             }
124             sub stable_qsort # (iterator-start, iterator-finish [, binary-function ] )
125             {
126 7 50       32 @{[ $have_sort ? 'use sort qw(stable _qsort);' : '' ]}
127             _sort(\@_);
128             }
129             sub stable_sort # (iterator-start, iterator-finish [, binary-function ] )
130             {
131 7 50       30 @{[ $have_sort ? 'use sort qw(stable);' : '' ]}
132             _sort(\@_);
133             }
134             "
135             ;
136 7     7 0 389 eval($eval);
  7     7 0 41  
  7     7 0 15  
  7     1   28  
  7     1   566  
  7     1   16  
  7         26  
  7         604  
  7         16  
  7         27  
  1         8  
  1         6  
  1         9  
137 7 50       435 confess "@{[ __PACKAGE__ ]} Invalid sort pragma usage!\n" if ($@);
  0         0  
138            
139             }
140             sub _sort # (iterator-start, iterator-finish [, binary-function ] )
141             {
142 7     7   43 use Class::STL::Iterators qw(distance);
  7         18  
  7         30541  
143 4 100   4   37 int(@_) == 2 ? _usage_check('sort(1)', 'II', @_) : _usage_check('sort(2)', 'IIB', @_);
144 4         11 my $iter_start = shift;
145 4         10 my $iter_finish = shift;
146 4   100     21 my $binary_op = shift || undef;
147             defined($binary_op)
148 2         46 ? CORE::splice(@{$iter_start->p_container()->data()}, $iter_start->arr_idx(), distance($iter_start, $iter_finish)+1,
149 112         297 CORE::sort { $binary_op->function_operator($a, $b) }
150 2         44 (@{$iter_start->p_container()->data()}[$iter_start->arr_idx()..$iter_finish->arr_idx()]))
151 2         49 : CORE::splice(@{$iter_start->p_container()->data()}, $iter_start->arr_idx(), distance($iter_start, $iter_finish)+1,
152 112         264 CORE::sort { $a->cmp($b) }
153 4 100       14 (@{$iter_start->p_container()->data()}[$iter_start->arr_idx()..$iter_finish->arr_idx()]));
  2         50  
154 4         42 return; # void
155             }
156             sub transform
157             {
158 16 100   16 0 88 return @_ == 5 ? transform_2(@_) : transform_1(@_);
159             }
160             sub transform_1 # (iterator-start, iterator-finish, iterator-result, unary-function-object)
161             {
162 12     12 0 59 _usage_check('transform(1)', 'IIIU', @_);
163 12         21 my $iter_start = shift;
164 12         20 my $iter_finish = shift;
165 12         26 my $iter_result = shift;
166 12         19 my $unary_op = shift; # unary-function
167 12         253 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
168             {
169 63 50 33     136 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::AbstracTree'))
    50          
170             {
171 0         0 transform_1($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $unary_op); # its a tree -- recurse
172             }
173             elsif ($unary_op->isa('Class::STL::Utilities::FunctionObject::UnaryPredicate'))
174             {
175             # Need to check this!
176 0         0 my $e = $iter->p_element()->clone();
177 0 0       0 $e->data($unary_op->function_operator($iter->p_element()) ? 1 : 0);
178 0         0 $iter_result->p_container()->insert($iter_result, $e);
179             }
180             else # $unary_op->isa('Class::STL::Utilities::FunctionObject::UnaryFunction')
181             {
182 63         1087 $iter_result->p_container()->insert($iter_result,
183             $unary_op->function_operator($iter->p_element()));
184             }
185             }
186 12         69 return;
187             }
188             sub transform_2 # (iterator-start, iterator-finish, iterator-start2, iterator-result, binary-function-object)
189             {
190 4     4 0 21 _usage_check('transform(2)', 'IIIIB', @_);
191 4         7 my $iter_start = shift;
192 4         10 my $iter_finish = shift;
193 4         6 my $iter_start2 = shift;
194 4         8 my $iter_result = shift;
195 4         7 my $binary_op = shift; # binary-function
196 4   66     81 for
197             (
198             my $iter=$iter_start->clone(), my $iter2=$iter_start2->clone();
199             $iter <= $iter_finish && !$iter2->at_end();
200             ++$iter, ++$iter2
201             )
202             {
203 20 50 33     39 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::AbstracTree'))
    100          
204             {
205 0         0 transform_2($iter->p_element()->begin(), $iter->p_element()->end(), $iter_start2, $iter_result, $binary_op); # its a tree -- recurse
206             }
207             elsif ($binary_op->isa('Class::STL::Utilities::FunctionObject::BinaryPredicate'))
208             {
209 10         24 my $e = $iter->p_element()->clone();
210             #> $e->negate($binary_op->function_operator($iter->p_element(), $iter2->p_element()) ? 0 : 1);
211 10 100       23 $e->data($binary_op->function_operator($iter->p_element(), $iter2->p_element()) ? 1 : 0);
212 10         135 $iter_result->p_container()->insert($iter_result, $e);
213             }
214             else # $binary_op->isa('Class::STL::Utilities::FunctionObject::BinaryFunction')
215             {
216 10         143 $iter_result->p_container()->insert($iter_result,
217             $binary_op->function_operator($iter->p_element(), $iter2->p_element()));
218             }
219             }
220 4         25 return;
221             }
222             sub unique # (iterator, iterator [, binary-predicate ] ) -- static function
223             {
224 3 100   3 0 21 int(@_) == 2 ? _usage_check('unique(1)', 'II', @_) : _usage_check('unique(2)', 'IIB', @_);
225 3         8 my $iter_start = shift;
226 3         5 my $iter_finish = shift;
227 3   100     17 my $binary_op = shift || undef;
228 3         78 my $iter_prev = $iter_start->clone();
229 3   100     43 for (my $iter = $iter_start->clone()+1; $iter != $iter_prev && $iter <= $iter_finish; )
230             {
231 49 50 33     137 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100 100        
      100        
      66        
232             {
233 0         0 unique($iter->p_element()->begin(), $iter->p_element()->end(), $binary_op); # its a tree -- recurse
234 0         0 ++$iter;
235 0         0 ++$iter_prev;
236             }
237             elsif
238             (
239             (defined($binary_op) && $binary_op->function_operator($iter_prev->p_element(), $iter->p_element()))
240             || (!defined($binary_op) && $iter_prev->p_element()->eq($iter->p_element()))
241             )
242             {
243 16         317 $iter = $iter->p_container()->erase($iter)
244             }
245             else
246             {
247 33         109 ++$iter;
248 33         89 ++$iter_prev;
249             }
250             }
251 3         25 return $iter_finish; # iterator
252             }
253             sub unique_copy # (iterator, iterator, iterator [, binary-predicate ] ) -- static function
254             {
255 2 100   2 0 20 int(@_) == 3 ? _usage_check('unique_copy(1)', 'III', @_) : _usage_check('unique_copy(2)', 'IIIB', @_);
256 2         7 my $iter_start = shift;
257 2         6 my $iter_finish = shift;
258 2         6 my $iter_result = shift;
259 2   100     15 my $binary_op = shift || undef;
260 2         67 my $iter_prev = $iter_start->clone();
261 2         59 $iter_result->p_container()->insert($iter_result, 1, $iter_prev->p_element());
262 2   66     58 for (my $iter = $iter_start->clone()+1; $iter != $iter_prev && $iter <= $iter_finish; ++$iter, ++$iter_prev)
263             {
264 38 100 100     215 if
      100        
      100        
265             (
266             (defined($binary_op) && !$binary_op->function_operator($iter_prev->p_element(), $iter->p_element()))
267             || (!defined($binary_op) && !$iter_prev->p_element()->eq($iter->p_element()))
268             )
269             {
270 22         540 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
271             }
272             }
273 2         12 return $iter_result-1; # iterator
274             }
275             sub adjacent_find # (iterator, iterator [, binary-predicate ] ) -- static function
276             {
277 2 100   2 0 13 int(@_) == 2 ? _usage_check('adjacent_find(1)', 'II', @_) : _usage_check('adjacent_find(2)', 'IIB', @_);
278 2         3 my $iter_start = shift;
279 2         2 my $iter_finish = shift;
280 2   100     6 my $binary_op = shift || undef;
281 2         34 my $iter_next = $iter_start->clone()+1;
282 2         32 for (my $iter = $iter_start->clone(); $iter_next <= $iter_finish; ++$iter, ++$iter_next)
283             {
284 4 100 100     36 return $iter
      100        
      100        
285             if
286             (
287             (defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter_next->p_element()))
288             || (!defined($binary_op) && $iter_next->p_element()->eq($iter->p_element()))
289             );
290             }
291 0         0 return $iter_finish; # iterator
292             }
293             sub partition # (iterator, iterator, unary-predicate) -- static function
294             {
295 0     0 0 0 stable_partition(@_);
296             }
297             sub stable_partition # (iterator, iterator, unary-predicate) -- static function
298             {
299 1     1 0 9 _usage_check('stable_partition', 'IIU', @_);
300 1         3 my $iter_start = shift;
301 1         3 my $iter_finish = shift;
302 1         3 my $function = shift;
303 1         30 my $position = $iter_start->clone();
304 1         31 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
305             {
306 5 100       25 if ($function->function_operator($iter->p_element()))
307             {
308 3         99 $iter->p_container()->insert($position, 1, $iter->p_element());
309 3         85 $iter->p_container()->erase($iter+1);
310             }
311             }
312 1         11 return;
313             }
314             sub min_element # (iterator, iterator, [, binary-function] ) -- static function
315             {
316 2 100   2 0 20 int(@_) == 3 ? _usage_check('min_element(1)', 'IIB', @_) : _usage_check('min_element(2)', 'II', @_);
317 2         6 my $iter_start = shift;
318 2         8 my $iter_finish = shift;
319 2   100     16 my $binary_op = shift || undef;
320 2         6 my $iter_min = $iter_start;
321 2         62 for (my $iter=$iter_start->clone(); $iter <= $iter_finish; ++$iter)
322             {
323 14 100 100     80 $iter_min = $iter
      100        
      100        
324             if
325             (
326             (defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter_min->p_element()))
327             || (!defined($binary_op) && $iter->p_element()->lt($iter_min->p_element()))
328             );
329             }
330 2         18 return $iter_min;
331             }
332             sub max_element # (iterator, iterator, [, binary-function] ) -- static function
333             {
334 2 100   2 0 21 int(@_) == 3 ? _usage_check('max_element(1)', 'IIB', @_) : _usage_check('max_element(2)', 'II', @_);
335 2         6 my $iter_start = shift;
336 2         6 my $iter_finish = shift;
337 2   100     25 my $binary_op = shift || undef;
338 2         8 my $iter_min = $iter_start;
339 2         67 for (my $iter=$iter_start->clone(); $iter <= $iter_finish; ++$iter)
340             {
341 14 100 100     86 $iter_min = $iter
      100        
      100        
342             if
343             (
344             (defined($binary_op) && !$binary_op->function_operator($iter->p_element(), $iter_min->p_element()))
345             || (!defined($binary_op) && !$iter->p_element()->lt($iter_min->p_element()))
346             );
347             }
348 2         18 return $iter_min;
349             }
350             sub equal # (iterator, iterator, iterator [, binary-function] ) -- static function
351             {
352 5 100   5 0 31 int(@_) == 3 ? _usage_check('equal(1)', 'III', @_) : _usage_check('equal(2)', 'IIIB', @_);
353 5         10 my $iter_start = shift;
354 5         9 my $iter_finish = shift;
355 5         9 my $iter_start2 = shift;
356 5   100     23 my $binary_op = shift || undef;
357 5         113 for
358             (
359             my $iter=$iter_start->clone(), my $iter2=$iter_start2->clone();
360             $iter <= $iter_finish;
361             ++$iter, ++$iter2
362             )
363             {
364 14 100 100     39 return 0 if # bool false
      66        
      100        
      100        
365             (
366             $iter2->at_end()
367             || (defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter2->p_element()) == 0)
368             || (!defined($binary_op) && $iter->p_element()->eq($iter2->p_element()) == 0)
369             );
370             }
371 3         37 return 1; # bool true
372             }
373             sub rotate_copy # (iterator, iterator, iterator, iterator) -- static function
374             {
375 1     1 0 8 _usage_check('rotate_copy', 'IIII', @_);
376 1         3 my $iter_start = shift;
377 1         3 my $iter_mid = shift;
378 1         13 my $iter_finish = shift;
379 1         4 my $iter_result = shift;
380 1         9 copy($iter_mid, $iter_finish, $iter_result);
381 1         6 copy($iter_start, $iter_mid-1, $iter_result);
382 1         7 return;
383             }
384             sub rotate # (iterator, iterator, iterator) -- static function
385             {
386 1     1 0 8 _usage_check('rotate', 'III', @_);
387 1         3 my $iter_start = shift;
388 1         3 my $iter_mid = shift;
389 1         3 my $iter_finish = shift;
390 1         4 my $iter_end = $iter_finish; ++$iter_end;
  1         33  
391 1         28 for (my $iter = $iter_start->clone(); $iter < $iter_mid; ++$iter)
392             {
393 2         54 $iter->p_container()->insert($iter_end, 1, $iter->p_element());
394             }
395 1         30 $iter_start->p_container()->erase($iter_start, --$iter_mid);
396 1         11 return;
397             }
398             sub reverse # (iterator, iterator) -- static function
399             {
400 2     2 0 11 _usage_check('reverse', 'II', @_);
401 2         5 my $iter_start = shift;
402 2         4 my $iter_finish = shift;
403 2         46 for (my $i1=$iter_start->clone(), my $i2=$iter_finish->clone(); $i1 < $i2; ++$i1, --$i2)
404             {
405 3         15 $i1->p_element()->swap($i2->p_element());
406             }
407 2         14 return;
408             }
409             sub reverse_copy # (iterator, iterator, iterator) -- static function
410             {
411 2     2 0 13 _usage_check('reverse_copy', 'III', @_);
412 2         5 my $iter_start = shift;
413 2         5 my $iter_finish = shift;
414 2         5 my $iter_result = shift;
415 2         64 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
416             {
417 12         306 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
418 12         83 $iter_result--;
419             }
420 2         20 return;
421             }
422             sub for_each # (iterator, iterator, unary-function-object) -- static function
423             {
424 0     0 0 0 _usage_check('for_each', 'IIF', @_);
425 0         0 my $iter_start = shift;
426 0         0 my $iter_finish = shift;
427 0         0 my $function = shift; # unary-function
428 0         0 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
429             {
430 0 0 0     0 ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
431             ? for_each($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
432             : $function->function_operator($iter->p_element());
433             }
434 0         0 return;
435             }
436             sub generate # (iterator, iterator, generator-function-object) -- static function
437             {
438 1     1 0 13 _usage_check('generate', 'IIG', @_);
439 1         5 my $iter_start = shift;
440 1         4 my $iter_finish = shift;
441 1         4 my $function = shift; # generator-function
442 1         32 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
443             {
444 4 50 33     16 ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
445             ? generate($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
446             : $iter->p_element()->swap($function->function_operator());
447             }
448 1         7 return;
449             }
450             sub generate_n # (iterator, size, generator-function-object) -- static function
451             {
452 1     1 0 12 _usage_check('generate_n', 'ISG', @_);
453 1         3 my $iter_start = shift;
454 1         5 my $size = shift;
455 1         2 my $function = shift; # generator-function
456 1         32 my $iter = $iter_start->clone();
457 1         25 my $start_idx = $iter->arr_idx();
458 1         27 for (; $iter->arr_idx() - $start_idx < $size; ++$iter)
459             {
460 3 50 33     12 ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
461             ? generate_n($iter->p_element()->begin(), $size, $function) # its a tree -- recurse
462             : $iter->p_element()->swap($function->function_operator());
463             }
464 1         5 return;
465             }
466             sub fill # (iterator, iterator, element-ref) -- static function
467             {
468 2     2 0 7 my $iter_start = shift;
469 2         6 my $iter_finish = shift;
470 2         6 my $element = shift;
471 2 50 33     74 $element = $iter_start->p_container()->factory(data => $element)
472             unless (ref($element) && $element->isa('Class::STL::Element'));
473 2         16 _usage_check('fill', 'IIE', $iter_start, $iter_finish, $element);
474 2         58 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
475             {
476 5 50 33     20 ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
477             ? fill($iter->p_element()->begin(), $iter->p_element()->end(), $element) # its a tree -- recurse
478             : $iter->p_element()->swap($element->clone());
479             }
480 2         12 return;
481             }
482             sub fill_n # (iterator, size, element-ref) -- static function
483             {
484 2     2 0 6 my $iter_start = shift;
485 2         6 my $size = shift;
486 2         5 my $element = shift;
487 2 50 33     48 $element = $iter_start->p_container()->factory(data => $element)
488             unless (ref($element) && $element->isa('Class::STL::Element'));
489 2         12 _usage_check('fill_n', 'ISE', $iter_start, $size, $element);
490 2         59 my $iter = $iter_start->clone();
491 2         39 my $start_idx = $iter->arr_idx();
492 2         40 for (; $iter->arr_idx() - $start_idx < $size; ++$iter)
493             {
494 2 50 33     9 ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
495             ? fill_n($iter->p_element()->begin(), $size, $element) # its a tree -- recurse
496             : $iter->p_element()->swap($element->clone());
497             }
498 2         8 return;
499             }
500             sub find_if # (iterator, iterator, unary-function-object) -- static function
501             {
502 2     2 0 14 _usage_check('find_if', 'IIF', @_);
503 2         5 my $iter_start = shift;
504 2         4 my $iter_finish = shift;
505 2         6 my $function = shift; # unary-function
506 2         61 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
507             {
508 8 50 33     29 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
509             { # its a tree -- recurse
510 0 0       0 if (my $i = find_if($iter->p_element()->begin(), $iter->p_element()->end(), $function))
511             {
512 0         0 return $i; # Need to check this !!
513             }
514             }
515             elsif ($function->function_operator($iter->p_element()))
516             {
517 2         56 return $iter->clone(); # iterator
518             }
519             }
520 0         0 return 0;
521             }
522             sub find # (iterator, iterator, element-ref) -- static function
523             {
524 4     4 0 9 my $iter_start = shift;
525 4         9 my $iter_finish = shift;
526 4         6 my $element = shift; # element-ref
527 4 100 66     40 $element = $iter_start->p_container()->factory(data => $element)
528             unless (ref($element) && $element->isa('Class::STL::Element'));
529 4         19 _usage_check('find', 'IIE', $iter_start, $iter_finish, $element);
530 4         84 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
531             {
532 12 50 33     29 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
533             {
534 0 0       0 if (my $i = find($iter->p_element()->begin(), $iter->p_element()->end(), $element)) # its a tree -- recurse
535             {
536 0         0 return $i;
537             }
538             }
539             elsif ($element->eq($iter->p_element()))
540             {
541 4         72 return $iter->clone();
542             }
543             }
544 0         0 return 0;
545             }
546             sub count_if # (iterator, iterator, unary-function-object) -- static function
547             {
548 10     10 0 56 _usage_check('count_if', 'IIF', @_);
549 10         21 my $iter_start = shift;
550 10         18 my $iter_finish = shift;
551 10         16 my $function = shift; # unary-function
552 10         17 my $count=0;
553 10         262 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
554             {
555 50 100 33     127 $count +=
    50          
556             ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
557             ? count_if($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
558             : ($function->function_operator($iter->p_element()) ? 1 : 0);
559             }
560 10         92 return $count;
561             }
562             sub count # (iterator, iterator, element-ref) -- static function
563             {
564 1     1 0 2 my $iter_start = shift;
565 1         3 my $iter_finish = shift;
566 1         3 my $element = shift;
567 1 50 33     12 $element = $iter_start->p_container()->factory(data => $element)
568             unless (ref($element) && $element->isa('Class::STL::Element'));
569 1         8 _usage_check('count', 'IIE', $iter_start, $iter_finish, $element);
570 1         3 my $count=0;
571 1         30 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
572             {
573 9 100 33     31 $count +=
    50          
574             ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
575             ? count($iter->p_element()->begin(), $iter->p_element()->end(), $element) # its a tree -- recurse
576             : ($element->eq($iter->p_element()) ? 1 : 0);
577             }
578 1         13 return $count;
579             }
580             sub remove_if # (iterator, iterator, unary-function-object) -- static function
581             {
582 3     3 0 16 _usage_check('remove_if', 'IIF', @_);
583 3         6 my $iter_start = shift;
584 3         7 my $iter_finish = shift;
585 3         6 my $function = shift; # unary-function or class-member-name
586 3         70 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
587             {
588 18 50 33     55 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
589             {
590 0         0 remove_if($iter->p_element()->begin(), $iter->p_element()->end(), $function); # its a tree -- recurse
591 0         0 ++$iter;
592 0         0 next;
593             }
594 18 100       56 $function->function_operator($iter->p_element())
595             ? $iter->p_container()->erase($iter)
596             : ++$iter;
597             }
598 3         17 return;
599             }
600             sub remove # (iterator, iterator, element-ref) -- static function
601             {
602 2     2 0 5 my $iter_start = shift;
603 2         2 my $iter_finish = shift;
604 2         5 my $element = shift; # element-ref
605 2 50 33     13 $element = $iter_start->p_container()->factory(data => $element)
606             unless (ref($element) && $element->isa('Class::STL::Element'));
607 2         6 _usage_check('remove', 'IIE', $iter_start, $iter_finish, $element);
608 2         34 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
609             {
610 13 50 33     31 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
611             {
612 0         0 remove($iter->p_element()->begin(), $iter->p_element()->end(), $element); # its a tree -- recurse
613 0         0 ++$iter;
614 0         0 next;
615             }
616 13 100       58 $element->eq($iter->p_element())
617             ? $iter->p_container()->erase($iter)
618             : ++$iter;
619             }
620 2         13 return;
621             }
622             sub remove_copy_if # (iterator, iterator, iterator, unary-function-object) -- static function
623             {
624 1     1 0 8 _usage_check('remove_copy_if', 'IIIF', @_);
625 1         3 my $iter_start = shift;
626 1         4 my $iter_finish = shift;
627 1         31 my $iter_result = shift;
628 1         7 my $function = shift; # unary-function or class-member-name
629 1         34 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
630             {
631 9 50 33     27 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
632             {
633 0         0 remove_copy_if($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $function); # its a tree -- recurse
634             }
635             elsif (!$function->function_operator($iter->p_element()))
636             {
637 5         134 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
638             }
639             }
640 1         8 return;
641             }
642             sub remove_copy # (iterator, iterator, iterator, element-ref) -- static function
643             {
644 1     1 0 3 my $iter_start = shift;
645 1         2 my $iter_finish = shift;
646 1         4 my $iter_result = shift;
647 1         2 my $element = shift; # element-ref
648 1 50 33     10 $element = $iter_start->p_container()->factory(data => $element)
649             unless (ref($element) && $element->isa('Class::STL::Element'));
650 1         7 _usage_check('remove_copy', 'IIIE', $iter_start, $iter_finish, $iter_result, $element);
651 1         31 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
652             {
653 9 50 33     39 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
654             {
655 0         0 remove_copy($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $element); # its a tree -- recurse
656             }
657             elsif (!$element->eq($iter->p_element()))
658             {
659 5         132 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
660             }
661             }
662 1         9 return;
663             }
664             sub copy # (iterator, iterator, iterator) -- static function
665             {
666 8     8 0 43 _usage_check('copy', 'III', @_);
667 8         14 my $iter_start = shift;
668 8         16 my $iter_finish = shift;
669 8         13 my $iter_result = shift;
670 8         184 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
671             {
672 37         690 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
673             }
674 8         37 return;
675             }
676             sub copy_backward # (iterator, iterator, iterator) -- static function
677             {
678 3     3 0 14 _usage_check('copy_backward', 'III', @_);
679 3         5 my $iter_start = shift;
680 3         9 my $iter_finish = shift;
681 3         8 my $iter_result = shift;
682 3         77 for (my $iter = $iter_finish->clone(); $iter >= $iter_start; --$iter)
683             {
684 21         414 $iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
685             }
686 3         15 return;
687             }
688             sub replace_if # (iterator, iterator, unary-function, element-ref) -- static function
689             {
690 1     1 0 2 my $iter_start = shift;
691 1         4 my $iter_finish = shift;
692 1         3 my $function = shift;
693 1         16 my $new_element = shift; # element-ref
694 1 50 33     14 $new_element = $iter_start->p_container()->factory(data => $new_element)
695             unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
696 1         9 _usage_check('replace_if', 'IIFE', $iter_start, $iter_finish, $function, $new_element);
697 1         32 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
698             {
699 10 50 33     40 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
700             {
701 0         0 replace_if($iter->p_element()->begin(), $iter->p_element()->end(), $function, $new_element); # its a tree -- recurse
702             }
703             elsif ($function->function_operator($iter->p_element()))
704             {
705 4         128 $iter->p_container()->erase($iter);
706 4         111 $iter->p_container()->insert($iter, 1, $new_element);
707             }
708             else
709             {
710 6         24 ++$iter;
711             }
712             }
713 1         8 return;
714             }
715             sub replace # (iterator, iterator, element-ref, element-ref) -- static function
716             {
717 1     1 0 4 my $iter_start = shift;
718 1         3 my $iter_finish = shift;
719 1         3 my $old_element = shift; # element-ref
720 1         2 my $new_element = shift; # element-ref
721 1 50 33     14 $old_element = $iter_start->p_container()->factory(data => $old_element)
722             unless (ref($old_element) && $old_element->isa('Class::STL::Element'));
723 1 50 33     10 $new_element = $iter_start->p_container()->factory(data => $new_element)
724             unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
725 1         8 _usage_check('replace', 'IIEE', $iter_start, $iter_finish, $old_element, $new_element);
726 1         31 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
727             {
728 10 50 33     42 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
    100          
729             {
730 0         0 replace($iter->p_element()->begin(), $iter->p_element()->end(), $old_element, $new_element); # its a tree -- recurse
731             }
732             elsif ($iter->p_element()->eq($old_element))
733             {
734 4         109 $iter->p_container()->erase($iter);
735 4         110 $iter->p_container()->insert($iter, 1, $new_element);
736             }
737             else
738             {
739 6         22 ++$iter;
740             }
741             }
742 1         9 return;
743             }
744             sub replace_copy_if # (iterator, iterator, iterator, unary-function, element-ref) -- static function
745             {
746 1     1 0 4 my $iter_start = shift;
747 1         3 my $iter_finish = shift;
748 1         2 my $iter_result = shift;
749 1         13 my $function = shift;
750 1         5 my $new_element = shift; # element-ref
751 1 50 33     16 $new_element = $iter_start->p_container()->factory(data => $new_element)
752             unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
753 1         6 _usage_check('replace_copy_if', 'IIIFE', $iter_start, $iter_finish, $iter_result, $function, $new_element);
754 1         39 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
755             {
756 9 50 33     26 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
757             {
758             #? Insert tree here???
759 0         0 replace_copy_if($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $function, $new_element); # its a tree -- recurse
760             }
761             else
762             {
763 9 100       217 $iter_result->p_container()->insert($iter_result, 1,
764             ($function->function_operator($iter->p_element()) ? $new_element : $iter->p_element()));
765             }
766             }
767 1         8 return;
768             }
769             sub replace_copy # (iterator, iterator, iterator, element-ref, element-ref) -- static function
770             {
771 1     1 0 3 my $iter_start = shift;
772 1         4 my $iter_finish = shift;
773 1         2 my $iter_result = shift;
774 1         3 my $old_element = shift; # element-ref
775 1         2 my $new_element = shift; # element-ref
776 1 50 33     14 $old_element = $iter_start->p_container()->factory(data => $old_element)
777             unless (ref($old_element) && $old_element->isa('Class::STL::Element'));
778 1 50 33     12 $new_element = $iter_start->p_container()->factory(data => $new_element)
779             unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
780 1         6 _usage_check('replace_copy', 'IIIEE', $iter_start, $iter_finish, $iter_result, $old_element, $new_element);
781 1         32 for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
782             {
783 9 50 33     30 if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
784             {
785 0         0 replace_copy($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $old_element, $new_element); # its a tree -- recurse
786             }
787             else
788             {
789 9 100       234 $iter_result->p_container()->insert($iter_result, 1,
790             ($iter->p_element()->eq($old_element) ? $new_element : $iter->p_element()));
791             }
792             }
793 1         9 return;
794             }
795             #TODO:sub sort
796             #TODO:{
797             #TODO:}
798             #TODO:sub random_shuffle # ( [ random_number_generator ] )
799             #TODO:{
800             #TODO:}
801             #TODO:sub lower_bound
802             #TODO:{
803             #TODO:}
804             #TODO:sub upper_bound
805             #TODO:{
806             #TODO:}
807             sub _usage_check
808             {
809 7     7   60 use Carp qw(confess);
  7         15  
  7         1576  
810 91     91   244 my $function_name = shift;
811 91         412 my @format = split(//, shift);
812 91         206 my $check=0;
813 91         345 foreach my $arg (0..$#_) {
814 298 50 66     1271 confess "Undefined arg $arg"
815             if ($format[$arg] ne 'S' && !ref($_[$arg]));
816 298 50 66     2733 ++$check
      66        
817             if
818             (
819             defined($_[$arg])
820             &&
821             (
822             ($format[$arg] eq 'I' && $_[$arg]->isa('Class::STL::Iterators::Abstract'))
823             || ($format[$arg] eq 'F' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject'))
824             || ($format[$arg] eq 'B' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::BinaryFunction'))
825             || ($format[$arg] eq 'U' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::UnaryFunction'))
826             || ($format[$arg] eq 'G' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::Generator'))
827             || ($format[$arg] eq 'E' && $_[$arg]->isa('Class::STL::Element'))
828             || ($format[$arg] eq 'S' && !ref($_[$arg])) # Scalar
829             )
830             )
831             }
832 91 50       350 if ($check != int(@_)) {
833 7     7   50 use Carp qw(confess);
  7         15  
  7         1904  
834 0         0 my @anames;
835 0         0 foreach (@format) {
836 0 0       0 push(@anames, 'scalar') if (/S/);
837 0 0       0 push(@anames, 'iterator') if (/I/);
838 0 0       0 push(@anames, 'function-object') if (/F/);
839 0 0       0 push(@anames, 'unary-function-object') if (/U/);
840 0 0       0 push(@anames, 'generator-function-object') if (/G/);
841 0 0       0 push(@anames, 'binary-function-object') if (/B/);
842 0 0       0 push(@anames, 'element-ref') if (/E/);
843             }
844 0         0 confess "@{[ __PACKAGE__]}::$function_name usage:\n$function_name( @{[ join(', ', @anames) ]});\n"
  0         0  
  0         0  
845             }
846 91         246 return 1;
847             }
848             }
849             # ----------------------------------------------------------------------------------------------------
850             1;