# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
# Name : Class::STL::Alogorithms.pm
# Created : 22 February 2006
# Author : Mario Gaffiero (gaffie)
#
# Copyright 2006-2007 Mario Gaffiero.
#
# This file is part of Class::STL::Containers(TM).
#
# Class::STL::Containers is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# Class::STL::Containers is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Class::STL::Containers; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# ----------------------------------------------------------------------------------------------------
# Modification History
# When Version Who What
# ----------------------------------------------------------------------------------------------------
# TO DO:
# ----------------------------------------------------------------------------------------------------
require 5.005_62;
use strict;
use attributes qw(get reftype);
use warnings;
use vars qw($VERSION $BUILD);
$VERSION = '0.21';
$BUILD = 'Monday May 8 23:08:34 GMT 2006';
# ----------------------------------------------------------------------------------------------------
{
package Class::STL::Algorithms;
use UNIVERSAL qw(isa can);
use vars qw( @EXPORT_OK %EXPORT_TAGS );
use Exporter;
my @export_names = qw(
find
find_if
for_each
transform
count
count_if
copy
copy_backward
remove
remove_if
remove_copy
remove_copy_if
replace
replace_if
replace_copy
replace_copy_if
generate
generate_n
fill
fill_n
equal
reverse
reverse_copy
rotate
rotate_copy
partition
stable_partition
min_element
max_element
unique
unique_copy
adjacent_find
_sort
stable_sort
qsort
stable_qsort
accumulate
);
@EXPORT_OK = (@export_names);
%EXPORT_TAGS = ( all => [@export_names] );
sub new
{
use Carp qw(confess);
confess "@{[ __PACKAGE__ ]} contains STATIC functions only!\n";
}
sub accumulate # (iterator-start, iterator-finish, element [, binary-function ] )
{
my $iter_start = shift;
my $iter_finish = shift;
my $element = shift;
my $binary_op = shift || undef;
$element = $iter_start->p_container()->factory($element);
defined($binary_op)
? _usage_check('accumulate', 'IIEB', $iter_start, $iter_finish, $element, $binary_op)
: _usage_check('accumulate', 'IIE', $iter_start, $iter_finish, $element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
accumulate($iter->p_element()->begin(), $iter->p_element()->end(), $element, $binary_op); # its a tree -- recurse
}
else
{
defined($binary_op)
? $element = $binary_op->function_operator($element, $iter->p_element())
: $element->add($iter->p_element());
}
}
return $element;
}
sub BEGIN
{
eval "use sort qw(stable)";
my $have_sort = !$@;
my $eval =
"
sub qsort # (iterator-start, iterator-finish [, binary-function ] )
{
@{[ $have_sort ? 'use sort qw(_qsort);' : '' ]}
_sort(\@_);
}
sub stable_qsort # (iterator-start, iterator-finish [, binary-function ] )
{
@{[ $have_sort ? 'use sort qw(stable _qsort);' : '' ]}
_sort(\@_);
}
sub stable_sort # (iterator-start, iterator-finish [, binary-function ] )
{
@{[ $have_sort ? 'use sort qw(stable);' : '' ]}
_sort(\@_);
}
"
;
eval($eval);
confess "@{[ __PACKAGE__ ]} Invalid sort pragma usage!\n" if ($@);
}
sub _sort # (iterator-start, iterator-finish [, binary-function ] )
{
use Class::STL::Iterators qw(distance);
int(@_) == 2 ? _usage_check('sort(1)', 'II', @_) : _usage_check('sort(2)', 'IIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $binary_op = shift || undef;
defined($binary_op)
? CORE::splice(@{$iter_start->p_container()->data()}, $iter_start->arr_idx(), distance($iter_start, $iter_finish)+1,
CORE::sort { $binary_op->function_operator($a, $b) }
(@{$iter_start->p_container()->data()}[$iter_start->arr_idx()..$iter_finish->arr_idx()]))
: CORE::splice(@{$iter_start->p_container()->data()}, $iter_start->arr_idx(), distance($iter_start, $iter_finish)+1,
CORE::sort { $a->cmp($b) }
(@{$iter_start->p_container()->data()}[$iter_start->arr_idx()..$iter_finish->arr_idx()]));
return; # void
}
sub transform
{
return @_ == 5 ? transform_2(@_) : transform_1(@_);
}
sub transform_1 # (iterator-start, iterator-finish, iterator-result, unary-function-object)
{
_usage_check('transform(1)', 'IIIU', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $unary_op = shift; # unary-function
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::AbstracTree'))
{
transform_1($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $unary_op); # its a tree -- recurse
}
elsif ($unary_op->isa('Class::STL::Utilities::FunctionObject::UnaryPredicate'))
{
# Need to check this!
my $e = $iter->p_element()->clone();
$e->data($unary_op->function_operator($iter->p_element()) ? 1 : 0);
$iter_result->p_container()->insert($iter_result, $e);
}
else # $unary_op->isa('Class::STL::Utilities::FunctionObject::UnaryFunction')
{
$iter_result->p_container()->insert($iter_result,
$unary_op->function_operator($iter->p_element()));
}
}
return;
}
sub transform_2 # (iterator-start, iterator-finish, iterator-start2, iterator-result, binary-function-object)
{
_usage_check('transform(2)', 'IIIIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_start2 = shift;
my $iter_result = shift;
my $binary_op = shift; # binary-function
for
(
my $iter=$iter_start->clone(), my $iter2=$iter_start2->clone();
$iter <= $iter_finish && !$iter2->at_end();
++$iter, ++$iter2
)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::AbstracTree'))
{
transform_2($iter->p_element()->begin(), $iter->p_element()->end(), $iter_start2, $iter_result, $binary_op); # its a tree -- recurse
}
elsif ($binary_op->isa('Class::STL::Utilities::FunctionObject::BinaryPredicate'))
{
my $e = $iter->p_element()->clone();
#> $e->negate($binary_op->function_operator($iter->p_element(), $iter2->p_element()) ? 0 : 1);
$e->data($binary_op->function_operator($iter->p_element(), $iter2->p_element()) ? 1 : 0);
$iter_result->p_container()->insert($iter_result, $e);
}
else # $binary_op->isa('Class::STL::Utilities::FunctionObject::BinaryFunction')
{
$iter_result->p_container()->insert($iter_result,
$binary_op->function_operator($iter->p_element(), $iter2->p_element()));
}
}
return;
}
sub unique # (iterator, iterator [, binary-predicate ] ) -- static function
{
int(@_) == 2 ? _usage_check('unique(1)', 'II', @_) : _usage_check('unique(2)', 'IIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $binary_op = shift || undef;
my $iter_prev = $iter_start->clone();
for (my $iter = $iter_start->clone()+1; $iter != $iter_prev && $iter <= $iter_finish; )
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
unique($iter->p_element()->begin(), $iter->p_element()->end(), $binary_op); # its a tree -- recurse
++$iter;
++$iter_prev;
}
elsif
(
(defined($binary_op) && $binary_op->function_operator($iter_prev->p_element(), $iter->p_element()))
|| (!defined($binary_op) && $iter_prev->p_element()->eq($iter->p_element()))
)
{
$iter = $iter->p_container()->erase($iter)
}
else
{
++$iter;
++$iter_prev;
}
}
return $iter_finish; # iterator
}
sub unique_copy # (iterator, iterator, iterator [, binary-predicate ] ) -- static function
{
int(@_) == 3 ? _usage_check('unique_copy(1)', 'III', @_) : _usage_check('unique_copy(2)', 'IIIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $binary_op = shift || undef;
my $iter_prev = $iter_start->clone();
$iter_result->p_container()->insert($iter_result, 1, $iter_prev->p_element());
for (my $iter = $iter_start->clone()+1; $iter != $iter_prev && $iter <= $iter_finish; ++$iter, ++$iter_prev)
{
if
(
(defined($binary_op) && !$binary_op->function_operator($iter_prev->p_element(), $iter->p_element()))
|| (!defined($binary_op) && !$iter_prev->p_element()->eq($iter->p_element()))
)
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
}
}
return $iter_result-1; # iterator
}
sub adjacent_find # (iterator, iterator [, binary-predicate ] ) -- static function
{
int(@_) == 2 ? _usage_check('adjacent_find(1)', 'II', @_) : _usage_check('adjacent_find(2)', 'IIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $binary_op = shift || undef;
my $iter_next = $iter_start->clone()+1;
for (my $iter = $iter_start->clone(); $iter_next <= $iter_finish; ++$iter, ++$iter_next)
{
return $iter
if
(
(defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter_next->p_element()))
|| (!defined($binary_op) && $iter_next->p_element()->eq($iter->p_element()))
);
}
return $iter_finish; # iterator
}
sub partition # (iterator, iterator, unary-predicate) -- static function
{
stable_partition(@_);
}
sub stable_partition # (iterator, iterator, unary-predicate) -- static function
{
_usage_check('stable_partition', 'IIU', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift;
my $position = $iter_start->clone();
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if ($function->function_operator($iter->p_element()))
{
$iter->p_container()->insert($position, 1, $iter->p_element());
$iter->p_container()->erase($iter+1);
}
}
return;
}
sub min_element # (iterator, iterator, [, binary-function] ) -- static function
{
int(@_) == 3 ? _usage_check('min_element(1)', 'IIB', @_) : _usage_check('min_element(2)', 'II', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $binary_op = shift || undef;
my $iter_min = $iter_start;
for (my $iter=$iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$iter_min = $iter
if
(
(defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter_min->p_element()))
|| (!defined($binary_op) && $iter->p_element()->lt($iter_min->p_element()))
);
}
return $iter_min;
}
sub max_element # (iterator, iterator, [, binary-function] ) -- static function
{
int(@_) == 3 ? _usage_check('max_element(1)', 'IIB', @_) : _usage_check('max_element(2)', 'II', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $binary_op = shift || undef;
my $iter_min = $iter_start;
for (my $iter=$iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$iter_min = $iter
if
(
(defined($binary_op) && !$binary_op->function_operator($iter->p_element(), $iter_min->p_element()))
|| (!defined($binary_op) && !$iter->p_element()->lt($iter_min->p_element()))
);
}
return $iter_min;
}
sub equal # (iterator, iterator, iterator [, binary-function] ) -- static function
{
int(@_) == 3 ? _usage_check('equal(1)', 'III', @_) : _usage_check('equal(2)', 'IIIB', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_start2 = shift;
my $binary_op = shift || undef;
for
(
my $iter=$iter_start->clone(), my $iter2=$iter_start2->clone();
$iter <= $iter_finish;
++$iter, ++$iter2
)
{
return 0 if # bool false
(
$iter2->at_end()
|| (defined($binary_op) && $binary_op->function_operator($iter->p_element(), $iter2->p_element()) == 0)
|| (!defined($binary_op) && $iter->p_element()->eq($iter2->p_element()) == 0)
);
}
return 1; # bool true
}
sub rotate_copy # (iterator, iterator, iterator, iterator) -- static function
{
_usage_check('rotate_copy', 'IIII', @_);
my $iter_start = shift;
my $iter_mid = shift;
my $iter_finish = shift;
my $iter_result = shift;
copy($iter_mid, $iter_finish, $iter_result);
copy($iter_start, $iter_mid-1, $iter_result);
return;
}
sub rotate # (iterator, iterator, iterator) -- static function
{
_usage_check('rotate', 'III', @_);
my $iter_start = shift;
my $iter_mid = shift;
my $iter_finish = shift;
my $iter_end = $iter_finish; ++$iter_end;
for (my $iter = $iter_start->clone(); $iter < $iter_mid; ++$iter)
{
$iter->p_container()->insert($iter_end, 1, $iter->p_element());
}
$iter_start->p_container()->erase($iter_start, --$iter_mid);
return;
}
sub reverse # (iterator, iterator) -- static function
{
_usage_check('reverse', 'II', @_);
my $iter_start = shift;
my $iter_finish = shift;
for (my $i1=$iter_start->clone(), my $i2=$iter_finish->clone(); $i1 < $i2; ++$i1, --$i2)
{
$i1->p_element()->swap($i2->p_element());
}
return;
}
sub reverse_copy # (iterator, iterator, iterator) -- static function
{
_usage_check('reverse_copy', 'III', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
$iter_result--;
}
return;
}
sub for_each # (iterator, iterator, unary-function-object) -- static function
{
_usage_check('for_each', 'IIF', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift; # unary-function
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? for_each($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
: $function->function_operator($iter->p_element());
}
return;
}
sub generate # (iterator, iterator, generator-function-object) -- static function
{
_usage_check('generate', 'IIG', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift; # generator-function
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? generate($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
: $iter->p_element()->swap($function->function_operator());
}
return;
}
sub generate_n # (iterator, size, generator-function-object) -- static function
{
_usage_check('generate_n', 'ISG', @_);
my $iter_start = shift;
my $size = shift;
my $function = shift; # generator-function
my $iter = $iter_start->clone();
my $start_idx = $iter->arr_idx();
for (; $iter->arr_idx() - $start_idx < $size; ++$iter)
{
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? generate_n($iter->p_element()->begin(), $size, $function) # its a tree -- recurse
: $iter->p_element()->swap($function->function_operator());
}
return;
}
sub fill # (iterator, iterator, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $element = shift;
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('fill', 'IIE', $iter_start, $iter_finish, $element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? fill($iter->p_element()->begin(), $iter->p_element()->end(), $element) # its a tree -- recurse
: $iter->p_element()->swap($element->clone());
}
return;
}
sub fill_n # (iterator, size, element-ref) -- static function
{
my $iter_start = shift;
my $size = shift;
my $element = shift;
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('fill_n', 'ISE', $iter_start, $size, $element);
my $iter = $iter_start->clone();
my $start_idx = $iter->arr_idx();
for (; $iter->arr_idx() - $start_idx < $size; ++$iter)
{
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? fill_n($iter->p_element()->begin(), $size, $element) # its a tree -- recurse
: $iter->p_element()->swap($element->clone());
}
return;
}
sub find_if # (iterator, iterator, unary-function-object) -- static function
{
_usage_check('find_if', 'IIF', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift; # unary-function
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{ # its a tree -- recurse
if (my $i = find_if($iter->p_element()->begin(), $iter->p_element()->end(), $function))
{
return $i; # Need to check this !!
}
}
elsif ($function->function_operator($iter->p_element()))
{
return $iter->clone(); # iterator
}
}
return 0;
}
sub find # (iterator, iterator, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $element = shift; # element-ref
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('find', 'IIE', $iter_start, $iter_finish, $element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
if (my $i = find($iter->p_element()->begin(), $iter->p_element()->end(), $element)) # its a tree -- recurse
{
return $i;
}
}
elsif ($element->eq($iter->p_element()))
{
return $iter->clone();
}
}
return 0;
}
sub count_if # (iterator, iterator, unary-function-object) -- static function
{
_usage_check('count_if', 'IIF', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift; # unary-function
my $count=0;
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$count +=
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? count_if($iter->p_element()->begin(), $iter->p_element()->end(), $function) # its a tree -- recurse
: ($function->function_operator($iter->p_element()) ? 1 : 0);
}
return $count;
}
sub count # (iterator, iterator, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $element = shift;
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('count', 'IIE', $iter_start, $iter_finish, $element);
my $count=0;
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$count +=
ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree')
? count($iter->p_element()->begin(), $iter->p_element()->end(), $element) # its a tree -- recurse
: ($element->eq($iter->p_element()) ? 1 : 0);
}
return $count;
}
sub remove_if # (iterator, iterator, unary-function-object) -- static function
{
_usage_check('remove_if', 'IIF', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift; # unary-function or class-member-name
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
remove_if($iter->p_element()->begin(), $iter->p_element()->end(), $function); # its a tree -- recurse
++$iter;
next;
}
$function->function_operator($iter->p_element())
? $iter->p_container()->erase($iter)
: ++$iter;
}
return;
}
sub remove # (iterator, iterator, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $element = shift; # element-ref
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('remove', 'IIE', $iter_start, $iter_finish, $element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
remove($iter->p_element()->begin(), $iter->p_element()->end(), $element); # its a tree -- recurse
++$iter;
next;
}
$element->eq($iter->p_element())
? $iter->p_container()->erase($iter)
: ++$iter;
}
return;
}
sub remove_copy_if # (iterator, iterator, iterator, unary-function-object) -- static function
{
_usage_check('remove_copy_if', 'IIIF', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $function = shift; # unary-function or class-member-name
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
remove_copy_if($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $function); # its a tree -- recurse
}
elsif (!$function->function_operator($iter->p_element()))
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
}
}
return;
}
sub remove_copy # (iterator, iterator, iterator, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $element = shift; # element-ref
$element = $iter_start->p_container()->factory(data => $element)
unless (ref($element) && $element->isa('Class::STL::Element'));
_usage_check('remove_copy', 'IIIE', $iter_start, $iter_finish, $iter_result, $element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
remove_copy($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $element); # its a tree -- recurse
}
elsif (!$element->eq($iter->p_element()))
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
}
}
return;
}
sub copy # (iterator, iterator, iterator) -- static function
{
_usage_check('copy', 'III', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
}
return;
}
sub copy_backward # (iterator, iterator, iterator) -- static function
{
_usage_check('copy_backward', 'III', @_);
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
for (my $iter = $iter_finish->clone(); $iter >= $iter_start; --$iter)
{
$iter_result->p_container()->insert($iter_result, 1, $iter->p_element());
}
return;
}
sub replace_if # (iterator, iterator, unary-function, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $function = shift;
my $new_element = shift; # element-ref
$new_element = $iter_start->p_container()->factory(data => $new_element)
unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
_usage_check('replace_if', 'IIFE', $iter_start, $iter_finish, $function, $new_element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
replace_if($iter->p_element()->begin(), $iter->p_element()->end(), $function, $new_element); # its a tree -- recurse
}
elsif ($function->function_operator($iter->p_element()))
{
$iter->p_container()->erase($iter);
$iter->p_container()->insert($iter, 1, $new_element);
}
else
{
++$iter;
}
}
return;
}
sub replace # (iterator, iterator, element-ref, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $old_element = shift; # element-ref
my $new_element = shift; # element-ref
$old_element = $iter_start->p_container()->factory(data => $old_element)
unless (ref($old_element) && $old_element->isa('Class::STL::Element'));
$new_element = $iter_start->p_container()->factory(data => $new_element)
unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
_usage_check('replace', 'IIEE', $iter_start, $iter_finish, $old_element, $new_element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; )
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
replace($iter->p_element()->begin(), $iter->p_element()->end(), $old_element, $new_element); # its a tree -- recurse
}
elsif ($iter->p_element()->eq($old_element))
{
$iter->p_container()->erase($iter);
$iter->p_container()->insert($iter, 1, $new_element);
}
else
{
++$iter;
}
}
return;
}
sub replace_copy_if # (iterator, iterator, iterator, unary-function, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $function = shift;
my $new_element = shift; # element-ref
$new_element = $iter_start->p_container()->factory(data => $new_element)
unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
_usage_check('replace_copy_if', 'IIIFE', $iter_start, $iter_finish, $iter_result, $function, $new_element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
#? Insert tree here???
replace_copy_if($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $function, $new_element); # its a tree -- recurse
}
else
{
$iter_result->p_container()->insert($iter_result, 1,
($function->function_operator($iter->p_element()) ? $new_element : $iter->p_element()));
}
}
return;
}
sub replace_copy # (iterator, iterator, iterator, element-ref, element-ref) -- static function
{
my $iter_start = shift;
my $iter_finish = shift;
my $iter_result = shift;
my $old_element = shift; # element-ref
my $new_element = shift; # element-ref
$old_element = $iter_start->p_container()->factory(data => $old_element)
unless (ref($old_element) && $old_element->isa('Class::STL::Element'));
$new_element = $iter_start->p_container()->factory(data => $new_element)
unless (ref($new_element) && $new_element->isa('Class::STL::Element'));
_usage_check('replace_copy', 'IIIEE', $iter_start, $iter_finish, $iter_result, $old_element, $new_element);
for (my $iter = $iter_start->clone(); $iter <= $iter_finish; ++$iter)
{
if (ref($iter->p_element()) && $iter->p_element()->isa('Class::STL::Containers::Tree'))
{
replace_copy($iter->p_element()->begin(), $iter->p_element()->end(), $iter_result, $old_element, $new_element); # its a tree -- recurse
}
else
{
$iter_result->p_container()->insert($iter_result, 1,
($iter->p_element()->eq($old_element) ? $new_element : $iter->p_element()));
}
}
return;
}
#TODO:sub sort
#TODO:{
#TODO:}
#TODO:sub random_shuffle # ( [ random_number_generator ] )
#TODO:{
#TODO:}
#TODO:sub lower_bound
#TODO:{
#TODO:}
#TODO:sub upper_bound
#TODO:{
#TODO:}
sub _usage_check
{
use Carp qw(confess);
my $function_name = shift;
my @format = split(//, shift);
my $check=0;
foreach my $arg (0..$#_) {
confess "Undefined arg $arg"
if ($format[$arg] ne 'S' && !ref($_[$arg]));
++$check
if
(
defined($_[$arg])
&&
(
($format[$arg] eq 'I' && $_[$arg]->isa('Class::STL::Iterators::Abstract'))
|| ($format[$arg] eq 'F' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject'))
|| ($format[$arg] eq 'B' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::BinaryFunction'))
|| ($format[$arg] eq 'U' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::UnaryFunction'))
|| ($format[$arg] eq 'G' && $_[$arg]->isa('Class::STL::Utilities::FunctionObject::Generator'))
|| ($format[$arg] eq 'E' && $_[$arg]->isa('Class::STL::Element'))
|| ($format[$arg] eq 'S' && !ref($_[$arg])) # Scalar
)
)
}
if ($check != int(@_)) {
use Carp qw(confess);
my @anames;
foreach (@format) {
push(@anames, 'scalar') if (/S/);
push(@anames, 'iterator') if (/I/);
push(@anames, 'function-object') if (/F/);
push(@anames, 'unary-function-object') if (/U/);
push(@anames, 'generator-function-object') if (/G/);
push(@anames, 'binary-function-object') if (/B/);
push(@anames, 'element-ref') if (/E/);
}
confess "@{[ __PACKAGE__]}::$function_name usage:\n$function_name( @{[ join(', ', @anames) ]});\n"
}
return 1;
}
}
# ----------------------------------------------------------------------------------------------------
1;
syntax highlighted by Code2HTML, v. 0.9.1