File Coverage

blib/lib/Math/Symbolic/Custom/DumpToFastEval.pm

Criterion	Covered	Total	%
statement	66	72	91.6
branch	11	18	61.1
condition	3	8	37.5
subroutine	12	12	100.0
pod	0	1	0.0
total	92	111	82.8

=head1 NAME

Math::Symbolic::Custom::DumpToFastEval - Compile Math::Symbolic trees fast RPN form

=head1 SYNOPSIS

  use Math::Symbolic::Custom::DumpToFastEval;

=head1 DESCRIPTION

FIXME documentation!

=head2 EXPORT

None by default, but you may choose to import the compile(), compile_to_sub(),
and compile_to_code() subroutines to your namespace using the standart
Exporter semantics including the ':all' tag.

=head1 SUBROUTINES

=cut

package Math::Symbolic::Custom::DumpToFastEval;
use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

use Math::SymbolicX::FastEvaluator;
use Math::Symbolic::Custom::Base;
BEGIN {*import = \&Math::Symbolic::Custom::Base::aggregate_import}

our $Aggregate_Export = [qw/to_fasteval/];

use Math::Symbolic::ExportConstants qw/:all/;

sub to_fasteval {
    my $tree = shift;
    $tree = shift if not ref $tree and $tree eq __PACKAGE__;

    my $order = shift || [];
    my %order;
    if (ref($order) eq 'HASH') {
        %order = %$order;
    }
    elsif (ref($order) eq 'ARRAY') {
        my $count = 0;
        %order = map { ( $_, $count++ ) } @$order;
    }

    no warnings 'recursion';

    my $vars = [ $tree->explicit_signature() ];

    my %vars;
    my @not_placed;
    foreach (@$vars) {
        my $pos = $order{$_};
        if ( defined $pos ) {
            $vars{$_} = $pos;
        }
        else {
            push @not_placed, $_;
        }
    }

    my $count = 0;
    foreach ( sort @not_placed ) {
        $vars{$_} = @$vars - @not_placed + $count++;
    }

    # The user is to do that himself. Left in to show that it would be
    # a sensible (if slow) thing to do.
    # $tree = $tree->simplify();
    # $tree = $tree->apply_derivatives();
    # $tree = $tree->simplify();

    my @trees;

    my $expr = Math::SymbolicX::FastEvaluator::Expression->new();
    my $success = _rec_ms_to_expr( $expr, $tree, \%vars );
    return() if not $success;

    $expr->SetNVars(scalar keys %vars);

    return($expr);
}


{
  no warnings 'recursion';
  sub _rec_ms_to_expr {
    my $expr = shift;
    my $tree  = shift;
    my $vars  = shift;

    my $op = Math::SymbolicX::FastEvaluator::Op->new();

    eval {
      $tree->descend(
        in_place => 1,
        after => sub {
          my $t = shift;
          my $ttype = $t->term_type;
          if ($ttype == T_VARIABLE) {
            $op->SetVariable();
            $op->SetValue($vars->{$t->name});
            #print $t->name, " ";
          }
          elsif ($ttype == T_CONSTANT) {
            $op->SetNumber();
            $op->SetValue($t->value);
            #print $t->value, " ";
          }
          else {
            my $type = $t->type;
            if ($type == U_P_DERIVATIVE || $type == U_T_DERIVATIVE) {
              die "Can't convert dertivatives to RPN for the FastEvaluator!";
            }
            $op->SetOpType($type);
            #print $Math::Symbolic::Operator::Op_Types[$type]{prefix_string}, " ";
          }
          $expr->AddOp($op);
        },
      );
    };
    if ($@) {
      warn "Caught exception while converting Math::Symbolic tree to RPN: $@";
      return();
    }
    return 1;
  }
}

1;
__END__