view release on metacpan or  search on metacpan

lib/Array/APX.pm  view on Meta::CPAN

    my ($left, $right) = @_;

    if ((ref($left) eq __PACKAGE__ and ref($right) eq __PACKAGE__) or
        (ref($left) eq __PACKAGE__ and defined($right) and !ref($right))
       ) # Binary or
    {
        my ($self, $other) = @_;
        my $result = ref($right) ? [@$right] : [$right];
        Array::DeepUtils::binary([@$left], $result, sub { $_[0] | $_[1] }, 1);
        return bless $result;
    }
    # If the right side argument is a reference to a subroutine we are at
    # the initial stage of a |...|-operator and have to rememeber the 
    # function to be used as well as the left hand operator:
    elsif (ref($left) eq __PACKAGE__ and ref($right) eq 'CODE')
    {
        my %outer;
        $outer{left}     = $left;  # APX object
        $outer{operator} = $right; # Reference to a subroutine
        push @_outer_stack, \%outer;
        return;
    }
    elsif (ref($left) eq __PACKAGE__ and !defined($right))
    {   # Second phase of applying the |...|-operator:
        my $info = pop @_outer_stack;
        my ($a1, $a2) = ([@{$info->{left}}], [@{$left}]);
        my @result;

        for my $i ( 0 .. @$a1 - 1 )
        {
            for my $j ( 0 .. @$a2 - 1 )
            {
                my $value = $a2->[$j];
                _binary($a1->[$i], $value, $info->{operator});
                $result[$i][$j] = $value;
            }
        }

        return bless \@result;
    }

    croak 'outer: Strange parametertypes: >>', ref($left), 
          '<< and >>', ref($right), '<<';
}

=head2 The reduce operator /

The operator / acts as the reduce operator if applied to a reference to a 
subroutine as its left argument and an APX structure as its right element:

    use strict;
    use warnings;
    use Array::APX qw(:all);

    my $x = iota(100) + 1;
    my $f = sub { $_[0] + $_[1] };

   print $f/ $x, "\n";

calculates the sum of all integers between 1 and 100 (without using Gauss'
summation formula just by repeated addition). The combined operator

    $f/

applies the function referenced by $f between each two successive elements 
of the APX structure on the right hand side of the operator.

=cut

sub reduce
{
    my ($left, $right, $swap) = @_;

    if (ref($left) eq __PACKAGE__ and ref($right) ne 'CODE') # Binary division
    {
         my $result = ref($right) ? [@$right] : [$right];
         ($left, $result) = ($result, [@$left]) if $swap;
        _binary([@$left], $result, sub { $_[0] / $_[1] }, 1);
        return bless $result;
    }
    elsif (ref($_[0]) eq __PACKAGE__ and ref($_[1]) eq 'CODE') # reduce operator
    {
        my $result = shift @$left;
        for my $element (@$left)
        {
            eval { _binary($element, $result, $right); };
            croak "reduce: Error while applying reduce: $@\n" if $@;
        }

        return $result;
    }

    croak 'outer: Strange parametertypes: ', ref($_[0]), ' and ', ref($_[0]);
}

=head2 The scan operator x

The scan-operator works like the \-operator in APL - it applies a binary 
function to all successive elements of an array but accumulates the results
gathered along the way. The following example creates a vector of the 
partial sums of 0, 0 and 1, 0 and 1 and 2, 0 and 1 and 2 and 3 etc.:

    $f = sub { $_[0] + $_[1] };
    $x = $f x iota(10);
    print $x;

This code snippet yields the following result:

    [    0    1    3    6   10   15   21   28   36   45 ]

=cut

sub scan
{
    my ($argument, $function, $swap) = @_;

    croak "scan operator: Wrong sequence of function and argument!\n"
        unless $swap;

    croak "scan operator: No function reference found!\n"
        if ref($function) ne 'CODE';