view release on metacpan or  search on metacpan

lib/Math/Symbolic/Custom/Transformation/Group.pm  view on Meta::CPAN

=item new

This is the constructor for C<Math::Symbolic::Custom::Transformation::Group>
objects.
First argument must be the type of the group as explained above. (C<','>,
C<'&'>, or C<'|'>.) Following the group type may be any number
of transformations (or groups thereof).

=cut

our %EXPORT_TAGS = ( 'all' => [ qw(
	new_trafo_group
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

my %Conjunctions = (
    '&' => 1,
    '|' => 1,
    ',' => 1,
);

sub new {
	my $proto = shift;
	my $class = ref($proto)||$proto;

    my $conjunction = shift;
    $conjunction = ',' if not defined $conjunction;

    unless ($Conjunctions{$conjunction}) {
        croak("Invalid conjunction type '$conjunction'.");
    }

    my @trafos;
    while (@_) {
        my $this = shift @_;
        if (
            ref($this)
            and $this->isa('Math::Symbolic::Custom::Transformation')
           )
        {
            push @trafos, $this;
        }
        else {
            my $pattern = shift @_;
            my $trafo = Math::Symbolic::Custom::Transformation->new(
                $this, $pattern
            );
            push @trafos, $trafo;
        }
    }

	my $self = {
		transformations => \@trafos,
        conjunction => $conjunction,
	};

	bless $self => $class;

    return $self;
}


=item apply

Applies the transformation (group) to a
C<Math::Symbolic> tree. First argument must be
a C<Math::Symbolic> tree to transform. The tree is not transformed in-place,
but its matched subtrees are contained in the transformed tree, so if you plan
to use the original tree as well as the transformed tree, take
care to clone one of the trees.

C<apply()> returns the transformed tree if the transformation pattern matched
and a false value otherwise.

On errors, it throws a fatal error.

=cut

sub apply {
	my $self = shift;
	my $tree = shift;

    if (not ref($tree) =~ /^Math::Symbolic/) {
		croak("First argument to apply() must be a Math::Symbolic tree.");
	}

    my $new;
    my $trafos = $self->{transformations};
    my $conj = $self->{conjunction};

    # apply sequentially regardless of outcome
    if ($conj eq ',') {
        foreach my $trafo (@$trafos) {
            my $res = $trafo->apply($tree);
            $new = $tree = $res if defined $res;
        }
    }
    # apply as long as the previous applied
    elsif ($conj eq '&') {
        foreach my $trafo (@$trafos) {
            my $res = $trafo->apply($tree);
            $new = $tree = $res if defined $res;
            last unless defined $res;
        }
    }
    # apply until the first is applied
    elsif ($conj eq '|') {
        foreach my $trafo (@$trafos) {
            my $res = $trafo->apply($tree);
            if(defined $res) {
                $new = $tree = $res;
                last;
            }
        }
    }
    else {
        warn "Invalid conjunction '$conj'";