view release on metacpan or  search on metacpan

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

This is a list of public methods.

=over 2

=cut


=item new

C<new()> is the constructor for Math::Symbolic::Custom::Pattern objects.
It takes a Math::Symbolic tree as first argument which will be transformed
into a pattern. See the C<match()> method documentation.

After the Math::Symbolic tree, a list of key/value pairs can be passed in
as options for the pattern construction.

The only currently supported option is C<commutation> indicating whether or
not the pattern should match sums and products commutatively. Please note
that this does not match recursively and does not recognize associativity:
The commutative pattern of C<(a + b) + c> matches the
expression C<(b + a) + c> and C<c + (b + a)>, but B<not> C<a + (b + c)>!
This means that if the tree to match is built from a string such as
C<a + b + c>, then it is not defined whether C<(a + b) + c> matches
that expression. It does so if the internal tree representation
happens to be C<(a + b) + c> and it doesn't if it happens to be
C<a + (b + c)>. This may be fixed at a later point.

=cut

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

  # I want to call that 'proto', too ;)
  $proto = shift;
  confess(
    __PACKAGE__."new() requires a Math::Symbolic tree as first "
    ."argument."
  ) if not ref($proto) =~ /^Math::Symbolic/;

  my %opt = @_;

  my $info = {
    vars        => {},
    constants   => {},
    trees       => {},
    commutation => $opt{commutation},
  };
  
  my $pattern = _descend_build($proto, $info);

  #_descend_generalize($pattern, $info);

  my $self = {
    pattern => $pattern,
    info    => $info,
    string  => $proto->to_string(),
  };

  return bless $self => $class;
}


sub _descend_build {
  my ($proto, $info) = @_;
  
  my $tree = [];
  my $tt   = $proto->term_type();

  if ($tt == T_CONSTANT) {
    $tree->[TYPE] = T_CONSTANT;
    $tree->[VAL]  = $proto->value();
  }
  elsif ($tt == T_OPERATOR) {
    $tree->[TYPE] = T_OPERATOR;
    $tree->[VAL]  = $proto->type();
    $tree->[OPS]  = [
      map { _descend_build($_, $info) }
      @{$proto->{operands}}
    ];
    $tree->[ATTR] = 0;
    $tree->[ATTR] |= ATTR_COMMUTATIVE
      if $info->{commutation} and $Math::Symbolic::Operator::Op_Types[$tree->[VAL]]{commutative};
    # todo: ATTR_CONSTANT?
  }
  else { # variable
    my $name = $proto->name();

    $tree->[TYPE] = PATTERN;
    if ($name eq 'TREE') {
      $tree->[VAL] = ANY_TREE;
    }
    elsif ($name eq 'CONST') {
      $tree->[VAL] = ANY_CONST;
    }
    elsif ($name eq 'VAR') {
      $tree->[VAL] = ANY_VAR;
    }
    elsif ($name =~ /^TREE_(\w+)$/) {
      $tree->[VAL] = NAMED_TREE;
      my @names = split /_/, $1;
      $tree->[OPS] = \@names;
      $info->{trees}{$_}++ for @names;
    }
    elsif ($name =~ /^CONST_(\w+)$/) {
      $tree->[VAL] = NAMED_CONST;
      my @names = split /_/, $1;
      $tree->[OPS] = \@names;
      $info->{constants}{$_}++ for @names;
    }
    elsif ($name =~ /^VAR_(\w+)$/) {
      $tree->[VAL] = NAMED_VAR;
      my @names = split /_/, $1;
      $tree->[OPS] = \@names;
      $info->{vars}{$_}++ for @names;
    }
    else {
      $tree->[TYPE] = T_VARIABLE;
      $tree->[VAL] = $name;
    }