1package Math::Symbolic::Custom::Transformation::Group;
2
3use 5.006;
4use strict;
5use warnings;
6
7use Carp qw/croak/;
8use Math::Symbolic qw/:all/;
9use Math::Symbolic::Custom::Pattern;
10use base 'Math::Symbolic::Custom::Transformation', 'Exporter';
11
12our $VERSION = '2.02';
13
14=encoding utf8
15
16=head1 NAME
17
18Math::Symbolic::Custom::Transformation::Group - Group of Transformations
19
20=head1 SYNOPSIS
21
22  use Math::Symbolic::Custom::Transformation qw/:all/;
23  use Math::Symbolic qw/parse_from_string/;
24
25  my $group = new_trafo_group(
26    ',',
27    new_trafo( 'TREE_x ^ 1'       => 'TREE_x'                           ),
28    new_trafo( 'TREE_x ^ CONST_a' => 'TREE_x * TREE_x^value{CONST_a-1}' ),
29  );
30
31  my $function = parse_from_string(
32    '(foo+1)^3 + bar^2'
33  );
34
35  while(1) {
36      my $result = $group->apply_recursive($function);
37      last if not defined $result;
38      $function = $result;
39  }
40
41  print $function."\n"
42  # prints "((foo + 1) * ((foo + 1) * (foo + 1))) + (bar * bar)"
43
44=head1 DESCRIPTION
45
46A C<Math::Symbolic::Custom::Transformation::Group> object (Trafo Group for now)
47represents a conjunction of several transformations and is a transformation
48itself. An example is in order here:
49
50  my $group = new_trafo_group( ',', $trafo1, $trafo2, ... );
51
52Now, C<$group> can be applied to L<Math::Symbolic> trees as if it was
53an ordinary transformation object itself. In fact it is, because this is
54a subclass of L<Math::Symbolic::Custom::Transformation>.
55
56The first argument to the constructor specifies the condition under which the
57grouped transformations are applied. C<','> is the simplest form. It means
58that all grouped transformations are always applied. C<'&'> means that
59the next transformation will only be applied if the previous one succeeded.
60Finally, C<'|'> means that the first transformation to succeed is the last
61that is tried. C<'&'> and C<'|'> are C<and> and C<or> operators if you will.
62
63=head2 EXPORT
64
65None by default, but you may choose to import the C<new_trafo_group>
66subroutine as an alternative constructor for
67C<Math::Symbolic::Custom::Transformation::Group> objects.
68
69=cut
70
71=head2 METHODS
72
73This is a list of public methods.
74
75=over 2
76
77=cut
78
79=item new
80
81This is the constructor for C<Math::Symbolic::Custom::Transformation::Group>
82objects.
83First argument must be the type of the group as explained above. (C<','>,
84C<'&'>, or C<'|'>.) Following the group type may be any number
85of transformations (or groups thereof).
86
87=cut
88
89our %EXPORT_TAGS = ( 'all' => [ qw(
90	new_trafo_group
91) ] );
92
93our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
94
95our @EXPORT = qw();
96
97my %Conjunctions = (
98    '&' => 1,
99    '|' => 1,
100    ',' => 1,
101);
102
103sub new {
104	my $proto = shift;
105	my $class = ref($proto)||$proto;
106
107    my $conjunction = shift;
108    $conjunction = ',' if not defined $conjunction;
109
110    unless ($Conjunctions{$conjunction}) {
111        croak("Invalid conjunction type '$conjunction'.");
112    }
113
114    my @trafos;
115    while (@_) {
116        my $this = shift @_;
117        if (
118            ref($this)
119            and $this->isa('Math::Symbolic::Custom::Transformation')
120           )
121        {
122            push @trafos, $this;
123        }
124        else {
125            my $pattern = shift @_;
126            my $trafo = Math::Symbolic::Custom::Transformation->new(
127                $this, $pattern
128            );
129            push @trafos, $trafo;
130        }
131    }
132
133	my $self = {
134		transformations => \@trafos,
135        conjunction => $conjunction,
136	};
137
138	bless $self => $class;
139
140    return $self;
141}
142
143
144=item apply
145
146Applies the transformation (group) to a
147C<Math::Symbolic> tree. First argument must be
148a C<Math::Symbolic> tree to transform. The tree is not transformed in-place,
149but its matched subtrees are contained in the transformed tree, so if you plan
150to use the original tree as well as the transformed tree, take
151care to clone one of the trees.
152
153C<apply()> returns the transformed tree if the transformation pattern matched
154and a false value otherwise.
155
156On errors, it throws a fatal error.
157
158=cut
159
160sub apply {
161	my $self = shift;
162	my $tree = shift;
163
164    if (not ref($tree) =~ /^Math::Symbolic/) {
165		croak("First argument to apply() must be a Math::Symbolic tree.");
166	}
167
168    my $new;
169    my $trafos = $self->{transformations};
170    my $conj = $self->{conjunction};
171
172    # apply sequentially regardless of outcome
173    if ($conj eq ',') {
174        foreach my $trafo (@$trafos) {
175            my $res = $trafo->apply($tree);
176            $new = $tree = $res if defined $res;
177        }
178    }
179    # apply as long as the previous applied
180    elsif ($conj eq '&') {
181        foreach my $trafo (@$trafos) {
182            my $res = $trafo->apply($tree);
183            $new = $tree = $res if defined $res;
184            last unless defined $res;
185        }
186    }
187    # apply until the first is applied
188    elsif ($conj eq '|') {
189        foreach my $trafo (@$trafos) {
190            my $res = $trafo->apply($tree);
191            if(defined $res) {
192                $new = $tree = $res;
193                last;
194            }
195        }
196    }
197    else {
198        warn "Invalid conjunction '$conj'";
199    }
200
201	return $new;
202}
203
204
205=item to_string
206
207Returns a string representation of the transformation.
208In presence of the C<simplify> or C<value> hooks, this may
209fail to return the correct represenation. It does not round-trip!
210
211(Generally, it should work if only one hook is present, but fails if
212more than one hook is found.)
213
214=cut
215
216sub to_string {
217    my $self = shift;
218
219    my $str = '[ ' . join(
220        ' '.$self->{conjunction}.' ',
221        map {
222            $_->to_string()
223        } @{$self->{transformations}}
224    ) . ' ]';
225    return $str;
226}
227
228=item apply_recursive
229
230This method is inherited from L<Math::Symbolic::Custom::Transformation>.
231
232=back
233
234=head2 SUBROUTINES
235
236This is a list of public subroutines.
237
238=over 2
239
240=cut
241
242=item new_trafo_group
243
244This subroutine is an alternative to the C<new()> constructor for
245Math::Symbolic::Custom::Transformation::Group objects that uses a hard coded
246package name. (So if you want to subclass this module, you should be aware
247of that!)
248
249=cut
250
251sub new_trafo_group {
252	unshift @_, __PACKAGE__;
253	goto &new;
254}
255
2561;
257__END__
258
259=back
260
261=head1 SEE ALSO
262
263New versions of this module can be found on http://steffen-mueller.net or CPAN.
264
265This module uses the L<Math::Symbolic> framework for symbolic computations.
266
267L<Math::Symbolic::Custom::Pattern> implements the pattern matching routines.
268
269=head1 AUTHOR
270
271Steffen Müller, E<lt>symbolic-module at steffen-mueller dot netE<gt>
272
273=head1 COPYRIGHT AND LICENSE
274
275Copyright (C) 2006, 2007, 2008, 2013 by Steffen Mueller
276
277This library is free software; you can redistribute it and/or modify
278it under the same terms as Perl itself, either Perl version 5.6.1 or,
279at your option, any later version of Perl 5 you may have available.
280
281=cut
282