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