Math-Symbolic-0.612000755001750001750 012157534055 13264 5ustar00tseetsee000000000000Math-Symbolic-0.612/Build.PL000444001750001750 77212157534055 14703 0ustar00tseetsee000000000000use Module::Build; my $b = Module::Build->new ( module_name => 'Math::Symbolic', dist_author => 'Steffen Mueller ', license => 'perl', requires => { Memoize => '1.01', 'Parse::RecDescent' => '0', 'Data::Dumper' => '0', }, build_requires => { 'Test::More' => 0, }, create_makefile_pl => 'traditional', # sign => 1, # conflicts => {}, # script_files => [], ); $b->create_build_script; Math-Symbolic-0.612/compile_yapp_parser.pl000555001750001750 171212157534055 20017 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; unless (@ARGV and $ARGV[0] =~ /^\s*--yes\s*/i) { print <<'HERE'; In order to recompile the Yapp.yp grammar, you need to install the Parse::Yapp module and then run this script with the --yes parameter *from this directory*. HERE exit(1); } opendir(DH, '.') or die $!; if (not grep {/^Yapp\.yp$/} readdir DH) { print "The program needs to be run from the Math::Symbolic\n" ."distribution root directory.\n"; exit(1); } close DH; system('yapp -s -n -m Math::Symbolic::Parser::Yapp -o lib/Math/Symbolic/Parser/Yapp.pm Yapp.yp'); open my $fh, '+<', 'lib/Math/Symbolic/Parser/Yapp.pm' or die $!; local $/ = undef; my $code = <$fh>; seek $fh, 0, 0; truncate $fh, 0; $code =~ s/(?' build_requires: Test::More: 0 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Math-Symbolic provides: Math::Symbolic: file: lib/Math/Symbolic.pm version: 0.612 Math::Symbolic::AuxFunctions: file: lib/Math/Symbolic/AuxFunctions.pm version: 0.612 Math::Symbolic::Base: file: lib/Math/Symbolic/Base.pm version: 0.612 Math::Symbolic::Compiler: file: lib/Math/Symbolic/Compiler.pm version: 0.612 Math::Symbolic::Constant: file: lib/Math/Symbolic/Constant.pm version: 0.612 Math::Symbolic::Custom: file: lib/Math/Symbolic/Custom.pm version: 0.612 Math::Symbolic::Custom::Base: file: lib/Math/Symbolic/Custom/Base.pm version: 0.612 Math::Symbolic::Custom::DefaultDumpers: file: lib/Math/Symbolic/Custom/DefaultDumpers.pm version: 0.612 Math::Symbolic::Custom::DefaultMods: file: lib/Math/Symbolic/Custom/DefaultMods.pm version: 0.612 Math::Symbolic::Custom::DefaultTests: file: lib/Math/Symbolic/Custom/DefaultTests.pm version: 0.612 Math::Symbolic::Derivative: file: lib/Math/Symbolic/Derivative.pm version: 0.612 Math::Symbolic::ExportConstants: file: lib/Math/Symbolic/ExportConstants.pm version: 0.612 Math::Symbolic::MiscAlgebra: file: lib/Math/Symbolic/MiscAlgebra.pm version: 0.612 Math::Symbolic::MiscCalculus: file: lib/Math/Symbolic/MiscCalculus.pm version: 0.612 Math::Symbolic::Operator: file: lib/Math/Symbolic/Operator.pm version: 0.612 Math::Symbolic::Parser: file: lib/Math/Symbolic/Parser.pm version: 0.612 Math::Symbolic::Parser::Precompiled: file: lib/Math/Symbolic/Parser/Precompiled.pm version: 0.612 Math::Symbolic::Parser::Yapp: file: lib/Math/Symbolic/Parser/Yapp.pm version: 0 Math::Symbolic::Parser::Yapp::Driver: file: lib/Math/Symbolic/Parser/Yapp.pm version: 1.05 Math::Symbolic::Variable: file: lib/Math/Symbolic/Variable.pm version: 0.612 Math::Symbolic::VectorCalculus: file: lib/Math/Symbolic/VectorCalculus.pm version: 0.612 Parse::RecDescent::Math::Symbolic::Parser::Precompiled: file: lib/Math/Symbolic/Parser/Precompiled.pm version: 0 requires: Data::Dumper: 0 Memoize: 1.01 Parse::RecDescent: 0 resources: license: http://dev.perl.org/licenses/ version: 0.612 Math-Symbolic-0.612/Yapp.yp000444001750001750 2557112157534055 14736 0ustar00tseetsee000000000000# Math::Symbolic::Parser::Yapp # # Based on Parse::Yapp's calculator example %left ',' %left '-' '+' %left '*' '/' %left NEG %right '^' %% exp: NUM { $_[1] } | FUNC '(' list ')' { if (exists($Math::Symbolic::Parser::Parser_Functions{$_[1]})) { $Math::Symbolic::Parser::Parser_Functions{$_[1]}->($_[1], @{$_[3]}) } else { Math::Symbolic::Operator->new($_[1], @{$_[3]}) } } | PRED '{' exp '}' { Math::Symbolic::Variable->new( 'TRANSFORMATION_HOOK', [$_[1], $_[3]] ); } | PRIVEFUNC { $_[1] =~ /^([^(]+)\((.*)\)$/ or die "invalid per-object parser extension function: '$_[1]'"; $_[0]->{__PRIV_EXT_FUNCTIONS}->{$1}->($2); } | EFUNC { $_[1] =~ /^([^(]+)\((.*)\)$/ or die "invalid global parser extension function: '$_[1]'"; $Math::SymbolicX::ParserExtensionFactory::Functions->{$1}->($2) } | VAR { $_[1] } | exp '+' exp { Math::Symbolic::Operator->new('+', $_[1], $_[3]) } | exp '-' exp { Math::Symbolic::Operator->new('-', $_[1], $_[3]) } | exp '*' exp { Math::Symbolic::Operator->new('*', $_[1], $_[3]) } | exp '/' exp { Math::Symbolic::Operator->new('/', $_[1], $_[3]) } | '-' exp %prec NEG { Math::Symbolic::Operator->new('neg', $_[2]) } | exp '^' exp { Math::Symbolic::Operator->new('^', $_[1], $_[3]) } | '(' exp ')' { $_[2] } ; list: exp ',' list { unshift @{$_[3]}, $_[1]; $_[3] } | exp { [$_[1]] } ; %% use strict; use warnings; use Math::Symbolic qw//; use constant DAT => 0; use constant OP => 1; sub _Error { exists $_[0]->YYData->{ERRMSG} and do { my $x = $_[0]->YYData->{ERRMSG}; delete $_[0]->YYData->{ERRMSG}; die $x; }; die "Syntax error in input string while parsing the following string: '".$_[0]->{USER}{INPUT}."'\n"; } my $Num = qr/[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee]([+-]?\d+))?/o; my $Ident = qr/[a-zA-Z][a-zA-Z0-9_]*/o; my $Op = qr/\+|\-|\*|\/|\^/o; my $Func = qr/log|partial_derivative|total_derivative|a?(?:sin|sinh|cos|cosh|tan|cot)|exp|sqrt/; my $Unary = qr/\+|\-/o; # taken from perlre my $balanced_parens_re; $balanced_parens_re = qr{\((?:(?>[^()]+)|(??{$balanced_parens_re}))*\)}; # This is a hack so we can hook into the new() method. { no warnings; no strict; *real_new = \&new; *new = sub { my $class = shift; my %args = @_; my $predicates = $args{predicates}; delete $args{predicates}; my $parser = real_new($class, %args); if ($predicates) { $parser->{__PREDICATES} = $predicates; } return $parser; }; } sub _Lexer { my($parser)=shift; my $ExtFunc = $Math::SymbolicX::ParserExtensionFactory::RegularExpression || qr/(?!)/; my $PrivExtFunc = $parser->{__PRIV_EXT_FUNC_REGEX}; my $data = $parser->{USER}; my $predicates = $parser->{__PREDICATES}; pos($data->{INPUT}) < length($data->{INPUT}) or return('',undef); # This is a huge hack if (defined $predicates) { for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($PrivExtFunc ? $data->{INPUT} =~ /\G($PrivExtFunc$balanced_parens_re)/cg : 0) { $data->{STATE} = OP; return('PRIVEFUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($predicates)(?=\{)/cg) { return('PRED', $1); } elsif ($data->{INPUT} =~ /\G($Ident)((?>\'*))(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; my $name = $1; my $ticks = $2; my $sig = $3; my $n; if (defined $ticks and ($n = length($ticks))) { my @sig = defined($sig) ? (split /,/, $sig) : ('x'); my $return = Math::Symbolic::Variable->new( {name=>$name, signature=>\@sig} ); my $var = $sig[0]; foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $var, ); } return('VAR', $return); } elsif (defined $sig) { return( 'VAR', Math::Symbolic::Variable->new({name=>$name, signature=>[split /,/, $sig]}) ); } else { return('VAR', Math::Symbolic::Variable->new($name)); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G\{/cgo) { return('{', '{'); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G\}/cgo) { return('}', '}'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end if defined $predicates else { # {{{ not defined $predicates for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($PrivExtFunc ? $data->{INPUT} =~ /\G($PrivExtFunc\s*$balanced_parens_re)/cg : 0) { $data->{STATE} = OP; return('PRIVEFUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc\s*$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($Ident)((?>\'*))(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; my $name = $1; my $ticks = $2; my $sig = $3; my $n; if (defined $ticks and ($n = length($ticks))) { my @sig = defined($sig) ? (split /,/, $sig) : ('x'); my $return = Math::Symbolic::Variable->new( {name=>$name, signature=>\@sig} ); my $var = $sig[0]; foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $var, ); } return('VAR', $return); } elsif (defined $sig) { return( 'VAR', Math::Symbolic::Variable->new({name=>$name, signature=>[split /,/, $sig]}) ); } else { return('VAR', Math::Symbolic::Variable->new($name)); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end else => not defined $predicates } sub parse { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error ); } sub parsedebug { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yydebug => 0x1F, yylex => \&_Lexer, yyerror => \&_Error ); } 1; Math-Symbolic-0.612/MANIFEST000444001750001750 304012157534055 14547 0ustar00tseetsee000000000000Build.PL Changes compile_yapp_parser.pl examples/run01.pl examples/run02.pl examples/run03.pl examples/run04.pl examples/run05.pl examples/run06.pl examples/run07.pl examples/run08.pl examples/run09.pl examples/run10.pl examples/run11.pl examples/run12.pl examples/run13.pl examples/run14.pl examples/run15.pl examples/run16.pl examples/run17.pl examples/run18.pl examples/run19.pl examples/run20.pl lib/Math/Symbolic.pm lib/Math/Symbolic/AuxFunctions.pm lib/Math/Symbolic/Base.pm lib/Math/Symbolic/Compiler.pm lib/Math/Symbolic/Constant.pm lib/Math/Symbolic/Custom.pm lib/Math/Symbolic/Custom/Base.pm lib/Math/Symbolic/Custom/DefaultDumpers.pm lib/Math/Symbolic/Custom/DefaultMods.pm lib/Math/Symbolic/Custom/DefaultTests.pm lib/Math/Symbolic/Derivative.pm lib/Math/Symbolic/ExportConstants.pm lib/Math/Symbolic/MiscAlgebra.pm lib/Math/Symbolic/MiscCalculus.pm lib/Math/Symbolic/Operator.pm lib/Math/Symbolic/Parser.pm lib/Math/Symbolic/Parser/Precompiled.pm lib/Math/Symbolic/Parser/Yapp.pm lib/Math/Symbolic/Variable.pm lib/Math/Symbolic/VectorCalculus.pm Makefile.PL MANIFEST This list of files META.yml README t/01basic.t t/02basic.t t/03exp.t t/04deep_derivatives.t t/05unary_minus.t t/06parser.t t/07simple_trig.t t/08parse_hyperbolic.t t/09hyperbolic.t t/10hyperbolic.t t/11trigonometric.t t/12overload.t t/13parse_more.t t/14compile.t t/15total_derivatives.t t/16tests.t t/17modifications.t t/18vectorcalc.t t/19misccalc.t t/20miscalgebra.t t/21more_derivatives.t t/22dumpers.t t/90regression.t TODO xt/00dist.t xt/00pod.t xt/00podcover.t Yapp.yp META.json Math-Symbolic-0.612/TODO000444001750001750 401412157534055 14110 0ustar00tseetsee000000000000This file contains the TODO milestones for Math::Symbolic. + => Met - => Not met Sooner-than-later: - Better testsuite as in: bring in some order and better coverage. - Clean up documentation. - Update TODO and clean it. - Make sure TODO and sourceforge task/issue/whatever trackers are in sync. - Write a coherent, easy-to-understand, central section on variable signatures and their purpose. - Should the operators/functions really be listed in the MS::Operator man page or should they be listed in a more central place like the main man page? Or both? (Duplicate docs are bad!) - Whatever's done about that last point, make sure the docs refer to the correct portion about the operator list. Random and unordered thoughts and ideas: - Differentials - Vector operations - Vector analysis - Equations - Symbolic calculator - Some idea of types/contexts? - n-ary operators - Equation solver - Canonical form - Improved term simplification! MUCH IMPROVED! - Integration (*laugh*) - Matrices Version 0.120: (erm, we're past 0.120, sadly.) - Major change to MS::Operator guts: - Separate ordinary operands such as the ones found with arithmetic operators and the special operands such as the deriving variable with derivatives. Ordinary operands are to stay in the {operands} hash entry. Special operands are to be put into a new {special} hash entry. {special} is an array ref containing the special operands. These are hashes themselves. They contain certain keys: - type: The type of operand. May be "variable", "tree", "constant", etc. ("identifier" even). - value: The "payload". - All code must be adapted to be aware of this change. - This fixes the trouble one may have when "implementing" a variable used for deriving, etc. - Makes summation possible as a new operator. The function would be the only ordinary operand. Lower, upper, and index variable would all be special. - Documentation for the changes. - Tests for the changes. Math-Symbolic-0.612/META.json000444001750001750 747612157534055 15060 0ustar00tseetsee000000000000{ "abstract" : "Symbolic calculations", "author" : [ "Steffen Mueller " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-Symbolic", "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Data::Dumper" : "0", "Memoize" : "1.01", "Parse::RecDescent" : "0" } } }, "provides" : { "Math::Symbolic" : { "file" : "lib/Math/Symbolic.pm", "version" : "0.612" }, "Math::Symbolic::AuxFunctions" : { "file" : "lib/Math/Symbolic/AuxFunctions.pm", "version" : "0.612" }, "Math::Symbolic::Base" : { "file" : "lib/Math/Symbolic/Base.pm", "version" : "0.612" }, "Math::Symbolic::Compiler" : { "file" : "lib/Math/Symbolic/Compiler.pm", "version" : "0.612" }, "Math::Symbolic::Constant" : { "file" : "lib/Math/Symbolic/Constant.pm", "version" : "0.612" }, "Math::Symbolic::Custom" : { "file" : "lib/Math/Symbolic/Custom.pm", "version" : "0.612" }, "Math::Symbolic::Custom::Base" : { "file" : "lib/Math/Symbolic/Custom/Base.pm", "version" : "0.612" }, "Math::Symbolic::Custom::DefaultDumpers" : { "file" : "lib/Math/Symbolic/Custom/DefaultDumpers.pm", "version" : "0.612" }, "Math::Symbolic::Custom::DefaultMods" : { "file" : "lib/Math/Symbolic/Custom/DefaultMods.pm", "version" : "0.612" }, "Math::Symbolic::Custom::DefaultTests" : { "file" : "lib/Math/Symbolic/Custom/DefaultTests.pm", "version" : "0.612" }, "Math::Symbolic::Derivative" : { "file" : "lib/Math/Symbolic/Derivative.pm", "version" : "0.612" }, "Math::Symbolic::ExportConstants" : { "file" : "lib/Math/Symbolic/ExportConstants.pm", "version" : "0.612" }, "Math::Symbolic::MiscAlgebra" : { "file" : "lib/Math/Symbolic/MiscAlgebra.pm", "version" : "0.612" }, "Math::Symbolic::MiscCalculus" : { "file" : "lib/Math/Symbolic/MiscCalculus.pm", "version" : "0.612" }, "Math::Symbolic::Operator" : { "file" : "lib/Math/Symbolic/Operator.pm", "version" : "0.612" }, "Math::Symbolic::Parser" : { "file" : "lib/Math/Symbolic/Parser.pm", "version" : "0.612" }, "Math::Symbolic::Parser::Precompiled" : { "file" : "lib/Math/Symbolic/Parser/Precompiled.pm", "version" : "0.612" }, "Math::Symbolic::Parser::Yapp" : { "file" : "lib/Math/Symbolic/Parser/Yapp.pm", "version" : 0 }, "Math::Symbolic::Parser::Yapp::Driver" : { "file" : "lib/Math/Symbolic/Parser/Yapp.pm", "version" : "1.05" }, "Math::Symbolic::Variable" : { "file" : "lib/Math/Symbolic/Variable.pm", "version" : "0.612" }, "Math::Symbolic::VectorCalculus" : { "file" : "lib/Math/Symbolic/VectorCalculus.pm", "version" : "0.612" }, "Parse::RecDescent::Math::Symbolic::Parser::Precompiled" : { "file" : "lib/Math/Symbolic/Parser/Precompiled.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.612" } Math-Symbolic-0.612/Makefile.PL000444001750001750 72412157534055 15356 0ustar00tseetsee000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4003 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Math::Symbolic', 'VERSION_FROM' => 'lib/Math/Symbolic.pm', 'PREREQ_PM' => { 'Data::Dumper' => '0', 'Memoize' => '1.01', 'Parse::RecDescent' => '0', 'Test::More' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Math-Symbolic-0.612/Changes000444001750001750 5556312157534055 14752 0ustar00tseetsee000000000000Revision history for Perl extension Math::Symbolic. 0.612 Mon Jun 17 08:10 2013 - Attempt to fix versioning issues, take two. 0.611 Wed Jun 05 08:10 2013 - Attempt to fix versioning issues. 0.610 Wed Jun 05 07:10 2013 - More POD/encoding fixes (Gregor Herrmann). - POD spelling fixes (Jonathan Yu). 0.609 Wed May 14 07:20 2013 - Move POD tests to xt/ - POD/encoding fixes. 0.608 Tue May 14 19:00 2013 - Move POD tests to xt/ 0.607 Mon Sep 19 09:03 2011 - Documentation change: Add warning about confusing ^ and ** for overloaded operations. 0.606 Fri Dec 31 19:30 2010 - Distribution fix 0.605 Fri Dec 31 18:30 2010 - Fix negation bug in simplification (RT #64269) 0.604 Fri Jun 11 18:30 2010 - Fix regression in the quotient rule of derivatives (#58319) - Fix problem with the atan2 derivative. 0.603 Wed Mar 4 18:21 2009 - Fix regression in the Yapp-parser parser extension mechanism. 0.602 Tue Mar 3 17:05 2009 - Fix RT #43783: Bug in the term simplification of constants in derivatives of differences. (Reported by Alexander Platt) 0.601 Thu Feb 5 21:50 2009 - Support for object-private parser extensions via Math::SymbolicX::ParserExtensionFactory. 0.510 Sun Jan 27 20:05 2008 - Implement commutativity information in @Math::Symbolic::Operator::Op_Types (used by Math::Symbolic::Custom::Pattern 2.00 and later). 0.509 Thu Dec 20 22:01 2007 - Add new operator type: atan2 which mostly corresponds to perl's atan2. This provides some saftey during evaluation of atan(y/x) which may be more common than any other use the arc tangent. 0.508 Mon May 28 17:40 2007 - Fix two bugs in simplification (James Mastros). - Some simplification improvements. (It's still crude, though.) - Add mod_add_constant and mod_multiply_constant to DefaultMods. 0.507 Sat Jan 20 11:35 2007 - The Yapp parser was improved so that it now works with Math::Symbolic::Custom::Transformation. 0.506 Fri Jan 12 11:35 2007 - Much more tests. - Added test_num_equiv to DefaultTests for testing approximate equivalence of a M::S tree and another or a M::S tree and a sub. - Added a 'sqrt' function to both parsers which is transformed into '(...)^0.5' internally. - The Yapp parser now works with Math::SymbolicX::ParserExtensionFactory! 0.505 Fri Jan 12 11:35 2007 - Fixed bug in ::Parser related to missing precompiled parsers. (Thanks, Jerrad Pierce) - You can now request a Parse::Yapp-based parser from the ::Parser->new() method. - Add is_one, is_zero, is_zero_or_one to DefaultTests - Now does some simplification while deriving. - Fix bug while deriving some logarithms. - More derivative tests. 0.504 Fri Nov 3 16:15 2006 - Improved POD coverage tests. - This release is mainly intended to fix some PAUSE indexing trouble of the last release. 0.503 Fri Sep 12 18:08 2006 - Added an "exp()" function to the parsers. So now you can use "exp()" in expressions and have it transformed to "e^(...)" internally with a pretty high-precision Euler number. (The one returned by M::S::Constant->euler()) 0.502 Fri Apr 28 9:20 2006 - Small changes to the new parser to make it indexable by PAUSE. - Added a script to compile the Yapp parser. - Removed the Yapp parser's readme because the script documents itself. 0.501 Thu Apr 27 19:19 2006 - Added a completely new and optional(!) parser as Math::Symbolic::Parser::Yapp. This new parser should be about 30x faster and it's over 10x faster in all benchmarks. - Documented the new parser in Math::Symbolic::Parser. - Augmented the tests. - Added the new parser's grammar as Yapp.yp. 0.201 Tue Feb 14 15:32 2006 - Rewrote the to_latex() LaTeX dumper. Since it's quite a bit of code which few people actually need to load, the LaTeX dumper will be availlable as a separate distribution Math::Symbolic::Custom::LaTeXDumper. - Ergo: Removed to_latex() from Math::Symbolic::Custom::DefaultDumpers. - For some, this might be a change that breaks backwards compatibility. All you would need to do when upgrading Math::Symbolic is installing the aforementioned distribution and adding a call 'use Math::Symbolic::Custom::LaTeXDumper;' to your program and the new, shiny *much* improved to_latex() method will be availlable. - Don't blame me! to_latex() was flagged as 'extremely experimental'! 0.164 Sat Dec 31 09:57:20 2005 - Fixed bug in det() of ::MiscAlgebra. Thanks to Markus Laire who noticed it. - Added better tests to test for det() on 4x4 matrices and larger. 0.163 Thu Oct 06 21:43:59 2005 - Added 'use strict;' to the top of ::Parser::Precompiled. - Added 'use strict;' to the parser generator. - Changed build process to use Module::Build but still supports Makefile.PL. 0.162 Thu Sep 22 22:19:41 2005 - Added t/00pod.t which runs Test::Pod if it is availlable. - Added a "license" line to META.yml 0.161 Wed Sep 7 21:04:02 2005 - Corrected a few bugs in ::Derivative. - Sped up ::Derivative a bit. - Included obvious simplifications into the derivative routines that avoid crap such as '0*foo'. - Small modifications to t/04deep_derivatives.t. We derive only ten times instead of twenty. - simplify() now takes an argument: A boolean indicating whether or not the routine has to clone. - Fixed bugs in simplify(). - Improved the simplification routines. 0.160 Wed Aug 17 21:16:46 2005 - Fixed a bug in the parser that prevented it from parsing C floating point numbers of the form 1e10. - Hacked on the parser so it's now at least 50% faster! This results in a very noticeably speedup. Test times jumped from 17 seconds to 12 seconds on my machine. 0.150 Tue Aug 02 22:48:56 2005 - Optimized a couple of bits in the module. This should help a very slight bit with performance. - Nothing that warrants the jump in version number. The jump is meant to signal that you should upgrade if you haven't already. Anything prior to 0.135 may become a problem due to ::Precompiled. 0.136 Sat Jul 30 23:27:03 2005 - Added a (long) paragraph about performance to Math::Symbolic docs. - Cleaned the README from some old cruft. (Who cares what was introduced in version 0.110? Read the change log. Oh. Well, that's what you're doing right now!) 0.135 Fri Jul 29 21:23:36 2005 - Math::Symbolic is over 2 years old now. - It's been 1 year since the last released version. - Fixed bugs in Math::Symbolic::Parser::Precompiled that might cause it to not compile on some systems. Probably due to different behaviour of Parse::RecDescent in different versions or so. - Sped up t/18vectorcalc.t which is, well, still slow, but it now has some Data::Dumper dumped code in its DATA section. That's because Perl parses *much* faster than Parse::RecDescent! - Doctored around a bit on the docs. 0.134 Thu Jul 29 17:51:53 2004 - Corrected embarassing derivative bug. - Modified value() and apply() behaviour. Should not break compatibility but increase speed. - Constants that are created with an undefined value now throw a fatal error. Previous behaviour was to do so on value() calls which turned out to be hard to debug. This may break compatibility in bad code. - Tests for the above. 0.133 Mon May 10 10:12:44 2004 - Documentation fixes. - Parser returns undef if the input text hasn't been consumed entirely now. - Fixed bug in 16tests.t (test 22). - Added test for the above behaviour. 0.132 Mon Apr 12 18:02:27 2004 - Added additional syntax to value() and set_value() methods as suggested by Henrik Edlund. - Fixed bug in precompile_grammar.pl that broke the precompiled parser on many systems. - Fixed bug in Math::Symbolic::Compiler that caused exports to fail. - Reworked some of the examples. Particularily added an example that graphically demonstrates the differences between different Taylor polynomials. (examples/run16.pl) - Changed the overloaded interface: If you add or subtract an existing Math::Symbolic object to/from , the result will be the Math::Symbolic::* object. (in case of the subtraction, the result will be a unary minus and the Math::Symbolic::* object.) Example where this is very useful: my @objects = (...some objects...); my $sum; $sum += $_ foreach @objects; 0.131 Wed Mar 31 14:55:13 2004 - Changed $VERSION = 0.xxx; to ...= '0.xxx'; since that broke the Test::Distribution version tests. - Improved documentation for M::S::MiscAlgebra. - Added linear_solve to M::S::MiscAlgebra. - Added docs and tests. - Fixed errors in the documentation for M::S::Compiler. - Extra tests for the compiler. - Added the explicit_signature() method. - Added tests and documentation. - Fixed nasty bug in the compiler. - Fixed even nastier misdocumentation of the compiler. - Thanks to Henrik Edlund's input, one can now pass a hash ref to the compile* functions instead of an array ref. 0.130 Sun Feb 15 23:54:54 2004 - Fixed documentation bug in M::S::VectorCalculus. - Increased the accuracy of pi and euler number. - Fixed documentation bug in M::S::Derivative - Removed Pod::Coverage from the Makefile.PL requirements - Modified the 00sanity.t tests to only use Pod::Coverage when availlable. - Removed 1 test from 20miscalgebra.t which took way too long on automatted test platforms. - Renamed 00sanity.t to 00podcover.t and added 00dist.t which uses Test::Distribution for well, exactly that. - Modified precompile_grammar.pl (CVS only) to include a $VERSION in M::S::P::Precompiled. 0.129 Sat Feb 7 19:04:50 2004 - Fixed associativity bug in parser for exponentiation. - Regenerated the Precompiled Parser. - Improved simplification of sums and differences. - Removed some tests that tested methods redundantly with too much data. These tests unduly slowed down testing to the point that automatted testing facilities considered the tests failed. 0.128 Wed Feb 4 13:14:12 2004 - Fixed bug in Constant.pm about special tag not being unset when the value of the constant is changed. - Documented an important gotcha with the replace() method in Base.pm - Added an extra check to the apply() method in Operator.pm that makes sure no "undefined ... in [arithmetic operation]" errors are generated when computing 1/0. 0.127 Sat Jan 3 19:20:29 2004 - Happy New Year! - There was an error in the 0.126 distribution related to the Math::Symbolic::Parser::Precompiled module. 0.126 Sun Nov 9 16:54:26 2003 - Fixed parser bug with asinh, acosh. - Added Oliver Ebenhoeh to the list of contributors. - Now including a precompiled Parse::RecDescent grammar as Math::Symbolic::Parser::Precompiled. That's for startup performance. 0.125 Wed Oct 8 16:19:13 2003 - Implemented binomial_coeff in AuxFunctions. - Now requiring Memoize to be installed. - Added META.yml and Makefile.PL dependency. - Added bell_number() to AuxFunctions. - Added bell_polynomial to MiscAlgebra. - Slightly improved simplification. 0.124 Wed Oct 1 15:08:49 2003 - Now value() and apply() return undef if any var is undefined. - Docs for the above. - value() on constants that aren't defined die. - Fixed some documentation oversights. - Added to_code, to_sub to DefaultDumpers. - Added fill_in_vars() to Base. - Moved the run*.pl files to ./examples/ - Added the perltidy.conf that is being used with this module to the CVS development tree. - Added WronskyDet to VectorCalc - Modified MANIFEST.skip to ignore CVS dirs and perltidy.conf - Added 00sanity.t which uses all modules and uses Pod::Coverage to test for validity of documentation. - Added requirement of Pod::Coverage to META.yml and Makefile.PL 0.123 Fri Sep 26 00:49:55 2003 - Fixed the previously slightly broken to_latex() method. - Added support for automatic greek output for to_latex(). - Added custom variable mapping for to_latex(). 0.122 Tue Sep 23 22:18:19 2003 - Added the 'to_' delegation prefix. - Added Math::Symbolic::Custom::DefaultDumpers. - Added support for dumping to LaTeX! *evil grin* 0.121 Sun Sep 14 14:41:31 2003 - Added M::S::MiscAlgebra and the det() routine. - Slightly improved simlification process - Added is_identical_base to the DefaultTests - Started implementation of mod_join_simple in DefaultMods. 0.120 Thu Sep 11 16:42:51 2003 - Now mentioning "Hesse" as exportable function of M::S::VectorCalclus. - Implemented TotalDifferential and DirectionalDerivative. - Implemented TaylorPolyTwoDim. - Cross-referenced the two taylor-related function docs. - Tests and documentation for the new features. - Added run17.pl to the distribution. 0.119 Wed Sep 10 00:48:02 2003 - Improved exponentiation simplification. - Now surpressing deep recursion warnings. - Fixed a few bugs in the tree descending routines. - Introduced M::S::MiscCalculus with TaylorPolynomial, TaylorErrorLagrange, and TaylorErrorCauchy. - Added run16.pl to the distribution. - Referenced the new module in Math::Symbolic. - Added tests. 0.118 Tue Sep 9 13:18:24 2003 - No more requiring Parse::RecDescent via Makefile.PL. After all, you can use Math::Symbolic without the parser (though you sacrifice the best piece of the interface that way.) - Updated META.yml to recommend Parse::RecDescent and require it for building. - Added Hesse() to M::S::VectorCalculus. - Amended tests for M::S::VectorCalculus. - Fixed typo in AUTHORS sections - is_identical now auto-parses first argument if not a M::S tree. - Slightly improved the simplification process using is_identical. - Fixed various small bugs in M::S::Constant and M::S::Operator. - Fixed parser bugs related to unary minus. - Improved unary minus simplification. - Added more unary minus parsing/simplification tests. 0.117 Mon Sep 8 17:12:36 2003 - Added M::S::VectorCalculus with rot, grad, div, Jacobi - Referenced it in the docs to the main module. - Added run15.pl example of usage. - Added tests. - Fixed bug in M::S::Variable 0.116 Wed Sep 3 22:16:51 2003 - Added META.yml - Removed "Exporter" dependency in Makefile.PL. Who needs to install Exporter from CPAN anyway? - Added run14.pl with Math::Complex stuff. - Math::Symbolic::Parser now defers loading Parse::RecDescent to the first call of the parser constructor. - Math::Symbolic now defers creating a parser to the first call of "parse_from_string". - Together, the above changes made the testsuite run 30% faster because many of the basic test scripts don't use the parser. 0.115 Tue Sep 2 16:23:15 2003 - Moved to sf.net - Ran perltidy over the distro. - Lots of doc patches including a section on extending the module. - Added can() overriding to Base.pm in order to reflect method delegation. 0.114 Thu Aug 28 13:26:47 2003 - Fixed bug in set_value() routine that was introduced in 0.113. - New example in Math::Symbolic docs 0.113 Sun Aug 17 19:13:28 2003 - Added the MS::Constant pi() constructor - Added tests and docs. - Added the MS::Base descend() routine. (This is a biggie.) - Converted as many descending routines as possible to be using descend() instead of descending themselves. These include is_constant, is_simple_constant, is_sum, apply_constant_fold, apply_derivatives() - Added new method namespace to be delegated to M::S::Custom: 'contains_. - Added docs and tests. - Added replace(). - Fixed a bug in implement(). Now also autoparses strings. - Added is_identical() to M::S::C::Default - Split up M::S::C::Default into M::S::C::DefaultTests and M::S::C::DefaultMods. - Added the M::S::Base::descending_operands() routine that tries to find the most sensible operands to descend into. - Added the operand_finder parameter to descend(). - Moved set_value to M::S::Base and refactored it to use descend(). - Modified implement() similarily to set_value. - Fixed some bugs in implement(), too. - Hacked simplify() some more. This needs to be cleaned up real soon. 0.112 Thu Aug 7 19:11:38 2003 - Continued moving functionality into the M::S::Custom::* namespace. - Moved constant_fold into custom namespace - Added tests. - Fixed serious bugs. 0.111 Tue Jul 29 12:38:40 2003 - Added Math::Symbolic::Custom::*. - Added custom transformation and test functionality. - Added is_sum(), is_constant(), is_integer() to M::S::C::Default - Added documentation and tests for the above. - Moved apply_derivatives() to the MSC::Default namespace. - TODO goals met with this release: + Create a Math::Symbolic::Custom class and a Math::Symbolic::Custom::Default class. + The Math::Symbolic::Custom::Default class is to contain all builtin simplification and term-transformation routines. (Also contains methods that tests trees for particular properties) + All calls to Math::Symbolic methods that cannot be resolved in the Math::Symbolic inheritance hierarchy (which should consist of the package itself, anyhow) and that start with "apply_" should be delegated to the subs named apply_... in the Math::Symbolic::Custom package. ('is_', 'test_', and 'mod_' also delegated.) + Math::Symbolic::Custom should load Math::Symbolic::Custom::Default. + Math::Symbolic::Custom::Default should inherit from a package named Math::Symbolic::Custom::Base which defines a special import routine that automatically adds the loaded module to the @ISA of Math::Symbolic::Custom. (Implemented this using a custom exporter scheme.) + Thus, users can extend the number of Math::Symbolic::Custom's by writing a package with transformation subroutines in it that just inherits from Math::Symbolic::Custom::Base. Upon use-ing the custom module, the routines will automatically be added to Math::Symbolic's transformation and testing repertoire. 0.110 Sat Jul 19 15:16:11 2003 - Documentation patches. - Added total derivatives. - Fixed the host of bugs that were discovered while implementing total derivatives. - Added tests. - Added docs. - Added docs section on variable passing styles to Compiler.pm - Added implement() - Fixed uncovered bugs in total derivatives. - TODO goals met with this release: + Add signatures to variables. + Add signature() methods to all elements. + Amend parser to parse signatures. + Given the signature-parser enhancements, total derivatives start making sense. Since function signatures must be defined by their signatures when they're used, total derivatives can be applied to all functions. (Or, if their implementation is still undefined, they can possibly still be kicked out because of their non-dependence on a particular variable.) + Add tests for sigs. + Add tests for the new features. 0.109 Fri Jul 18 00:34:00 2003 - Documentation patches. - Added signature attribute to variables. - Added signature() method to all tree elements. - Added set_signature() method to variables. - Some docs for the sig. changes. - Tests for the sig. changes. - Modified parser to parse unknown 'function(list)' constructs as variables and their signatures. - Tests for the parser changes. - Documentation for the parser changes. - Added some bad examples to the parser man-page. 0.108 Wed Jul 16 22:41:01 2003 - Added Math::Symbolic::Compiler (as a modified to_sub.pl). - Modified value() semantics to optionally take arguments. - Added set_value() method. - Added lots of docs. - Added some tests. - TODO milestones met with this release: + Refactor the to_sub.pl code to a package that allows to compile Math::Symbolic trees to subroutines and/or code. 0.107 Sun Jul 13 21:25:29 2003 - Fixed tests. (Note to self: recreate MANIFEST for dists.) 0.106 Sun Jul 13 19:56:29 2003 - Modified the parser to parse unknown identifiers as variables. - Modified Operator constructor to send operands through the parser if they aren't valid Math::Symbolic::* objects. - Added and fixed docs. A lot. - Added tests. 0.105 Wed Jul 9 18:56:33 2003 - Added several important items to the TODO. - Accepted the fact that the TODO is growing faster than the code base. - TODO milestones met with this release: + Add reasonable overloaded interface for arithmetic operators and some mathematical functions as far as feasible. + Overloaded interface for exp, sqrt, log, +,-,*,/,**. + Overloaded interface for boolean context and stringification. + O. i. for unary minus + O. i. for trig functions + Overloaded interface for numerical context. + Tests for the above. + Documentation for the above changes 0.104 Sat Jul 5 19:17:00 2003 - Added to_sub.pl to the distribution. (Math::Symbolic -> Perl sub compiler.) This is just a proof-of-concept. 0.103 Thu Jun 26 15:08:12 2003 - Fixed test errors. - Added (very little) documentation. 0.102 Wed Jun 25 21:04:41 2003 - Added overloaded interface for arithmetic operators, exp, log, sqrt, boolean context, numerical context, sin, cos, mutators. - Added tests. - Added docs. 0.101 Fri Jun 20 15:45:10 2003 - Documentation fixes 0.100 Fri Jun 20 01:32:32 2003 (Yep, I hack at random hours.) - Implemented hyperbolic sine, h cosine. - Implemented partial derivatives for h sine, h cosine - Amended parser for h sine, h cosine. - Same for tangents - Myriad of bugfixes - ExportConstants now includes (and exports) PI and EULER constants. - Renamed class data in M::S::Operator. - Cotangent. - Arc sine, arc cosine, arc tangent, arc cotangent. - Hyperbolic area sine, h. a. cosine - Tests for the above. - Broke the parser badly. - (much later) Fixed it again. - Some more documentation - Renamed test files - TODO milestones met with this release: + Add sine/cosine + Amend parser to parse sine/cosine. + Add sinh/cosh or at least allow the user to use them in the input string to the parser and have them replaced with (e^x ± e^-x)/2 + Amend parser to parse hyperbolic sine/h. cosine. + Add tan, arctan, arcsine, arccosine + Amend parser to parse tan / arctan, arcsine / arccosine. + Find a more reasonable naming scheme for class data and rename appropriately. + Add tests for the new features. 0.090 Wed Jun 18 16:37:56 2003 - Implemented sine, cosine, sine/cosine derivatives - Amended parser for sine and cosine functions 0.080 Sun Jun 15 22:17:11 2003 - Parser now a module (M::S::Parser) - Parser accessible through new_from_string(). 0.070 Sat Jun 14 18:21:47 2003 - Parser now outputs Math::Symbolic tree - Fixed unary-minus to infix issues. 0.060 Wed Jun 11 16:58:59 2003 - Now including rudimentary parser for algebraic expressions. - Some documentation added. 0.050 Fri Jun 6 16:57:19 2003 - Moved the rules for partial derivatives to separate subs and introduced a lookup-table. 0.040 Thu Jun 5 01:12:23 2003 - Many changes again. 0.030 Wed Jun 4 18:43:00 2003 - More major enhancements (exp function, log, derivative as operator) 0.020 Wed Jun 4 14:29:15 2003 - First working version. 0.010 Tue Jun 3 21:45:57 2003 - original version; created by h2xs 1.21 with options -AX Math::Symbolic Math-Symbolic-0.612/README000444001750001750 570512157534055 14310 0ustar00tseetsee000000000000Math::Symbolic ============== Math::Symbolic is intended to offer symbolic calculation capabilities to the Perl programmer without using external (and commercial) libraries and/or applications. Unless, however, some interested and knowledgable developers turn up to participate in the development, the library will be severely limited by my experience in the area. Symbolic calculations are an active field of research in computer science. The module supports compiling Math::Symbolic trees to fast Perl or C code. Version 0.116 of this module has been used in conjunction with Math::Complex to offer symbolic calculation with complex numbers. Please have a look at the enclosed example scripts. Version 0.119 introduced some calculus related subroutines including the symbolic computation of Taylor Polynomials and the associated errors from Math::Symbolic trees. Vectorial calculus including gradients, divergence, rotation, Jacobi- and Hesse matrices, Wronskian Determinants, directional derivatives, total differentials, and two dimensional Taylor Polynomials is supported by the Math::Symbolic::VectorCalculus module which is part of the distribution but not loaded by default. Similarily, algebra related functions like determinants are offered by Math::Symbolic::MiscAlgebra. Using the Math::Symbolic::Custom::LaTeXDumper distribution from CPAN, it is possible to dump Math::Symbolic trees as LaTeX formulae! You are encouraged to visit http://search.cpan.org and search for 'Math::Symbolic'. You will find various extension modules! INSTALLATION To install this module type the following: perl Build.PL ./Build ./Build test ./Build install On platforms that don't support the "./" notation, that would be: perl Build.PL perl Build perl Build test perl Build install If you wish, you may use the old MakeMaker style instead: perl Makefile.PL make make test make install Since version 0.501, we include support for a new, faster Parse::Yapp based parser. By default we use the old parser, but if you would like to test the new parser, run the tests as follows: TEST_YAPP_PARSER=1 ./Build test DEPENDENCIES This module requires these other modules and libraries: Test::More Exporter Parse::RecDescent Memoize SEE ALSO Current versions of this module may be found on http://steffen-mueller.net or CPAN. The development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic Please send your suggestions, inquiries, and feedback to math-symbolic-support at lists dot sourceforge dot net. Feel free to subscribe to the developers mailing list: math-symbolic-develop at lists dot sourceforge dot net COPYRIGHT AND LICENCE Copyright (C) 2003-2013 Steffen Mueller This library is free software; you can redistribute it and/or modify it under the same terms as Perl (5) itself. CONTRIBUTIONS Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh Math-Symbolic-0.612/lib000755001750001750 012157534055 14032 5ustar00tseetsee000000000000Math-Symbolic-0.612/lib/Math000755001750001750 012157534055 14723 5ustar00tseetsee000000000000Math-Symbolic-0.612/lib/Math/Symbolic.pm000444001750001750 5747312157534055 17237 0ustar00tseetsee000000000000=encoding utf8 =head1 NAME Math::Symbolic - Symbolic calculations =head1 SYNOPSIS use Math::Symbolic; my $tree = Math::Symbolic->parse_from_string('1/2 * m * v^2'); # Now do symbolic calculations with $tree. # ... like deriving it... my ($sub) = Math::Symbolic::Compiler->compile_to_sub($tree); my $kinetic_energy = $sub->($mass, $velocity); =head1 DESCRIPTION Math::Symbolic is intended to offer symbolic calculation capabilities to the Perl programmer without using external (and commercial) libraries and/or applications. Unless, however, some interested and knowledgable developers turn up to participate in the development, the library will be severely limited by my experience in the area. Symbolic calculations are an active field of research in CS. There are several ways to construct Math::Symbolic trees. There are no actual Math::Symbolic objects, but rather trees of objects of subclasses of Math::Symbolic. The most general but unfortunately also the least intuitive way of constructing trees is to use the constructors of the Math::Symbolic::Operator, Math::Symbolic::Variable, and Math::Symbolic::Constant classes to create (nested) objects of the corresponding types. Furthermore, you may use the overloaded interface to apply the standard Perl operators (and functions, see L) to existing Math::Symbolic trees and standard Perl expressions. Possibly the most convenient way of constructing Math::Symbolic trees is using the builtin parser to generate trees from expressions such as C<2 * x^5>. You may use the Cparse_from_string()> class method for this. Of course, you may combine the overloaded interface with the parser to generate trees with Perl code such as C<$term * 5 * 'sin(omega*t+phi)'> which will create a tree of the existing tree $term times 5 times the sine of the vars omega times t plus phi. There are several modules in the distribution that contain subroutines related to calculus. These are not loaded by Math::Symbolic by default. Furthermore, there are several extensions to Math::Symbolic available from CPAN as separate distributions. Please refer to L for an incomplete list of these. For example, L come with C and contains routines to compute Taylor Polynomials and the associated errors. Routines related to vector calculus such as grad, div, rot, and Jacobi- and Hesse matrices are available through the L module. This module is also able to compute Taylor Polynomials of functions of two variables, directional derivatives, total differentials, and Wronskian Determinants. Some basic support for linear algebra can be found in L. This includes a routine to compute the determinant of a matrix of C trees. =head2 EXPORT None by default, but you may choose to have the following constants exported to your namespace using the standard Exporter semantics. There are two export tags: :all and :constants. :all will export all constants and the parse_from_string subroutine. Constants for transcendetal numbers: EULER (2.7182...) PI (3.14159...) Constants representing operator types: (First letter indicates arity) (These evaluate to the same numbers that are returned by the type() method of Math::Symbolic::Operator objects.) B_SUM B_DIFFERENCE B_PRODUCT B_DIVISION B_LOG B_EXP U_MINUS U_P_DERIVATIVE (partial derivative) U_T_DERIVATIVE (total derivative) U_SINE U_COSINE U_TANGENT U_COTANGENT U_ARCSINE U_ARCCOSINE U_ARCTANGENT U_ARCCOTANGENT U_SINE_H U_COSINE_H U_AREASINE_H U_AREACOSINE_H B_ARCTANGENT_TWO Constants representing Math::Symbolic term types: (These evaluate to the same numbers that are returned by the term_type() methods.) T_OPERATOR T_CONSTANT T_VARIABLE Subroutines: parse_from_string (returns Math::Symbolic tree) =cut package Math::Symbolic; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic::ExportConstants qw/:all/; use Math::Symbolic::AuxFunctions; use Math::Symbolic::Base; use Math::Symbolic::Operator; use Math::Symbolic::Variable; use Math::Symbolic::Constant; use Math::Symbolic::Derivative; use Math::Symbolic::Parser; use Math::Symbolic::Compiler; use Math::Symbolic::Custom; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( all => [ @{ $Math::Symbolic::ExportConstants::EXPORT_TAGS{all} }, qw{&parse_from_string}, ], constants => [ @{ $Math::Symbolic::ExportConstants::EXPORT_TAGS{all} }, ], ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.612'; =head1 CLASS DATA The package variable $Parser will contain a Parse::RecDescent object that is used to parse strings at runtime. =cut our $Parser = Math::Symbolic::Parser->new(); =head1 SUBROUTINES =head2 parse_from_string This subroutine takes a string as argument and parses it using a Parse::RecDescent parser taken from the package variable $Math::Symbolic::Parser. It generates a Math::Symbolic tree from the string and returns that tree. The string may contain any identifiers matching /[a-zA-Z][a-zA-Z0-9_]*/ which will be parsed as variables of the corresponding name. Please refer to L for more information. =cut sub parse_from_string { my $string = shift; croak "Missing string argument from parse_from_string() call" unless defined $string; if ($string eq 'Math::Symbolic') { if (@_) { $string = shift; } else { croak("Missing string argument from Math::Symbolic->parse_from_string() call"); } } $string =~ s/\s+//gso; if ( not defined $Parser ) { $Parser = Math::Symbolic::Parser->new(); } return $Parser->parse($string); } 1; __END__ =head1 EXAMPLES This example demonstrates variable and operator creation using object prototypes as well as partial derivatives and the various ways of applying derivatives and simplifying terms. Furthermore, it shows how to use the compiler for simple expressions. use Math::Symbolic qw/:all/; my $energy = parse_from_string(<<'HERE'); kinetic(mass, velocity, time) + potential(mass, z, time) HERE $energy->implement(kinetic => '(1/2) * mass * velocity(time)^2'); $energy->implement(potential => 'mass * g * z(t)'); $energy->set_value(g => 9.81); # permanently print "Energy is: $energy\n"; # Is how does the energy change with the height? my $derived = $energy->new('partial_derivative', $energy, 'z'); $derived = $derived->apply_derivatives()->simplify(); print "Changes with the heigth as: $derived\n"; # With whatever values you fancy: print "Putting in some sample values: ", $energy->value(mass => 20, velocity => 10, z => 5), "\n"; # Too slow? $energy->implement(g => '9.81'); # To get rid of the variable my ($sub) = Math::Symbolic::Compiler->compile($energy); print "This was much faster: ", $sub->(20, 10, 5), # vars ordered alphabetically "\n"; =head1 OVERLOADED OPERATORS Since version 0.102, several arithmetic operators have been overloaded. That means you can do most arithmetic with Math::Symbolic trees just as if they were plain Perl scalars. The following operators are currently overloaded to produce valid Math::Symbolic trees when applied to an expression involving at least one Math::Symbolic object: +, -, *, /, **, sqrt, log, exp, sin, cos Furthermore, some contexts have been overloaded with particular behaviour: '""' (stringification context) has been overloaded to produce the string representation of the object. '0+' (numerical context) has been overloaded to produce the value of the object. 'bool' (boolean context) has been overloaded to produce the value of the object. If one of the operands of an overloaded operator is a Math::Symbolic tree and the over is undef, the module will throw an error I. If the operator is an addition, the result will be the original Math::Symbolic tree. If the operator is a subtraction, the result will be the negative of the Math::Symbolic tree. Reason for this inconsistent behaviour is that it makes idioms like the following possible: @objects = (... list of Math::Symbolic trees ...); $sum += $_ foreach @objects; Without this behaviour, you would have to shift the first object into $sum before using it. This is not a problem in this case, but if you are applying some complex calculation to each object in the loop body before adding it to the sum, you'd have to either split the code into two loops or replicate the code required for the complex calculation when shift()ing the first object into $sum. B The operator to use for exponentiation is the normal Perl operator for exponentiation C<**>, NOT the caret C<^> which denotes exponentiation in the notation that is recognized by the Math::Symbolic parsers! The C<^> operator will be interpreted as the normal binary xor. =head1 EXTENDING THE MODULE Due to several design decisions, it is probably rather difficult to extend the Math::Symbolic related modules through subclassing. Instead, we chose to make the module extendable through delegation. That means you can introduce your own methods to extend Math::Symbolic's functionality. How this works in detail can be read in L. Some of the extensions available via CPAN right now are listed in the L section. =head1 PERFORMANCE Math::Symbolic can become quite slow if you use it wrong. To be honest, it can even be slow if you use it correctly. This section is meant to give you an idea about what you can do to have Math::Symbolic compute as quickly as possible. It has some explanation and a couple of 'red flags' to watch out for. We'll focus on two central points: Creation and evaluation. =head2 CREATING Math::Symbolic TREES Math::Symbolic provides several means of generating Math::Symbolic trees (which are just trees of Math::Symbolic::Constant, Math::Symbolic::Variable and most importantly Math::Symbolic::Operator objects). The most convenient way is to use the builtin parser (for example via the C subroutine). Problem is, this darn thing becomes really slow for long input strings. This is a known problem for Parse::RecDescent parsers and the Math::Symbolic grammar isn't the shortest either. B I'll give a simple example where this first advice is gospel: use Math::Symbolic qw/parse_from_string/; my @formulas; foreach my $var (qw/x y z foo bar baz/) { my $formula = parse_from_string("sin(x)*$var+3*y^z-$var*x"); push @formulas, $formula; } So what's wrong here? I'm parsing the whole formula every time. How about this? use Math::Symbolic qw/parse_from_string/; my @formulas; my $sin = parse_from_string('sin(x)'); my $term = parse_from_string('3*y^z'); my $x = Math::Symbolic::Variable->new('x'); foreach my $var (qw/x y z foo bar baz/) { my $v = $x->new($var); my $formula = $sin*$var + $term - $var*$x; push @formulas, $formula; } I wouldn't call that more legible, but you notice how I moved all the heavy lifting out of the loop. You'll know and do this for normal code, but it's maybe not as obvious when dealing with such code. Now, since this is still slow and - if anything - ugly, we'll do something really clever now to get the best of both worlds! use Math::Symbolic qw/parse_from_string/; my @formulas; my $proto = parse_from_string('sin(x)*var+3*y^z-var*x"); foreach my $var (qw/x y z foo bar baz/) { my $formula = $proto->new(); $formula->implement(var => Math::Symbolic::Variable->new($var)); push @formulas, $formula; } Notice how we can combine legibility of a clean formula with removing all parsing work from the loop? The C method is described in detail in L. On a side note: One thing you could do to bring your computer to its knees is to take a function like I, derive that in respect to I a couple of times (like, erm, 50 times?), call C on it and parse that string again. Almost as convenient as the parser is the overloaded interface. That means, you create a Math::Symbolic object and use it in algebraic expressions as if it was a variable or number. This way, you can even multiply a Math::Symbolic tree with a string and have the string be parsed as a subtree. Example: my $x = Math::Symbolic::Variable->new('x'); my $formula = $x - sin(3*$x); # $formula will be a M::S tree # or: my $another = $x - 'sin(3*x)'; # have the string parsed as M::S tree This, however, turns out to be rather slow, too. It is only about two to five times faster than parsing the formula all the way. B Finally, you can create objects using the C constructors from Math::Symbolic::Operator and friends. These can be called in two forms, a long one that gives you complete control (signature for variables, etc.) and a short hand. Even if it is just to protect your finger tips from burning, you should use the short hand whenever possible. It is also I faster. B on that may help with the typing effort and should not result in a slow down>. =head2 CRUNCHING NUMBERS WITH Math::Symbolic As with the generation of Math::Symbolic trees, the evaluation of a formula can be done in distinct ways. The simplest is, of course, to call C on the tree and have that calculate the value of the formula. You might have to supply some input values to the formula via C, but you can also call C before using C. But that's not faster. For each call to C, the computer walks the complete Math::Symbolic tree and evaluates the nodes. If it reaches a leaf, the resulting value is propagated back up the tree. (It's a depth-first search.) B You may be able to make the formula simpler using the Math::Symbolic simplification routines (like C or some stuff in the Math::Symbolic::Custom::* modules). Simpler formula are quicker to evaluate. In particular, the simplification should fold constants. B But again, your mileage may vary. Test first. If the overhead of calling C is unaccepable, you should use the Math::Symbolic::Compiler to compile the tree to Perl code. (Which usually comes in compiled form as an anonymous subroutine.) Example: my $tree = parse_from_string('3*x+sin(y)^(z+1)'); my $sub = $tree->to_sub(y => 0, x => 1, z => 2); foreach (1..100) { # define $x, $y, and $z my $res = $sub->($y, $x, $z); # faster than $tree->value(x => $x, y => $y, z => $z) !!! } B On an interesting side note, the subroutines compiled from Math::Symbolic trees are just as fast as hand-crafted, "performance tuned" subroutines. If you have extremely long formulas, you can choose to even resort to more extreme measures than generating Perl code. You can have Math::Symbolic generate C code for you, compile that and link it into your application at run time. It will then be available to you as a subroutine. This is not the most portable thing to do. (You need Inline::C which in turn needs the C compiler that was used to compile your perl.) Therefore, you need to install an extra module for this. It's called L. The speed-up for short formulas is only about factor 2 due to the overhead of calling the Perl subroutine, but with sufficiently complicated formulas, you should be able to get a boost up to factor 100 or even 1000. B =head2 PROOF In the last two sections, you were told a lot about the performance of two important aspects of Math::Symbolic handling. But eventhough benchmarks are very system dependent and have limited meaning to the general case, I'll supply some proof for what I claimed. This is Perl 5.8.6 on linux-2.6.9, x86_64 (Athlon64 3200+). In the following tables, I means evaluation using the C method, I means evaluation of Perl code as a string, I is a hand-crafted Perl subroutine, I is the compiled Perl code, I is the compiled C code. Evaluation of a very simple function yields: f(x) = x*2 Rate value eval sub compiled c value 17322/s -- -68% -99% -99% -99% eval 54652/s 215% -- -97% -97% -97% sub 1603578/s 9157% 2834% -- -1% -16% compiled 1616630/s 9233% 2858% 1% -- -15% c 1907541/s 10912% 3390% 19% 18% -- We see that resorting to C is a waste in such simple cases. Compiling to a Perl sub, however is a good idea. f(x,y,z) = x*y*z+sin(x*y*z)-cos(x*y*z) Rate value eval compiled sub c value 1993/s -- -88% -100% -100% -100% eval 16006/s 703% -- -97% -97% -99% compiled 544217/s 27202% 3300% -- -2% -56% sub 556737/s 27830% 3378% 2% -- -55% c 1232362/s 61724% 7599% 126% 121% -- f(x,y,z,a,b) = x^y^tan(a*z)^(y*sin(x^(z*b))) Rate value eval compiled sub c value 2181/s -- -84% -99% -99% -100% eval 13613/s 524% -- -97% -97% -98% compiled 394945/s 18012% 2801% -- -5% -48% sub 414328/s 18901% 2944% 5% -- -46% c 763985/s 34936% 5512% 93% 84% -- These more involved examples show that using I can become unpractical even if you're just doing a 2D plot with just a few thousand points. The C routines aren't I much faster, but they scale much better. Now for something different. Let's see whether I lied about the creation of Math::Symbolic trees. I indicates that the parser was used to create the object tree. I indicates that the long syntax of the constructor was used. I... well. I means that the objects were created from prototypes of the same class. For I and I, I used the overloaded interface in conjunction with constructors or parsing (a la C<$x * 'y+z'>). f(x) = x Rate parse long short ol_long ol_parse proto parse 258/s -- -100% -100% -100% -100% -100% long 95813/s 37102% -- -33% -34% -34% -35% short 143359/s 55563% 50% -- -2% -2% -3% ol_long 146022/s 56596% 52% 2% -- -0% -1% ol_parse 146256/s 56687% 53% 2% 0% -- -1% proto 147119/s 57023% 54% 3% 1% 1% -- Obviously, the parser gets blown to pieces, performance-wise. If you want to use it, but cannot accept its tranquility, you can resort to Math::SymbolicX::Inline and have the formulas parsed at compile time. (Which isn't faster, but means that they are available when the program runs.) All other methods are about the same speed. Note, that the ol_* tests are just the same as I here, because in case of C, you cannot make use of the overloaded interface. f(x,y,a,b) = x*y(a,b) Rate parse ol_parse ol_long long proto short parse 125/s -- -41% -41% -100% -100% -100% ol_parse 213/s 70% -- -0% -99% -99% -99% ol_long 213/s 70% 0% -- -99% -99% -99% long 26180/s 20769% 12178% 12171% -- -6% -10% proto 27836/s 22089% 12955% 12947% 6% -- -5% short 29148/s 23135% 13570% 13562% 11% 5% -- f(x,a) = sin(x+a)*3-5*x Rate parse ol_long ol_parse proto short parse 41.2/s -- -83% -84% -100% -100% ol_long 250/s 505% -- -0% -97% -98% ol_parse 250/s 506% 0% -- -97% -98% proto 9779/s 23611% 3819% 3810% -- -3% short 10060/s 24291% 3932% 3922% 3% -- The picture changes when we're dealing with slightly longer functions. The performance of the overloaded interface isn't that much better than the parser. (Since it uses the parser to convert non-Math::Symbolic operands.) I should, however, be faster than I. I'll refine the benchmark somewhen. The three other construction methods are still about the same speed. I omitted the long version in the last benchmark because the typing work involved was unnerving. =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ The following modules come with this distribution: L, L L, L, L, L L, L, L, L L L, L, L, L L, L, L The following modules are extensions on CPAN that do not come with this distribution in order to keep the distribution size reasonable. L - (Inlined Math::Symbolic functions) L (Compile Math::Symbolic trees to C for speed or for use in C code) L (Big number support for the Math::Symbolic parser) L (Complex number support for the Math::Symbolic parser) L (Find subtrees in Math::Symbolic expressions) L (Generate parser extensions for the Math::Symbolic parser) L (Calculate Gaussian Error Propagation) L (Statistical Distributions as Math::Symbolic functions) L (Turns off Math::Symbolic simplifications) =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, smueller at cpan dot org Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 COPYRIGHT AND LICENSE Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2013 by Steffen Mueller This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.6.1 or, at your option, any later version of Perl 5 you may have available. =cut Math-Symbolic-0.612/lib/Math/Symbolic000755001750001750 012157534055 16504 5ustar00tseetsee000000000000Math-Symbolic-0.612/lib/Math/Symbolic/AuxFunctions.pm000444001750001750 710012157534055 21623 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::AuxFunctions - Auxiliary functions for Math::Symbolic hierarchy =head1 SYNOPSIS use Math::Symbolic::AuxFunctions; Math::Symbolic::AuxFunctions::acos($x); # etc =head1 DESCRIPTION This module contains implementations of some auxiliary functions that are used within the Math::Symbolic hierarchy of modules. In particular, this module holds all trigonometric functions used for numeric evaluation of trees by Math::Symbolic::Operator. =head2 EXPORT None. On purpose. If I wished this module would pollute others' namespaces, I'd have put the functions right where they're used. =cut package Math::Symbolic::AuxFunctions; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic::ExportConstants qw/:all/; use Memoize; our $VERSION = '0.612'; =head1 TRIGONOMETRIC FUNCTIONS =head2 tan Computes the tangent sin(x) / cos(x). =cut sub tan { sin( $_[0] ) / cos( $_[0] ) } =head2 cot Computes the cotangent cos(x) / sin(x). =cut sub cot { cos( $_[0] ) / sin( $_[0] ) } =head2 asin Computes the arc sine asin(z) = -i log(iz + sqrt(1-z*z)). Above formula is for complex numbers. =cut sub asin { atan2( $_[0], sqrt( 1 - $_[0] * $_[0] ) ) } =head2 acos Computes the arc cosine acos(z) = -i log(z + sqrt(z*z-1)). Above formula is for complex numbers. =cut sub acos { atan2( sqrt( 1 - $_[0] * $_[0] ), $_[0] ) } =head2 atan Computes the arc tangent atan(z) = i/2 log((i+z) / (i-z)). Above formula is for complex numbers. =cut sub atan { atan2( $_[0], 1 ) } =head2 acot Computes the arc cotangent ( atan( 1 / x ) ). =cut sub acot { atan2( 1 / $_[0], 1 ) } =head2 asinh Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z+1)) =cut sub asinh { log( $_[0] + sqrt( $_[0] * $_[0] + 1 ) ) } =head2 acosh Computes the arc hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)). =cut sub acosh { log( $_[0] + sqrt( $_[0] * $_[0] - 1 ) ) } =head1 OTHER FUNCTIONS =cut =head2 binomial_coeff Calculates the binomial coefficient n over k of its first two arguments (n, k). Code taken from Orwant et al, "Mastering Algorithms with Perl" =cut memoize('binomial_coeff'); sub binomial_coeff { my ( $n, $k ) = @_; my ( $res, $j ) = ( 1, 1 ); return 0 if $k > $n || $k < 0; $k = ( $n - $k ) if ( $n - $k ) < $k; while ( $j <= $k ) { $res *= $n--; $res /= $j++; } return $res; } =head2 bell_number The Bell numbers are defined as follows: B_0 = 1 B_n+1 = sum_k=0_to_n( B_k * binomial_coeff(n, k) ) This function uses memoization. =cut memoize('bell_number'); sub bell_number { my $n = shift; return undef if $n < 0; return 1 if $n == 0; my $bell = 0; $bell += bell_number($_) * binomial_coeff( $n - 1, $_ ) for 0 .. $n - 1; return $bell; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/MiscCalculus.pm000444001750001750 2262112157534055 21611 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::MiscCalculus - Miscellaneous calculus routines (eg Taylor poly) =head1 SYNOPSIS use Math::Symbolic qw/:all/; use Math::Symbolic::MiscCalculus qw/:all/; # not loaded by Math::Symbolic $taylor_poly = TaylorPolynomial $function, $degree, $variable; # or: $taylor_poly = TaylorPolynomial $function, $degree, $variable, $pos; $lagrange_error = TaylorErrorLagrange $function, $degree, $variable; # or: $lagrange_error = TaylorErrorLagrange $function, $degree, $variable, $pos; # or: $lagrange_error = TaylorErrorLagrange $function, $degree, $variable, $pos, $name_for_range_variable; # This has the same syntax variations as the Lagrange error: $cauchy_error = TaylorErrorLagrange $function, $degree, $variable; =head1 DESCRIPTION This module provides several subroutines related to calculus such as computing Taylor polynomials and errors the associated errors from Math::Symbolic trees. Please note that the code herein may or may not be refactored into the OO-interface of the Math::Symbolic module in the future. =head2 EXPORT None by default. You may choose to have any of the following routines exported to the calling namespace. ':all' tag exports all of the following: TaylorPolynomial TaylorErrorLagrange TaylorErrorCauchy =head1 SUBROUTINES =cut package Math::Symbolic::MiscCalculus; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic qw/:all/; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( TaylorPolynomial TaylorErrorLagrange TaylorErrorCauchy ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our $VERSION = '0.612'; =begin comment _faculty() computes the (symbolic) product that is the faculty of the first argument. =end comment =cut sub _faculty { my $num = shift; croak "Cannot calculate faculty of negative numbers." if $num < 0; my $fac = Math::Symbolic::Constant->one(); return $fac if $num <= 1; for ( my $i = 2 ; $i <= $num ; $i++ ) { $fac *= Math::Symbolic::Constant->new($i); } return $fac; } =head2 TaylorPolynomial This function (symbolically) computes the nth-degree Taylor Polynomial of a given function. Generally speaking, the Taylor Polynomial is an n-th degree polynomial that approximates the original function. It does so particularly well in the proximity of a certain point x0. (Since my mathematical English jargon is lacking, I strongly suggest you read up on what this is in a book.) Mathematically speaking, the Taylor Polynomial of the function f(x) looks like this: Tn(f, x, x0) = sum_from_k=0_to_n( n-th_total_derivative(f)(x0) / k! * (x-x0)^k ) First argument to the subroutine must be the function to approximate. It may be given either as a string to be parsed or as a valid Math::Symbolic tree. Second argument must be an integer indicating to which degree to approximate. The third argument is the last required argument and denotes the variable to use for approximation either as a string (name) or as a Math::Symbolic::Variable object. That's the 'x' above. The fourth argument is optional and specifies the name of the variable to introduce as the point of approximation. May also be a variable object. It's the 'x0' above. If not specified, the name of this variable will be assumed to be the name of the function variable (the 'x') with '_0' appended. This routine is for functions of one variable only. There is an equivalent for functions of two variables in the Math::Symbolic::VectorCalculus package. =cut sub TaylorPolynomial ($$$;$) { my $func = shift; my $degree = shift; my $var = shift; my $pos = shift; $func = parse_from_string($func) unless ref($func) =~ /^Math::Symbolic/; $var = Math::Symbolic::Variable->new($var) unless ref($var) =~ /^Math::Symbolic::Variable$/; $pos = Math::Symbolic::Variable->new( $var->name() . '_0' ) unless ref($pos) =~ /^Math::Symbolic::Variable$/; my $copy = $func->new(); $copy->implement( $var->name() => $pos ); my $taylor = $copy; return $taylor if $degree == 0; my $diff = Math::Symbolic::Operator->new( '-', $var, $pos ); my $partial = $func->new(); foreach my $d ( 1 .. $degree ) { $partial = Math::Symbolic::Operator->new( 'total_derivative', $partial, $var ); $partial = $partial->apply_derivatives()->simplify(); my $copy = $partial->new()->implement( $var->name() => $pos ); $taylor += Math::Symbolic::Operator->new( '*', Math::Symbolic::Operator->new( '/', $copy, _faculty($d) ), Math::Symbolic::Operator->new( '^', $diff, Math::Symbolic::Constant->new($d) ) ); } return $taylor; } =head2 TaylorErrorLagrange TaylorErrorLagrange computes and returns the formula for the Taylor Polynomial's approximation error after Lagrange. (Again, my English terminology is lacking.) It looks similar to this: Rn(f, x, x0) = n+1-th_total_derivative(f)( x0 + theta * (x-x0) ) / (n+1)! * (x-x0)^(n+1) Please refer to your favourite book on the topic. 'theta' may be any number between 0 and 1. The calling conventions for TaylorErrorLagrange are similar to those of TaylorPolynomial, but TaylorErrorLagrange takes an extra optional argument specifying the name of 'theta'. If it isn't specified explicitly, the variable will be named 'theta' as in the formula above. =cut sub TaylorErrorLagrange ($$$;$$) { my $func = shift; my $degree = shift; my $var = shift; my $pos = shift; my $theta = shift; $func = parse_from_string($func) unless ref($func) =~ /^Math::Symbolic/; $var = Math::Symbolic::Variable->new($var) unless ref($var) =~ /^Math::Symbolic::Variable$/; $pos = Math::Symbolic::Variable->new( $var->name() . '_0' ) unless ref($pos) =~ /^Math::Symbolic::Variable$/; $theta = Math::Symbolic::Variable->new('theta') unless ref($theta) =~ /^Math::Symbolic::Variable$/; my $error = Math::Symbolic::Operator->new( 'total_derivative', $func->new(), $var ); foreach ( 1 .. $degree + 1 ) { $error = Math::Symbolic::Operator->new( 'total_derivative', $error, $var ); $error = $error->apply_derivatives()->simplify(); } # We want to avoid endless recursion at all cost! my @sig = $func->signature(); my $last = $sig[-1] . '_not_taken'; $error->implement( $var->name() => Math::Symbolic::Variable->new($last) ); my $xhi = Math::Symbolic::Operator->new( '+', $pos, Math::Symbolic::Operator->new( '*', $theta, Math::Symbolic::Operator->new( '-', $var, $pos ) ) ); $error->implement( $last => $xhi ); $error = Math::Symbolic::Operator->new( '*', $error, Math::Symbolic::Operator->new( '/', Math::Symbolic::Operator->new( '^', Math::Symbolic::Operator->new( '-', $var, $pos ), Math::Symbolic::Constant->new( $degree + 1 ) ), _faculty( $degree + 1 ) ) ); return $error; } =head2 TaylorErrorCauchy TaylorErrorCauchy computes and returns the formula for the Taylor Polynomial's approximation error after (guess who!) Cauchy. (Again, my English terminology is lacking.) It looks similar to this: Rn(f, x, x0) = TaylorErrorLagrange(...) * (1 - theta)^n Please refer to your favourite book on the topic and the documentation for TaylorErrorLagrange. 'theta' may be any number between 0 and 1. The calling conventions for TaylorErrorCauchy are identical to those of TaylorErrorLagrange. =cut sub TaylorErrorCauchy ($$$;$$) { my $func = shift; my $degree = shift; my $var = shift; my $pos = shift; my $theta = shift; $func = parse_from_string($func) unless ref($func) =~ /^Math::Symbolic/; $var = Math::Symbolic::Variable->new($var) unless ref($var) =~ /^Math::Symbolic::Variable$/; $pos = Math::Symbolic::Variable->new( $var->name() . '_0' ) unless ref($pos) =~ /^Math::Symbolic::Variable$/; $theta = Math::Symbolic::Variable->new('theta') unless ref($theta) =~ /^Math::Symbolic::Variable$/; my $error = TaylorErrorLagrange( $func, $degree, $var, $pos, $theta ); $error = Math::Symbolic::Operator->new( '*', $error, Math::Symbolic::Operator->new( '^', Math::Symbolic::Operator->new( '-', Math::Symbolic::Constant->one(), $theta ), $degree ) ); return $error; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Constant.pm000444001750001750 1634312157534055 21017 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Constant - Constants in symbolic calculations =head1 SYNOPSIS use Math::Symbolic::Constant; my $const = Math::Symbolic::Constant->new(25); my $zero = Math::Symbolic::Constant->zero(); my $one = Math::Symbolic::Constant->one(); my $euler = Math::Symbolic::Constant->euler(); # e = 2.718281828... =head1 DESCRIPTION This module implements numeric constants for Math::Symbolic trees. =head2 EXPORT None by default. =cut package Math::Symbolic::Constant; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic::ExportConstants qw/:all/; use base 'Math::Symbolic::Base'; our $VERSION = '0.612'; =head1 METHODS =cut =head2 Constructor new Takes hash reference of key-value pairs as argument. Special case: a value for the constant instead of the hash. Returns a Math::Symbolic::Constant. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my %args; %args = %{ shift() } if @_ && ref( $_[0] ) eq 'HASH'; my $value = ( @_ && !%args ? shift : $args{value} ); $value = $proto->value() if !defined($value) and ref($proto); croak("Math::Symbolic::Constant created with undefined value!") if not defined($value); my $self = { special => '', ( ref($proto) ? %$proto : () ), value => $value, %args, }; bless $self => $class; } =head2 Constructor zero Arguments are treated as key-value pairs of object attributes. Returns a Math::Symbolic::Constant with value of 0. =cut sub zero { my $proto = shift; my $class = ref($proto) || $proto; croak("Uneven number of arguments to zero()") if @_ % 2; return( bless {@_, value => 0, special => 'zero' } => $class ); # return $class->new( { @_, value => 0, special => 'zero' } ); } =head2 Constructor one Arguments are treated as key-value pairs of object attributes. Returns a Math::Symbolic::Constant with value of 1. =cut sub one { my $proto = shift; my $class = ref($proto) || $proto; croak("Uneven number of arguments to one()") if @_ % 2; return( bless {@_, value => 1, special => 'one' } => $class ); #return $class->new( { @_, value => 1 } ); } =head2 Constructor euler Arguments are treated as key-value pairs of object attributes. Returns a Math::Symbolic::Constant with value of e, the Euler number. The object has its 'special' attribute set to 'euler'. =cut sub euler { my $proto = shift; my $class = ref($proto) || $proto; croak("Uneven number of arguments to euler()") if @_ % 2; return( bless {@_, value => EULER, special => 'euler' } => $class ); #return $class->new( { @_, value => EULER, special => 'euler' } ); } =head2 Constructor pi Arguments are treated as key-value pairs of object attributes. Returns a Math::Symbolic::Constant with value of pi. The object has its 'special' attribute set to 'pi'. =cut sub pi { my $proto = shift; my $class = ref($proto) || $proto; croak("Uneven number of arguments to pi()") if @_ % 2; return( bless {@_, value => PI, special => 'pi' } => $class ); #return $class->new( { @_, value => PI, special => 'pi' } ); } =head2 Method value value() evaluates the Math::Symbolic tree to its numeric representation. value() without arguments requires that every variable in the tree contains a defined value attribute. Please note that this refers to every variable I, not just every named variable. value() with one argument sets the object's value if you're dealing with Variables or Constants. In case of operators, a call with one argument will assume that the argument is a hash reference. (see next paragraph) value() with named arguments (key/value pairs) associates variables in the tree with the value-arguments if the corresponging key matches the variable name. (Can one say this any more complicated?) Since version 0.132, an equivalent and valid syntax is to pass a single hash reference instead of a list. Example: $tree->value(x => 1, y => 2, z => 3, t => 0) assigns the value 1 to any occurrances of variables of the name "x", aso. If a variable in the tree has no value set (and no argument of value sets it temporarily), the call to value() returns undef. =cut sub value { my $self = shift; if ( @_ == 1 and not ref( $_[0] ) eq 'HASH' ) { croak "Constant assigned undefined value!" if not defined $_[0]; $self->{value} = $_[0]; $self->{special} = undef; # !!!FIXME!!! one day, this # needs better handling. } return $self->{value}; } =head2 Method signature signature() returns a tree's signature. In the context of Math::Symbolic, signatures are the list of variables any given tree depends on. That means the tree "v*t+x" depends on the variables v, t, and x. Thus, applying signature() on the tree that would be parsed from above example yields the sorted list ('t', 'v', 'x'). Constants do not depend on any variables and therefore return the empty list. Obviously, operators' dependencies vary. Math::Symbolic::Variable objects, however, may have a slightly more involved signature. By convention, Math::Symbolic variables depend on themselves. That means their signature contains their own name. But they can also depend on various other variables because variables themselves can be viewed as placeholders for more compicated terms. For example in mechanics, the acceleration of a particle depends on its mass and the sum of all forces acting on it. So the variable 'acceleration' would have the signature ('acceleration', 'force1', 'force2',..., 'mass', 'time'). If you're just looking for a list of the names of all variables in the tree, you should use the explicit_signature() method instead. =cut sub signature { return (); } =head2 Method explicit_signature explicit_signature() returns a lexicographically sorted list of variable names in the tree. See also: signature(). =cut sub explicit_signature { return (); } =head2 Method special Optional argument: sets the object's special attribute. Returns the object's special attribute. =cut sub special { my $self = shift; $self->{special} = shift if @_; return $self->{special}; } =head2 Method to_string Returns a string representation of the constant. =cut sub to_string { my $self = shift; return $self->value(); } =head2 Method term_type Returns the type of the term. (T_CONSTANT) =cut sub term_type { T_CONSTANT } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Derivative.pm000444001750001750 5007012157534055 21323 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Derivative - Derive Math::Symbolic trees =head1 SYNOPSIS use Math::Symbolic::Derivative qw/:all/; $derived = partial_derivative($term, $variable); # or: $derived = total_derivative($term, $variable); =head1 DESCRIPTION This module implements derivatives for Math::Symbolic trees. Derivatives are Math::Symbolic::Operators, but their implementation is drawn from this module because it is significantly more complex than the implementation of most operators. Derivatives come in two flavours. There are partial- and total derivatives. Explaining the precise difference between partial- and total derivatives is beyond the scope of this document, but in the context of Math::Symbolic, the difference is simply that partial derivatives just derive in terms of I dependency on the differential variable while total derivatives recongnize implicit dependencies from variable signatures. Partial derivatives are faster, have been tested more thoroughly, and are probably what you want for simpler applications anyway. =head2 EXPORT None by default. But you may choose to import the total_derivative() and partial_derivative() functions. =cut package Math::Symbolic::Derivative; use 5.006; use strict; use warnings; no warnings 'recursion'; use Carp; use Math::Symbolic::ExportConstants qw/:all/; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( &total_derivative &partial_derivative ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.612'; =head1 CLASS DATA The package variable %Partial_Rules contains partial derivative rules as key-value pairs of names and subroutines. =cut # lookup-table for derivative rules for various operators. our %Rules = ( 'each operand' => \&_each_operand, 'product rule' => \&_product_rule, 'quotient rule' => \&_quotient_rule, 'logarithmic chain rule after ln' => \&_logarithmic_chain_rule_after_ln, 'logarithmic chain rule' => \&_logarithmic_chain_rule, 'derivative commutation' => \&_derivative_commutation, 'trigonometric derivatives' => \&_trigonometric_derivatives, 'inverse trigonometric derivatives' => \&_inverse_trigonometric_derivatives, 'inverse atan2' => \&_inverse_atan2, ); # References to derivative subroutines # Will be assigned a reference after subroutine compilation. our $Partial_Sub; our $Total_Sub; our @Constant_Simplify = ( # B_SUM sub { my $tree = shift; my ($op1, $op2) = @{$tree->{operands}}; my ($t1, $t2) = ($op1->term_type(), $op2->term_type()); if ($t1 == T_CONSTANT) { return $op2 if $op1->{value} == 0; if ($t2 == T_CONSTANT) { return Math::Symbolic::Constant->new($op1->{value} + $op2->{value}); } } elsif ($t2 == T_CONSTANT) { return $op1 if $op2->{value} == 0; } return $tree; }, # B_DIFFERENCE sub { my $tree = shift; my ($op1, $op2) = @{$tree->{operands}}; my ($t1, $t2) = ($op1->term_type(), $op2->term_type()); if ($t1 == T_CONSTANT) { $op2 *= -1, return $op2 if $op1->{value} == 0; if ($t2 == T_CONSTANT) { return Math::Symbolic::Constant->new($op1->{value} - $op2->{value}); } } elsif ($t2 == T_CONSTANT) { return $op1 if $op2->{value} == 0; $op2->{value} *= -1; return Math::Symbolic::Operator->new('+', $op1, $op2); } return $tree; }, # B_PRODUCT undef, # implemented inline # B_DIVISION undef, # not implemented # U_MINUS sub { my $tree = shift; my $op = $tree->{operands}[0]; if ($op->term_type == T_CONSTANT) { return Math::Symbolic::Constant->new(-$op->{value}); } return $tree; }, #... not implemented ); =begin comment The following subroutines are helper subroutines that apply a specific rule to a tree. =end comment =cut sub _each_operand { my ( $tree, $var, $cloned, $d_sub ) = @_; foreach ( @{ $tree->{operands} } ) { $_ = $d_sub->( $_, $var, 1 ); } my $type = $tree->type(); my $simplifier = $Constant_Simplify[$type]; return $simplifier->($tree) if $simplifier; return $tree; } sub _product_rule { my ( $tree, $var, $cloned, $d_sub ) = @_; my $ops = $tree->{operands}; my ($o1, $o2) = @$ops; my ($to1, $to2) = ($o1->term_type(), $o2->term_type()); # one of the terms is a constant, don't derive it if ($to1 == T_CONSTANT) { return Math::Symbolic::Constant->zero() if $o1->{value} == 0; my $deriv = $d_sub->( $o2, $var, 0 ); return $deriv if $o1->{value} == 0; return Math::Symbolic::Constant->new($deriv->{value}*$o1->{value}) if $deriv->term_type == T_CONSTANT; } if ($to2 == T_CONSTANT) { return Math::Symbolic::Constant->zero() if $o2->{value} == 0; my $deriv = $d_sub->( $o1, $var, 0 ); return $deriv if $o2->{value} == 0; return Math::Symbolic::Constant->new($deriv->{value}*$o2->{value}) if $deriv->term_type == T_CONSTANT; } my $do1 = $d_sub->( $o1, $var, 0 ); my $do2 = $d_sub->( $o2, $var, 0 ); my ($tdo1, $tdo2) = ($do1->term_type(), $do2->term_type()); my ($m1, $m2); # check for const*const if ($tdo1 == T_CONSTANT) { if ($to2 == T_CONSTANT) { $m1 = $do1->new($o2->{value} * $do1->{value}); # const } elsif ($do1->{value} == 0) { $m1 = $do1->zero(); # 0 } elsif ($do1->{value} == 1) { $m1 = $o2; } else { $m1 = $do1*$o2; # c*tree } } else { $m1 = $o2*$do1; } if ($tdo2 == T_CONSTANT) { if ($to1 == T_CONSTANT) { $m2 = $do2->new($o1->{value} * $do2->{value}); # const } elsif ($do2->{value} == 0) { $m2 = $do2->zero(); # 0 } elsif ($do2->{value} == 1) { $m2 = $o1; } else { $m2 = $do2*$o1; # c*tree } } else { $m2 = $o1*$do2; } # 0's or 2 consts in + if ($m1->term_type == T_CONSTANT) { return $m2 if $m1->{value} == 0; if ($m2->term_type == T_CONSTANT) { return $m2->new($m1->{value}*$m2->{value}); } } elsif ($m2->term_type == T_CONSTANT) { return $m1 if $m2->{value} == 0; } return Math::Symbolic::Operator->new( '+', $m1, $m2 ); } sub _quotient_rule { my ( $tree, $var, $cloned, $d_sub ) = @_; my ($op1, $op2) = @{$tree->{operands}}; my ($do1, $do2); # y = f(x)/c; y' = f'/c if ($op2->is_simple_constant()) { $do1 = $d_sub->( $op1, $var, 0 ); my $val = $op2->value(); if ($val == 0) { return $tree->new('/', $do1, $op2->new()); # inf! } elsif ($val == 1) { return $do1; # f/1 } return $tree->new('*', Math::Symbolic::Constant->new(1/$val), $do1); } # y = c/f(x) => y' = -c*f'(x)/f^2(x) elsif ($op1->is_simple_constant()) { $do2 = $d_sub->( $op2, $var, 0 ); my $val = $op1->value(); if ($val == 0) { return Math::Symbolic::Constant->zero(); # 0*f'/f } my $tdo2 = $do2->term_type(); if ($tdo2 == T_CONSTANT) { return $do2->zero() if $do2->{value} == 0; # c*0/f return $tree->new( '/', $do2->new(-1.*$val*$do2->{value}), $tree->new('^', $op2, 2) ); } else { return $tree->new( '*', Math::Symbolic::Constant->new(-1*$val), $tree->new('/', $do2, $tree->new('^', $op2, Math::Symbolic::Constant->new(2))) ) } } $do1 = $d_sub->( $op1, $var, 0 ) if not $do1; $do2 = $d_sub->( $op2, $var, 0 ) if not $do2; my $m1 = Math::Symbolic::Operator->new( '*', $do1, $op2 ); my $m2 = Math::Symbolic::Operator->new( '*', $op1, $do2 ); # f' = 0 if ($do1->is_zero()) { $m1 = undef; } # f' = 1 elsif ($do1->is_one()) { $m1 = $op2->new(); } # g' = 0 if ($do2->is_zero()) { $m2 = undef; } elsif ($do2->is_one()) { $m2 = $op1->new(); } my $upper; # -g'f / g^2 if (not defined $m1) { # f'=g'=0 return Math::Symbolic::Constant->zero() if not defined $m2; $upper = $tree->new('neg', $m2); } # f'g / g^2 = f'/g elsif (not defined $m2) { return $tree->new('/', $do1, $op2); } my $m3 = $tree->new('^', $op2, Math::Symbolic::Constant->new(2)); if (not defined $upper) { $upper = Math::Symbolic::Operator->new( '-', $m1, $m2 ); } return Math::Symbolic::Operator->new( '/', $upper, $m3 ); } sub _logarithmic_chain_rule_after_ln { my ( $tree, $var, $cloned, $d_sub ) = @_; # y(x)=u^v # y'(x)=y*(d/dx ln(y)) # y'(x)=y*(d/dx (v*ln(u))) my ($u, $v) = @{$tree->{operands}}; # This is a special case: # y(x)=u^CONST # y'(x)=CONST*y* d/dx ln(u) # y'(x)=CONST*y* u' / u if ($v->term_type() == T_CONSTANT) { # y=VAR^CONST if ($u->term_type() == T_VARIABLE) { my $d = $d_sub->($u, $var, 0); my $dtt = $d->term_type(); if ($dtt == T_CONSTANT) { # not our var return Math::Symbolic::Constant->zero() if $d->{value} == 0; # our var return Math::Symbolic::Constant->one() if $v->{value} == 1; return $tree->new('*', $v->new(), $u->new()) if $v->{value} == 2; return $tree->new('*', $v->new(), $tree->new('^', $u->new(), $v->new($v->{value}-1))); } # otherwise: signature contains $var } return Math::Symbolic::Operator->new( '*', Math::Symbolic::Operator->new( '*', $v->new(), $tree ), Math::Symbolic::Operator->new( '/', $d_sub->($u, $var, 0), $u->new() ) ); } my $e = Math::Symbolic::Constant->euler(); my $ln = Math::Symbolic::Operator->new( 'log', $e, $u ); my $mul1 = $ln->new( '*', $v, $ln ); my $dmul = $d_sub->( $mul1, $var, 0 ); $tree = $ln->new( '*', $tree, $dmul ); return $tree; } sub _logarithmic_chain_rule { my ( $tree, $var, $cloned, $d_sub ) = @_; #log_a(y(x))=>y'(x)/(ln(a)*y(x)) my ($a, $y) = @{$tree->{operands}}; my $dy = $d_sub->( $y, $var, 0 ); # This would be y'/y if ($a->term_type() == T_CONSTANT and $a->{special} eq 'euler') { return Math::Symbolic::Operator->new('/', $dy, $y); } my $e = Math::Symbolic::Constant->euler(); my $ln = Math::Symbolic::Operator->new( 'log', $e, $a ); my $mul1 = $ln->new( '*', $ln, $y->new() ); $tree = $ln->new( '/', $dy, $mul1 ); return $tree; } sub _derivative_commutation { my ( $tree, $var, $cloned, $d_sub ) = @_; $tree->{operands}[0] = $d_sub->( $tree->{operands}[0], $var, 0 ); return $tree; } sub _trigonometric_derivatives { my ( $tree, $var, $cloned, $d_sub ) = @_; my $op = Math::Symbolic::Operator->new(); my $d_inner = $d_sub->( $tree->{operands}[0], $var, 0 ); my $trig; my $type = $tree->type(); if ( $type == U_SINE ) { $trig = $op->new( 'cos', $tree->{operands}[0] ); } elsif ( $type == U_COSINE ) { $trig = $op->new( 'neg', $op->new( 'sin', $tree->{operands}[0] ) ); } elsif ( $type == U_SINE_H ) { $trig = $op->new( 'cosh', $tree->{operands}[0] ); } elsif ( $type == U_COSINE_H ) { $trig = $op->new( 'sinh', $tree->{operands}[0] ); } elsif ( $type == U_TANGENT or $type == U_COTANGENT ) { $trig = $op->new( '/', Math::Symbolic::Constant->one(), $op->new( '^', $op->new( 'cos', $tree->op1() ), Math::Symbolic::Constant->new(2) ) ); $trig = $op->new( 'neg', $trig ) if $type == U_COTANGENT; } else { die "Trigonometric derivative applied to invalid operator."; } if ($d_inner->term_type() == T_CONSTANT) { my $spec = $d_inner->special(); if ($spec eq 'zero') { return $d_inner; } elsif ($spec eq 'one') { return $trig; } } return $op->new( '*', $d_inner, $trig ); } sub _inverse_trigonometric_derivatives { my ( $tree, $var, $cloned, $d_sub ) = @_; my $op = Math::Symbolic::Operator->new(); my $d_inner = $d_sub->( $tree->{operands}[0], $var, 0 ); my $trig; my $type = $tree->type(); if ( $type == U_ARCSINE or $type == U_ARCCOSINE ) { my $one = $type == U_ARCSINE ? Math::Symbolic::Constant->one() : Math::Symbolic::Constant->new(-1); $trig = $op->new( '/', $one, $op->new( '-', $one->new(1), $op->new( '^', $tree->op1(), $one->new(2) ) ) ); } elsif ($type == U_ARCTANGENT or $type == U_ARCCOTANGENT ) { my $one = $type == U_ARCTANGENT ? Math::Symbolic::Constant->one() : Math::Symbolic::Constant->new(-1); $trig = $op->new( '/', $one, $op->new( '+', $one->new(1), $op->new( '^', $tree->op1(), $one->new(2) ) ) ); } elsif ($type == U_AREASINE_H or $type == U_AREACOSINE_H ) { my $one = Math::Symbolic::Constant->one(); $trig = $op->new( '/', $one, $op->new( '^', $op->new( ( $tree->type() == U_AREASINE_H ? '+' : '-' ), $op->new( '^', $tree->op1(), $one->new(2) ), $one ), $one->new(0.5) ) ); } else { die "Inverse trig. derivative applied to invalid operator."; } if ($d_inner->term_type() == T_CONSTANT) { my $spec = $d_inner->special(); if ($spec eq 'zero') { return $d_inner; } elsif ($spec eq 'one') { return $trig; } } return $op->new( '*', $d_inner, $trig ); } sub _inverse_atan2 { my ( $tree, $var, $cloned, $d_sub ) = @_; # d/df atan(y/x) = x^2/(x^2+y^2) * (d/df y/x) my ($op1, $op2) = @{$tree->{operands}}; my $inner = $d_sub->( $op1->new()/$op2->new(), $var, 0 ); # templates my $two = Math::Symbolic::Constant->new(2); my $op = Math::Symbolic::Operator->new('+', $two, $two); my $result = $op->new('*', $op->new('/', $op->new('^', $op2->new(), $two->new()), $op->new( '+', $op->new('^', $op2->new(), $two->new()), $op->new('^', $op1->new(), $two->new()) ) ), $inner ); return $result; } =head1 SUBROUTINES =cut =head2 partial_derivative Takes a Math::Symbolic tree and a Math::Symbolic::Variable as argument. third argument is an optional boolean indicating whether or not the tree has to be cloned before being derived. If it is true, the subroutine happily stomps on any code that might rely on any components of the Math::Symbolic tree that was passed to the sub as first argument. =cut sub partial_derivative { my $tree = shift; my $var = shift; defined $var or die "Cannot derive using undefined variable."; if ( ref($var) eq '' ) { $var = Math::Symbolic::parse_from_string($var); croak "2nd argument to partial_derivative must be variable." if ( ref($var) ne 'Math::Symbolic::Variable' ); } else { croak "2nd argument to partial_derivative must be variable." if ( ref($var) ne 'Math::Symbolic::Variable' ); } my $cloned = shift; if ( not $cloned ) { $tree = $tree->new(); $cloned = 1; } if ( $tree->term_type() == T_OPERATOR ) { my $rulename = $Math::Symbolic::Operator::Op_Types[ $tree->type() ]->{derive}; my $subref = $Rules{$rulename}; die "Cannot derive using rule '$rulename'." unless defined $subref; $tree = $subref->( $tree, $var, $cloned, $Partial_Sub ); } elsif ( $tree->term_type() == T_CONSTANT ) { $tree = Math::Symbolic::Constant->zero(); } elsif ( $tree->term_type() == T_VARIABLE ) { if ( $tree->name() eq $var->name() ) { $tree = Math::Symbolic::Constant->one; } else { $tree = Math::Symbolic::Constant->zero; } } else { die "Cannot apply partial derivative to anything but a tree."; } return $tree; } =head2 total_derivative Takes a Math::Symbolic tree and a Math::Symbolic::Variable as argument. third argument is an optional boolean indicating whether or not the tree has to be cloned before being derived. If it is true, the subroutine happily stomps on any code that might rely on any components of the Math::Symbolic tree that was passed to the sub as first argument. =cut sub total_derivative { my $tree = shift; my $var = shift; defined $var or die "Cannot derive using undefined variable."; if ( ref($var) eq '' ) { $var = Math::Symbolic::parse_from_string($var); croak "Second argument to total_derivative must be variable." if ( ref($var) ne 'Math::Symbolic::Variable' ); } else { croak "Second argument to total_derivative must be variable." if ( ref($var) ne 'Math::Symbolic::Variable' ); } my $cloned = shift; if ( not $cloned ) { $tree = $tree->new(); $cloned = 1; } if ( $tree->term_type() == T_OPERATOR ) { my $var_name = $var->name(); my @tree_sig = $tree->signature(); if ( ( grep { $_ eq $var_name } @tree_sig ) > 0 ) { my $rulename = $Math::Symbolic::Operator::Op_Types[ $tree->type() ]->{derive}; my $subref = $Rules{$rulename}; die "Cannot derive using rule '$rulename'." unless defined $subref; $tree = $subref->( $tree, $var, $cloned, $Total_Sub ); } else { $tree = Math::Symbolic::Constant->zero(); } } elsif ( $tree->term_type() == T_CONSTANT ) { $tree = Math::Symbolic::Constant->zero(); } elsif ( $tree->term_type() == T_VARIABLE ) { my $name = $tree->name(); my $var_name = $var->name(); if ( $name eq $var_name ) { $tree = Math::Symbolic::Constant->one; } else { my @tree_sig = $tree->signature(); my $is_dependent; foreach my $ident (@tree_sig) { if ( $ident eq $var_name ) { $is_dependent = 1; last; } } if ( $is_dependent ) { $tree = Math::Symbolic::Operator->new( 'total_derivative', $tree, $var ); } else { $tree = Math::Symbolic::Constant->zero; } } } else { die "Cannot apply total derivative to anything but a tree."; } return $tree; } # Class data again. $Partial_Sub = \&partial_derivative; $Total_Sub = \&total_derivative; 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Variable.pm000444001750001750 1514512157534055 20752 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Variable - Variable in symbolic calculations =head1 SYNOPSIS use Math::Symbolic::Variable; my $var1 = Math::Symbolic::Variable->new('name'); $var1->value(5); my $var2 = Math::Symbolic::Variable->new('x', 2); my $var3 = Math::Symbolic::Variable->new( { name => 'variable', value => 1, } ); =head1 DESCRIPTION This class implements variables for Math::Symbolic trees. The objects are overloaded in stringification context to return their names. =head2 EXPORT None by default. =cut package Math::Symbolic::Variable; use 5.006; use strict; use warnings; use Math::Symbolic::ExportConstants qw/:all/; use base 'Math::Symbolic::Base'; our $VERSION = '0.612'; =head1 METHODS =head2 Constructor new First argument is expected to be a hash reference of key-value pairs which will be used as object attributes. In particular, a variable is required to have a 'name'. Optional arguments include a 'value', and a 'signature'. The value expected for the signature key is a reference to an array of identifiers. Special case: First argument is not a hash reference. In this case, first argument is treated as variable name, second as value. This special case disallows cloning of objects (when used as object method). Returns a Math::Symbolic::Variable. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; if ( @_ == 1 and ref( $_[0] ) eq 'Math::Symbolic::Variable' ) { return $_[0]->new(); } elsif ( @_ and not ref( $_[0] ) eq 'HASH' ) { my $name = shift; my $value = shift; return bless { name => $name, value => $value, signature => [@_] } => $class; } my $self = { value => undef, name => undef, signature => [], ( ref($proto) ? %$proto : () ), ((@_ and ref($_[0]) eq 'HASH') ? %{$_[0]} : ()), }; bless $self => $class; } =head2 Method value value() evaluates the Math::Symbolic tree to its numeric representation. value() without arguments requires that every variable in the tree contains a defined value attribute. Please note that this refers to every variable I, not just every named variable. value() with one argument sets the object's value if you're dealing with Variables or Constants. In case of operators, a call with one argument will assume that the argument is a hash reference. (see next paragraph) value() with named arguments (key/value pairs) associates variables in the tree with the value-arguments if the corresponging key matches the variable name. (Can one say this any more complicated?) Since version 0.132, an equivalent and valid syntax is to pass a single hash reference instead of a list. Example: $tree->value(x => 1, y => 2, z => 3, t => 0) assigns the value 1 to any occurrances of variables of the name "x", aso. If a variable in the tree has no value set (and no argument of value sets it temporarily), the call to value() returns undef. =cut sub value { my $self = shift; if ( @_ == 0 ) { return $self->{value}; } elsif ( @_ == 1 and not ref( $_[0] ) eq 'HASH' ) { $self->{value} = shift; return $self->{value}; } else { my $args = ( @_ == 1 ? $_[0] : +{@_} ); if ( exists $args->{ $self->{name} } ) { return $args->{ $self->{name} }; } else { return $self->{value}; } } die "Sanity check in Math::Symbolic::Variable::value()"; } =head2 Method name Optional argument: sets the object's name. Returns the object's name. =cut sub name { my $self = shift; $self->{name} = shift if @_; return $self->{name}; } =head2 Method signature signature() returns a tree's signature. In the context of Math::Symbolic, signatures are the list of variables any given tree depends on. That means the tree "v*t+x" depends on the variables v, t, and x. Thus, applying signature() on the tree that would be parsed from above example yields the sorted list ('t', 'v', 'x'). Constants do not depend on any variables and therefore return the empty list. Obviously, operators' dependencies vary. Math::Symbolic::Variable objects, however, may have a slightly more involved signature. By convention, Math::Symbolic variables depend on themselves. That means their signature contains their own name. But they can also depend on various other variables because variables themselves can be viewed as placeholders for more compicated terms. For example in mechanics, the acceleration of a particle depends on its mass and the sum of all forces acting on it. So the variable 'acceleration' would have the signature ('acceleration', 'force1', 'force2',..., 'mass', 'time'). If you're just looking for a list of the names of all variables in the tree, you should use the explicit_signature() method instead. =cut sub signature { my $self = shift; my $sig = [ @{ $self->{signature} } ]; # copying it push @$sig, $self->{name}; # Make things unique, then sort and return. return sort keys %{ { map { ( $_, undef ) } @$sig } }; } =head2 Method explicit_signature explicit_signature() returns a lexicographically sorted list of variable names in the tree. See also: signature(). =cut sub explicit_signature { return $_[0]->{name}; } =head2 Method set_signature set_signature expects any number of variable identifiers as arguments. It sets a variable's signature to this list of identifiers. =cut sub set_signature { my $self = shift; @{ $self->{signature} } = @_; return (); } =head2 Method to_string Returns a string representation of the variable. =cut sub to_string { my $self = shift; return $self->name(); } =head2 Method term_type Returns the type of the term. (T_VARIABLE) =cut sub term_type { return T_VARIABLE; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Base.pm000444001750001750 5624412157534055 20104 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Base - Base class for symbols in symbolic calculations =head1 SYNOPSIS use Math::Symbolic::Base; =head1 DESCRIPTION This is a base class for all Math::Symbolic::* terms such as Math::Symbolic::Operator, Math::Symbolic::Variable and Math::Symbolic::Constant objects. =head2 EXPORT None by default. =cut package Math::Symbolic::Base; use 5.006; use strict; use warnings; no warnings 'recursion'; use Carp; use overload "+" => \&_overload_addition, "-" => \&_overload_subtraction, "*" => \&_overload_multiplication, "/" => \&_overload_division, "**" => \&_overload_exponentiation, "sqrt" => \&_overload_sqrt, "log" => \&_overload_log, "exp" => \&_overload_exp, "sin" => \&_overload_sin, "cos" => \&_overload_cos, '""' => sub { $_[0]->to_string() }, "0+" => sub { $_[0]->value() }, "bool" => sub { $_[0]->value() }; use Math::Symbolic::ExportConstants qw/:all/; our $VERSION = '0.612'; our $AUTOLOAD; =head1 METHODS =cut =head2 Method to_string Default method for stringification just returns the object's value. =cut sub to_string { my $self = shift; return $self->value(); } =head2 Method value value() evaluates the Math::Symbolic tree to its numeric representation. value() without arguments requires that every variable in the tree contains a defined value attribute. Please note that this refers to every variable I, not just every named variable. value() with one argument sets the object's value (in case of a variable or constant). value() with named arguments (key/value pairs) associates variables in the tree with the value-arguments if the corresponging key matches the variable name. (Can one say this any more complicated?) Since version 0.132, an alternative syntax is to pass a single hash reference. Example: $tree->value(x => 1, y => 2, z => 3, t => 0) assigns the value 1 to any occurrances of variables of the name "x", aso. If a variable in the tree has no value set (and no argument of value sets it temporarily), the call to value() returns undef. =cut sub value { croak "This is a method stub from Math::Symbolic::Base. Implement me."; } =head2 Method signature signature() returns a tree's signature. In the context of Math::Symbolic, signatures are the list of variables any given tree depends on. That means the tree "v*t+x" depends on the variables v, t, and x. Thus, applying signature() on the tree that would be parsed from above example yields the sorted list ('t', 'v', 'x'). Constants do not depend on any variables and therefore return the empty list. Obviously, operators' dependencies vary. Math::Symbolic::Variable objects, however, may have a slightly more involved signature. By convention, Math::Symbolic variables depend on themselves. That means their signature contains their own name. But they can also depend on various other variables because variables themselves can be viewed as placeholders for more compicated terms. For example in mechanics, the acceleration of a particle depends on its mass and the sum of all forces acting on it. So the variable 'acceleration' would have the signature ('acceleration', 'force1', 'force2',..., 'mass', 'time'). If you're just looking for a list of the names of all variables in the tree, you should use the explicit_signature() method instead. =cut sub signature { croak "signature() implemented in the inheriting classes."; } =head2 Method explicit_signature explicit_signature() returns a lexicographically sorted list of variable names in the tree. See also: signature(). =cut sub explicit_signature { croak "explicit_signature() implemented in the inheriting classes."; } =head2 Method set_signature set_signature expects any number of variable identifiers as arguments. It sets a variable's signature to this list of identifiers. =cut sub set_signature { croak "Cannot set signature of non-Variable Math::Symbolic tree element."; } =head2 Method implement implement() works in-place! Takes key/value pairs as arguments. The keys are to be variable names and the values must be valid Math::Symbolic trees. All occurrances of the variables will be replaced with their implementation. =cut sub implement { my $self = shift; my %args = @_; return $self->descend( in_place => 1, after => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_VARIABLE ) { my $name = $tree->name(); if ( exists $args{$name} and defined $args{$name} ) { $args{$name} = Math::Symbolic::parse_from_string( $args{$name} ) unless ref( $args{$name} ); $tree->replace( $args{$name} ); } } elsif ( $ttype == T_OPERATOR or $ttype == T_CONSTANT ) { } else { croak "'implement' called on invalid term " . "type."; } }, operand_finder => sub { return $_[0]->descending_operands('all_vars'); }, ); } =head2 Method replace First argument must be a valid Math::Symbolic tree. replace() modifies the object it is called on in-place in that it replaces it with its first argument. Doing that, it retains the original object reference. This destroys the object it is called on. However, this also means that you can create recursive trees of objects if the new tree is to contain the old tree. So make sure you clone the old tree using the new() method before using it in the replacement tree or you will end up with a program that eats your memory fast. =cut sub replace { my $tree = shift; my $new = shift; %$tree = %$new; bless $tree => ref $new; return $tree; } =head2 fill_in_vars This method returns a modified copy of the tree it was called on. It walks the tree and replaces all variables whose value attribute is defined (either done at the time of object creation or using set_value()) with the corresponding constant objects. Variables whose value is not defined are unaffected. Take, for example, the following code: $tree = parse_from_string('a*b+a*c'); $tree->set_value(a => 4, c => 10); # value of b still not defined. print $tree->fill_in_vars(); # prints "(4 * b) + (4 * 10)" =cut sub fill_in_vars { my $self = shift; return $self->descend( in_place => 0, before => sub { my $term = shift; if ( $term->term_type() == T_VARIABLE and defined $term->{value} ) { $term->replace( Math::Symbolic::Constant->new( $term->{value} ) ); } return (); }, ); } =head2 Method simplify Minimum method for term simpilification just clones. =cut sub simplify { my $self = shift; return $self->new(); } =head2 Method descending_operands When called on an operator, descending_operands tries hard to determine which operands to descend into. (Which usually means all operands.) A list of these is returned. When called on a constant or a variable, it returns the empty list. Of course, some routines may have to descend into different branches of the Math::Symbolic tree, but this routine returns the default operands. The first argument to this method may control its behaviour. If it is any of the following key-words, behaviour is modified accordingly: default -- obvious. Use default heuristics. These are all supersets of 'default': all -- returns ALL operands. Use with caution. all_vars -- returns all operands that may contain vars. =cut sub descending_operands { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT or $ttype == T_VARIABLE ) { return (); } elsif ( $ttype == T_OPERATOR ) { my $action = shift || 'default'; my $type = $tree->type(); if ( $action eq 'all' ) { return @{ $tree->{operands} }; } elsif ( $action eq 'all_vars' ) { return @{ $tree->{operands} }; } else { # default if ( $type == U_P_DERIVATIVE or $type == U_T_DERIVATIVE ) { return $tree->{operands}[0]; } else { return @{ $tree->{operands} }; } } } else { croak "'descending_operands' called on invalid term type."; } die "Sanity check in 'descending_operands'. Should not be reached."; } =head2 Method descend The method takes named arguments (key/value pairs). descend() descends (Who would have guessed?) into the Math::Symbolic tree recursively and for each node, it calls code references with a copy of the current node as argument. The copy may be modified and will be used for construction of the returned tree. The automatic copying behaviour may be turned off. Returns a (modified) copy of the original tree. If in-place modification is turned on, the returned tree will not be a copy. Available parameters are: =over 2 =item before A code reference to be used as a callback that will be invoked before descent. Depending on whether or not the "in_place" option is set, the callback will be passed a copy of the current node (default) or the original node itself. The callback may modify the tree node and the modified node will be used to construct descend()'s return value. The return value of this callback describes the way descend() handles the descent into the current node's operands. If it returns the empty list, the (possibly modified) copy of the current that was passed to the callback is used as the return value of descend(), but the recursive descent is continued for all of the current node's operands which may or may not be modified by the callback. The "after" callback will be called on the node after descent into the operands. (This is the normal behavior.) If the callback returns undef, the descent is stopped for the current branch and an exact copy of the current branch's children will be used for descend()'s return value. The "after" callback will be called immediately. If the callback returns a list of integers, these numbers are assumed to be the indexes of the current node's operands that are to be descended into. That means if the callback returns (1), descend will be called for the second operand and only the second. All other children/operands will be cloned. As usual, the "after" callback will be called after descent. Any other return lists will lead to hard-to-debug errors. Tough luck. Returning a hash reference from the callback allows for complete control over the descend() routine. The hash may contain the following elements: =over 2 =item operands This is a referenced array that will be put in place of the previous operands. It is the callback's job to make sure the number of operands stays correct. The "operands" entry is evaluated I the "descend_into" entry. =item descend_into This is a referenced array of integers and references. The integers are assumed to be indices of the array of operands. Returning (1) results in descent into the second operand and only the second. References are assumed to be operands to descend into. descend() will be directly called on them. If the array is empty, descend() will act just as if an empty list had been returned. =item in_place Boolean indicating whether or not to modify the operands in-place or not. If this is true, descend() will be called with the "in_place => 1" parameter. If false, it will be called with "in_place => 0" instead. Defaults to false. (Cloning) This does not affect the call to the "after" callback but only the descent into operands. =item skip_after If this option exists and is set to true, the "after" callback will not be invoked. This only applies to the current node, not to its children/operands. =back The list of options may grow in future versions. =item after This is a code reference which will be invoked as a callback after the descent into the operands. =item in_place Controls whether or not to modify the current tree node in-place. Defaults to false - cloning. =item operand_finder This option controls how the descend routine chooses which operands to recurse into by default. That means it controls which operands descend() recurses into if the 'before' routine returned the empty list or if no 'before' routine was specified. The option may either be a code reference or a string. If it is a code reference, this code reference will be called with the current node as argument. If it is a string, the method with that name will be called on the current node object. By default, descend() calls the 'descending_operands()' method on the current node to determine the operands to descend into. =back =cut sub descend { my ( $tree, %args ) = @_; $tree = $tree->new() unless exists $args{in_place} and $args{in_place}; my @opt; # Will be used at several locations inside this routine. my $operand_finder = sub { if ( exists $args{operand_finder} ) { my $op_f = $args{operand_finder}; return $tree->$op_f() if not ref $op_f; croak "Invalid 'operand_finder' option passed to " . "descend() routine." if not ref($op_f) eq 'CODE'; return $op_f->($tree); } else { return $tree->descending_operands(); } }; if ( exists $args{before} ) { croak "'before' parameter to descend() must be code reference." unless ref( $args{before} ) eq 'CODE'; @opt = $args{before}->($tree); } if ( exists $args{after} and ref( $args{after} ) ne 'CODE' ) { croak "'after' parameter to descend() must be code reference."; } my $has_control = ( @opt == 1 && ref( $opt[0] ) eq 'HASH' ? 1 : 0 ); my $ttype = $tree->term_type(); # Do nothing! if ( $ttype != T_OPERATOR ) { } # Fine control! elsif ($has_control) { my $opt = $opt[0]; my %new_args = %args; $new_args{in_place} = $opt->{in_place} if exists $opt->{in_place}; if ( exists $opt->{operands} ) { croak "'operands' return value of 'begin' callback\n" . "in descend() must be array reference." unless ref( $opt->{operands} ) eq 'ARRAY'; $tree->{operands} = $opt->{operands}; } if ( exists $opt->{descend_into} ) { croak "'descend_into' return value of 'begin'\n" . "callback in descend() must be array reference." unless ref( $opt->{descend_into} ) eq 'ARRAY'; $opt->{descend_into} = [ $operand_finder->() ] if @{ $opt->{descend_into} } == 0; foreach ( @{ $opt->{descend_into} } ) { if ( ref $_ ) { $_->replace( $_->descend(%new_args) ); } else { $tree->{operands}[$_] = $tree->{operands}[$_]->descend(%new_args); } } } } # descend into all operands. elsif ( @opt == 0 ) { foreach ( $operand_finder->() ) { $_->replace( $_->descend(%args) ); } } # Do nothing. elsif ( @opt == 1 and not defined( $opt[0] ) ) { } # Descend into indexed operands elsif ( @opt >= 1 and not grep { $_ !~ /^[+-]?\d+$/ } @opt ) { foreach (@opt) { $tree->{operands}[$_] = $tree->{operands}[$_]->descend(%args); } } # Error! else { croak "Invalid return list from descend() 'before' callback."; } # skip the after callback? if ( exists $args{after} and not($has_control and exists $opt[0]{skip_after} and $opt[0]{skip_after} ) ) { $args{after}->($tree); } return $tree; } =head2 Method term_type Returns the type of the term. This is a stub to be overridden. =cut sub term_type { croak "term_type not defined for " . __PACKAGE__; } =head2 Method set_value set_value() returns the tree it modifies, but acts in-place on the Math::Symbolic tree it was called on. set_value() requires named arguments (key/value pairs) that associate variable names of variables in the tree with the value-arguments if the corresponging key matches the variable name. (Can one say this any more complicated?) Since version 0.132, an alternative syntax is to pass a single hash reference to the method. Example: $tree->set_value(x => 1, y => 2, z => 3, t => 0) assigns the value 1 to any occurrances of variables of the name "x", aso. As opposed to value(), set_value() assigns to the variables I and does not evaluate the tree. When called on constants, set_value() sets their value to its first argument, but only if there is only one argument. =cut sub set_value { my ( $self, %args ); if ( @_ == 1 ) { return(); } elsif ( @_ == 2 ) { $self = shift; croak "Invalid arguments to method set_value()" unless ref $_[0] eq 'HASH'; %args = %{ $_[0] }; } else { ( $self, %args ) = @_; } my $ttype = $self->term_type(); if ( $ttype == T_CONSTANT ) { return $self unless @_ == 2; my $value = $_[1]; $self->{value} = $value if defined $value; return $self; } $self->descend( in_place => 1, after => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_OPERATOR or $ttype == T_CONSTANT ) { } elsif ( $ttype == T_VARIABLE ) { $tree->{value} = $args{ $tree->{name} } if exists $args{ $tree->{name} }; } else { croak "'set_value' called on invalid term " . "type."; } }, ); return $self; } =begin comment Since version 0.102, there are several overloaded operators. The overloaded interface is documented below. For more info, please have a look at the Math::Symbolic man page. =end comment =cut sub _overload_make_object { my $operand = shift; unless ( ref($operand) =~ /^Math::Symbolic/ ) { if ( not defined $operand ) { return $operand; } elsif ( $operand !~ /^\s*\d+\s*$/ ) { $operand = Math::Symbolic::parse_from_string($operand); } else { $operand = Math::Symbolic::Constant->new($operand); } } return $operand; } sub _overload_addition { my ( $obj, $operand, $reverse ) = @_; $operand = _overload_make_object($operand); return $obj if not defined $operand and $reverse; ( $obj, $operand ) = ( $operand, $obj ) if $reverse; my $n_obj = Math::Symbolic::Operator->new( '+', $obj, $operand ); return $n_obj; } sub _overload_subtraction { my ( $obj, $operand, $reverse ) = @_; $operand = _overload_make_object($operand); return Math::Symbolic::Operator->new( 'neg', $obj ) if not defined $operand and $reverse; ( $obj, $operand ) = ( $operand, $obj ) if $reverse; my $n_obj = Math::Symbolic::Operator->new( '-', $obj, $operand ); return $n_obj; } sub _overload_multiplication { my ( $obj, $operand, $reverse ) = @_; $operand = _overload_make_object($operand); ( $obj, $operand ) = ( $operand, $obj ) if $reverse; my $n_obj = Math::Symbolic::Operator->new( '*', $obj, $operand ); return $n_obj; } sub _overload_division { my ( $obj, $operand, $reverse ) = @_; $operand = _overload_make_object($operand); ( $obj, $operand ) = ( $operand, $obj ) if $reverse; my $n_obj = Math::Symbolic::Operator->new( '/', $obj, $operand ); return $n_obj; } sub _overload_exponentiation { my ( $obj, $operand, $reverse ) = @_; $operand = _overload_make_object($operand); ( $obj, $operand ) = ( $operand, $obj ) if $reverse; my $n_obj = Math::Symbolic::Operator->new( '^', $obj, $operand ); return $n_obj; } sub _overload_sqrt { my ( $obj, undef, $reverse ) = @_; my $n_obj = Math::Symbolic::Operator->new( '^', $obj, Math::Symbolic::Constant->new(0.5) ); return $n_obj; } sub _overload_exp { my ( $obj, undef, $reverse ) = @_; my $n_obj = Math::Symbolic::Operator->new( '^', Math::Symbolic::Constant->euler(), $obj, ); return $n_obj; } sub _overload_log { my ( $obj, undef, $reverse ) = @_; my $n_obj = Math::Symbolic::Operator->new( 'log', Math::Symbolic::Constant->euler(), $obj, ); return $n_obj; } sub _overload_sin { my ( $obj, undef, $reverse ) = @_; my $n_obj = Math::Symbolic::Operator->new( 'sin', $obj ); return $n_obj; } sub _overload_cos { my ( $obj, undef, $reverse ) = @_; my $n_obj = Math::Symbolic::Operator->new( 'cos', $obj ); return $n_obj; } =begin comment The following AUTOLOAD mechanism delegates all method calls that aren't found in the normal Math::Symbolic inheritance tree and that start with 'is_', 'test_', 'contains_', 'apply_', 'mod_', or 'to_' to the Math::Symbolic::Custom class. The 'is_' and 'test_' "namespaces" are intended for methods that test a tree on whether or not it has certain characteristics that define a group. Eg.: 'is_polynomial' The 'contains_' prefix is intended for tests as well. The 'apply_' and 'mod_' prefixes are intended for modifications to the tree itself. Eg.: 'apply_derivatives' The 'to_' prefix is intended for output / conversion related routines. =end comment =cut sub AUTOLOAD { my $call = $AUTOLOAD; $call =~ s/.*\:\:(\w+)$/$1/; if ( $call =~ /^((?:apply|mod|is|test|contains|to)_\w+)/ ) { my $method = $1; my $ref = Math::Symbolic::Custom->can($method); if ( defined $ref ) { goto &$ref; } else { my $obj = $_[0]; my $class = ref $obj; croak "Invalid method '$call' called on Math::Symbolic " ."tree. Tree was of type '$class'"; } } else { my $obj = $_[0]; my $class = ref $obj; croak "Invalid method '$call' called on Math::Symbolic " ."tree. Tree was of type '$class'"; } } =begin comment We override the UNIVERSAL::can routine to reflect method delegations. =end comment =cut sub can { my $obj = shift; my $method = shift; my $sub = $obj->SUPER::can($method); return $sub if defined $sub; return Math::Symbolic::Custom->can($method); } # to make AUTOLOAD happy: (because it would otherwise try to delegate DESTROY) sub DESTROY { } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/VectorCalculus.pm000444001750001750 5565112157534055 22171 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::VectorCalculus - Symbolically comp. grad, Jacobi matrices etc. =head1 SYNOPSIS use Math::Symbolic qw/:all/; use Math::Symbolic::VectorCalculus; # not loaded by Math::Symbolic @gradient = grad 'x+y*z'; # or: $function = parse_from_string('a*b^c'); @gradient = grad $function; # or: @signature = qw(x y z); @gradient = grad 'a*x+b*y+c*z', @signature; # Gradient only for x, y, z # or: @gradient = grad $function, @signature; # Similar syntax variations as with the gradient: $divergence = div @functions; $divergence = div @functions, @signature; # Again, similar DWIM syntax variations as with grad: @rotation = rot @functions; @rotation = rot @functions, @signature; # Signatures always inferred from the functions here: @matrix = Jacobi @functions; # $matrix is now array of array references. These hold # Math::Symbolic trees. Or: @matrix = Jacobi @functions, @signature; # Similar to Jacobi: @matrix = Hesse $function; # or: @matrix = Hesse $function, @signature; $wronsky_determinant = WronskyDet @functions, @vars; # or: $wronsky_determinant = WronskyDet @functions; # functions of 1 variable $differential = TotalDifferential $function; $differential = TotalDifferential $function, @signature; $differential = TotalDifferential $function, @signature, @point; $dir_deriv = DirectionalDerivative $function, @vector; $dir_deriv = DirectionalDerivative $function, @vector, @signature; $taylor = TaylorPolyTwoDim $function, $var1, $var2, $degree; $taylor = TaylorPolyTwoDim $function, $var1, $var2, $degree, $var1_0, $var2_0; # example: $taylor = TaylorPolyTwoDim 'sin(x)*cos(y)', 'x', 'y', 2; =head1 DESCRIPTION This module provides several subroutines related to vector calculus such as computing gradients, divergence, rotation, and Jacobi/Hesse Matrices of Math::Symbolic trees. Furthermore it provides means of computing directional derivatives and the total differential of a scalar function and the Wronsky Determinant of a set of n scalar functions. Please note that the code herein may or may not be refactored into the OO-interface of the Math::Symbolic module in the future. =head2 EXPORT None by default. You may choose to have any of the following routines exported to the calling namespace. ':all' tag exports all of the following: grad div rot Jacobi Hesse WronskyDet TotalDifferential DirectionalDerivative TaylorPolyTwoDim =head1 SUBROUTINES =cut package Math::Symbolic::VectorCalculus; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic qw/:all/; use Math::Symbolic::MiscAlgebra qw/det/; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( grad div rot Jacobi Hesse TotalDifferential DirectionalDerivative TaylorPolyTwoDim WronskyDet ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our $VERSION = '0.612'; =begin comment _combined_signature returns the combined signature of unique variable names of all Math::Symbolic trees passed to it. =end comment =cut sub _combined_signature { my %seen = map { ( $_, undef ) } map { ( $_->signature() ) } @_; return [ sort keys %seen ]; } =head2 grad This subroutine computes the gradient of a Math::Symbolic tree representing a function. The gradient of a function f(x1, x2, ..., xn) is defined as the vector: ( df(x1, x2, ..., xn) / d(x1), df(x1, x2, ..., xn) / d(x2), ..., df(x1, x2, ..., xn) / d(xn) ) (These are all partial derivatives.) Any good book on calculus will have more details on this. grad uses prototypes to allow for a variety of usages. In its most basic form, it accepts only one argument which may either be a Math::Symbolic tree or a string both of which will be interpreted as the function to compute the gradient for. Optionally, you may specify a second argument which must be a (literal) array of Math::Symbolic::Variable objects or valid Math::Symbolic variable names (strings). These variables will the be used for the gradient instead of the x1, ..., xn inferred from the function signature. =cut sub grad ($;\@) { my $original = shift; $original = parse_from_string($original) unless ref($original) =~ /^Math::Symbolic/; my $signature = shift; my @funcs; my @signature = ( defined $signature ? @$signature : $original->signature() ); foreach (@signature) { my $var = Math::Symbolic::Variable->new($_); my $func = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $original->new(), $var ], } ); push @funcs, $func; } return @funcs; } =head2 div This subroutine computes the divergence of a set of Math::Symbolic trees representing a vectorial function. The divergence of a vectorial function F = (f1(x1, ..., xn), ..., fn(x1, ..., xn)) is defined like follows: sum_from_i=1_to_n( dfi(x1, ..., xn) / dxi ) That is, the sum of all partial derivatives of the i-th component function to the i-th coordinate. See your favourite book on calculus for details. Obviously, it is important to keep in mind that the number of function components must be equal to the number of variables/coordinates. Similar to grad, div uses prototypes to offer a comfortable interface. First argument must be a (literal) array of strings and Math::Symbolic trees which represent the vectorial function's components. If no second argument is passed, the variables used for computing the divergence will be inferred from the functions. That means the function signatures will be joined to form a signature for the vectorial function. If the optional second argument is specified, it has to be a (literal) array of Math::Symbolic::Variable objects and valid variable names (strings). These will then be interpreted as the list of variables for computing the divergence. =cut sub div (\@;\@) { my @originals = map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @{ +shift }; my $signature = shift; $signature = _combined_signature(@originals) if not defined $signature; if ( @$signature != @originals ) { die "Variable count does not function count for divergence."; } my @signature = map { Math::Symbolic::Variable->new($_) } @$signature; my $div = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ shift(@originals)->new(), shift @signature ], } ); foreach (@originals) { $div = Math::Symbolic::Operator->new( '+', $div, Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $_->new(), shift @signature ], } ) ); } return $div; } =head2 rot This subroutine computes the rotation of a set of three Math::Symbolic trees representing a vectorial function. The rotation of a vectorial function F = (f1(x1, x2, x3), f2(x1, x2, x3), f3(x1, x2, x3)) is defined as the following vector: ( ( df3/dx2 - df2/dx3 ), ( df1/dx3 - df3/dx1 ), ( df2/dx1 - df1/dx2 ) ) Or "nabla x F" for short. Again, I have to refer to the literature for the details on what rotation is. Please note that there have to be exactly three function components and three coordinates because the cross product and hence rotation is only defined in three dimensions. As with the previously introduced subroutines div and grad, rot offers a prototyped interface. First argument must be a (literal) array of strings and Math::Symbolic trees which represent the vectorial function's components. If no second argument is passed, the variables used for computing the rotation will be inferred from the functions. That means the function signatures will be joined to form a signature for the vectorial function. If the optional second argument is specified, it has to be a (literal) array of Math::Symbolic::Variable objects and valid variable names (strings). These will then be interpreted as the list of variables for computing the rotation. (And please excuse my copying the last two paragraphs from above.) =cut sub rot (\@;\@) { my $originals = shift; my @originals = map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @$originals; my $signature = shift; $signature = _combined_signature(@originals) unless defined $signature; if ( @originals != 3 ) { die "Rotation only defined for functions of three components."; } if ( @$signature != 3 ) { die "Rotation only defined for three variables."; } return ( Math::Symbolic::Operator->new( '-', Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[2]->new(), $signature->[1] ], } ), Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[1]->new(), $signature->[2] ], } ) ), Math::Symbolic::Operator->new( '-', Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[0]->new(), $signature->[2] ], } ), Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[2]->new(), $signature->[0] ], } ) ), Math::Symbolic::Operator->new( '-', Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[1]->new(), $signature->[0] ], } ), Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $originals[0]->new(), $signature->[1] ], } ) ) ); } =head2 Jacobi Jacobi() returns the Jacobi matrix of a given vectorial function. It expects any number of arguments (strings and/or Math::Symbolic trees) which will be interpreted as the vectorial function's components. Variables used for computing the matrix are, by default, inferred from the combined signature of the components. By specifying a second literal array of variable names as (second) argument, you may override this behaviour. The Jacobi matrix is the vector of gradient vectors of the vectorial function's components. =cut sub Jacobi (\@;\@) { my @funcs = map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @{ +shift() }; my $signature = shift; my @signature = ( defined $signature ? ( map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @$signature ) : ( @{ +_combined_signature(@funcs) } ) ); return map { [ grad $_, @signature ] } @funcs; } =head2 Hesse Hesse() returns the Hesse matrix of a given scalar function. First argument must be a string (to be parsed as a Math::Symbolic tree) or a Math::Symbolic tree. As with Jacobi(), Hesse() optionally accepts an array of signature variables as second argument. The Hesse matrix is the Jacobi matrix of the gradient of a scalar function. =cut sub Hesse ($;\@) { my $function = shift; $function = parse_from_string($function) unless ref($function) =~ /^Math::Symbolic/; my $signature = shift; my @signature = ( defined $signature ? ( map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @$signature ) : $function->signature() ); my @gradient = grad $function, @signature; return Jacobi @gradient, @signature; } =head2 TotalDifferential This function computes the total differential of a scalar function of multiple variables in a certain point. First argument must be the function to derive. The second argument is an optional (literal) array of variable names (strings) and Math::Symbolic::Variable objects to be used for deriving. If the argument is not specified, the functions signature will be used. The third argument is also an optional array and denotes the set of variable (names) to use for indicating the point for which to evaluate the differential. It must have the same number of elements as the second argument. If not specified the variable names used as coordinated (the second argument) with an appended '_0' will be used as the point's components. =cut sub TotalDifferential ($;\@\@) { my $function = shift; $function = parse_from_string($function) unless ref($function) =~ /^Math::Symbolic/; my $sig = shift; $sig = [ $function->signature() ] if not defined $sig; my @sig = map { Math::Symbolic::Variable->new($_) } @$sig; my $point = shift; $point = [ map { $_->name() . '_0' } @sig ] if not defined $point; my @point = map { Math::Symbolic::Variable->new($_) } @$point; if ( @point != @sig ) { croak "Signature dimension does not match point dimension."; } my @grad = grad $function, @sig; if ( @grad != @sig ) { croak "Signature dimension does not match function grad dim."; } foreach (@grad) { my @point_copy = @point; $_->implement( map { ( $_->name() => shift(@point_copy) ) } @sig ); } my $d = Math::Symbolic::Operator->new( '*', shift(@grad), Math::Symbolic::Operator->new( '-', shift(@sig), shift(@point) ) ); $d += Math::Symbolic::Operator->new( '*', shift(@grad), Math::Symbolic::Operator->new( '-', shift(@sig), shift(@point) ) ) while @grad; return $d; } =head2 DirectionalDerivative DirectionalDerivative computes the directional derivative of a scalar function in the direction of a specified vector. With f being the function and X, A being vectors, it looks like this: (this is a partial derivative) df(X)/dA = grad(f(X)) * (A / |A|) First argument must be the function to derive (either a string or a valid Math::Symbolic tree). Second argument must be vector into whose direction to derive. It is to be specified as an array of variable names and objects. Third argument is the optional signature to be used for computing the gradient. Please see the documentation of the grad function for details. It's dimension must match that of the directional vector. =cut sub DirectionalDerivative ($\@;\@) { my $function = shift; $function = parse_from_string($function) unless ref($function) =~ /^Math::Symbolic/; my $vec = shift; my @vec = map { Math::Symbolic::Variable->new($_) } @$vec; my $sig = shift; $sig = [ $function->signature() ] if not defined $sig; my @sig = map { Math::Symbolic::Variable->new($_) } @$sig; if ( @vec != @sig ) { croak "Signature dimension does not match vector dimension."; } my @grad = grad $function, @sig; if ( @grad != @sig ) { croak "Signature dimension does not match function grad dim."; } my $two = Math::Symbolic::Constant->new(2); my @squares = map { Math::Symbolic::Operator->new( '^', $_, $two ) } @vec; my $abs_vec = shift @squares; $abs_vec += shift(@squares) while @squares; $abs_vec = Math::Symbolic::Operator->new( '^', $abs_vec, Math::Symbolic::Constant->new( 1 / 2 ) ); @vec = map { $_ / $abs_vec } @vec; my $dd = Math::Symbolic::Operator->new( '*', shift(@grad), shift(@vec) ); $dd += Math::Symbolic::Operator->new( '*', shift(@grad), shift(@vec) ) while @grad; return $dd; } =begin comment This computes the taylor binomial (d/dx*(x-x0)+d/dy*(y-y0))^n * f(x0, y0) =end comment =cut sub _taylor_binomial { my $f = shift; my $a = shift; my $b = shift; my $a0 = shift; my $b0 = shift; my $n = shift; $f = $f->new(); my $da = $a - $a0; my $db = $b - $b0; $f->implement( $a->name() => $a0, $b->name() => $b0 ); return Math::Symbolic::Constant->one() if $n == 0; return $da * Math::Symbolic::Operator->new( 'partial_derivative', $f->new(), $a0 ) + $db * Math::Symbolic::Operator->new( 'partial_derivative', $f->new(), $b0 ) if $n == 1; my $n_obj = Math::Symbolic::Constant->new($n); my $p_a_deriv = $f->new(); $p_a_deriv = Math::Symbolic::Operator->new( 'partial_derivative', $p_a_deriv, $a0 ) for 1 .. $n; my $res = Math::Symbolic::Operator->new( '*', $p_a_deriv, Math::Symbolic::Operator->new( '^', $da, $n_obj ) ); foreach my $k ( 1 .. $n - 1 ) { $p_a_deriv = $p_a_deriv->op1()->new(); my $deriv = $p_a_deriv; $deriv = Math::Symbolic::Operator->new( 'partial_derivative', $deriv, $b0 ) for 1 .. $k; my $k_obj = Math::Symbolic::Constant->new($k); $res += Math::Symbolic::Operator->new( '*', Math::Symbolic::Constant->new( _over( $n, $k ) ), Math::Symbolic::Operator->new( '*', $deriv, Math::Symbolic::Operator->new( '*', Math::Symbolic::Operator->new( '^', $da, Math::Symbolic::Constant->new( $n - $k ) ), Math::Symbolic::Operator->new( '^', $db, $k_obj ) ) ) ); } my $p_b_deriv = $f->new(); $p_b_deriv = Math::Symbolic::Operator->new( 'partial_derivative', $p_b_deriv, $b0 ) for 1 .. $n; $res += Math::Symbolic::Operator->new( '*', $p_b_deriv, Math::Symbolic::Operator->new( '^', $db, $n_obj ) ); return $res; } =begin comment This computes / n \ | | \ k / =end comment =cut sub _over { my $n = shift; my $k = shift; return 1 if $k == 0; return _over( $n, $n - $k ) if $k > $n / 2; my $prod = 1; my $i = $n; my $j = $k; while ( $i > $k ) { $prod *= $i; $prod /= $j if $j > 1; $i--; $j--; } return ($prod); } =begin comment _faculty() computes the product that is the faculty of the first argument. =end comment =cut sub _faculty { my $num = shift; croak "Cannot calculate faculty of negative numbers." if $num < 0; my $fac = Math::Symbolic::Constant->one(); return $fac if $num <= 1; for ( my $i = 2 ; $i <= $num ; $i++ ) { $fac *= Math::Symbolic::Constant->new($i); } return $fac; } =head2 TaylorPolyTwoDim This subroutine computes the Taylor Polynomial for functions of two variables. Please refer to the documentation of the TaylorPolynomial function in the Math::Symbolic::MiscCalculus package for an explanation of single dimensional Taylor Polynomials. This is the counterpart in two dimensions. First argument must be the function to approximate with the Taylor Polynomial either as a string or a Math::Symbolic tree. Second and third argument must be the names of the two coordinates. (These may alternatively be Math::Symbolic::Variable objects.) Fourth argument must be the degree of the Taylor Polynomial. Fifth and Sixth arguments are optional and specify the names of the variables to introduce as the point of approximation. These default to the names of the coordinates with '_0' appended. =cut sub TaylorPolyTwoDim ($$$$;$$) { my $function = shift; $function = parse_from_string($function) unless ref($function) =~ /^Math::Symbolic/; my $x1 = shift; $x1 = Math::Symbolic::Variable->new($x1) unless ref($x1) eq 'Math::Symbolic::Variable'; my $x2 = shift; $x2 = Math::Symbolic::Variable->new($x2) unless ref($x2) eq 'Math::Symbolic::Variable'; my $n = shift; my $x1_0 = shift; $x1_0 = $x1->name() . '_0' if not defined $x1_0; $x1_0 = Math::Symbolic::Variable->new($x1_0) unless ref($x1_0) eq 'Math::Symbolic::Variable'; my $x2_0 = shift; $x2_0 = $x2->name() . '_0' if not defined $x2_0; $x2_0 = Math::Symbolic::Variable->new($x2_0) unless ref($x2_0) eq 'Math::Symbolic::Variable'; my $x1_n = $x1->name(); my $x2_n = $x2->name(); my $dx1 = $x1 - $x1_0; my $dx2 = $x2 - $x2_0; my $copy = $function->new(); $copy->implement( $x1_n => $x1_0, $x2_n => $x2_0 ); my $taylor = $copy; return $taylor if $n == 0; foreach my $k ( 1 .. $n ) { $taylor += Math::Symbolic::Operator->new( '/', _taylor_binomial( $function->new(), $x1, $x2, $x1_0, $x2_0, $k ), _faculty($k) ); } return $taylor; } =head2 WronskyDet WronskyDet() computes the Wronsky Determinant of a set of n functions. First argument is required and a (literal) array of n functions. Second argument is optional and a (literal) array of n variables or variable names. If the second argument is omitted, the variables used for deriving are inferred from function signatures. This requires, however, that the function signatures have exactly one element. (And the function this exactly one variable.) =cut sub WronskyDet (\@;\@) { my $functions = shift; my @functions = map { ( ref($_) =~ /^Math::Symbolic/ ) ? $_ : parse_from_string($_) } @$functions; my $vars = shift; my @vars = ( defined $vars ? @$vars : () ); @vars = map { my @sig = $_->signature(); croak "Cannot infer function signature for WronskyDet." if @sig != 1; shift @sig; } @functions if not defined $vars; @vars = map { Math::Symbolic::Variable->new($_) } @vars; croak "Number of vars doesn't match num of functions in WronskyDet." if not @vars == @functions; my @matrix; push @matrix, [@functions]; foreach ( 2 .. @functions ) { my $i = 0; @functions = map { Math::Symbolic::Operator->new( 'partial_derivative', $_, $vars[ $i++ ] ) } @functions; push @matrix, [@functions]; } return det @matrix; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Parser.pm000444001750001750 4533012157534055 20460 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Parser - Parse strings into Math::Symbolic trees =head1 SYNOPSIS use Math::Symbolic::Parser; my $parser = Math::Symbolic::Parser->new(); $string =~ s/\s+//g; my $tree = $parser->parse($string); # or better: use Math::Symbolic; my $tree = Math::Symbolic->parse_from_string($string); =head1 DESCRIPTION This module contains the parsing routines used by Math::Symbolic to parse strings into Math::Symbolic trees. Usually, you will want to simply use the Math::Symbolic->parse_from_string() class method instead of this module directly. If you do use this module directly, however, make sure to remove any whitespace from your input string. =head2 NOTE With version 0.501 of Math::Symbolic, an experimental, new parser is introduced, but it is not enabled by default. The new parser is based on Parse::Yapp instead of Parse::RecDescent and comes with an at least ten fold speed increase. However, it has not been available for a long time and is not as well tested. Since version 2.00 of the Math::SymbolicX::ParserExtensionFactory module, it's possible to extend Yapp parsers. B It is suggested you test your code against it before that. Code that uses the RecDescent based parser's C method may fail! Until then, you need to load it by hand as follows: $Math::Symbolic::Parser = Math::Symbolic::Parser->new( implementation=>'Yapp' ); This replaces the default Math::Symbolic parser with an instance of the new Yapp parser. =head2 STRING FORMAT The parser has been designed to parse strings that are reminiscient of ordinary algebraic expressions including the standard arithmetic infix operators such as multiplication. Many functions such as a rather comprehensive set of trigonometric functions are parsed in prefix form like 'sin(expression)' or 'log(base, expression)'. Unknown identifiers starting with a letter and containing only letters, digits, and underscores are parsed as variables. If these identifiers are followed by parenthesis containing a list of identifiers, the list is parsed as the signature of the variable. Example: '5*x(t)' is parsed as the product of the constant five and the variable 'x' which depends on 't'. These dependencies are important for total derivatives. The supported builtin-functions are listed in the documentation for Math::Symbolic::Operator in the section on the new() constructor. =head2 EXTENSIONS In version 0.503, a function named C is recognized and transformed into C internally. In version 0.506, a function named C was added which is transformed into C<(...)^0.5>. Version 0.511 added support for the typical C syntax for derivatives. For details, refer to the section on parsing derivatives below. =head2 EXAMPLES # An example from analytical mechanics: my $hamilton_function = Math::Symbolic->parse_from_string( 'p_q(q, dq_dt, t) * dq_dt(q, t) - Lagrange(q, p_q, t)' ); This parses as "The product of the generalized impulse p_q (which is a function of the generalized coordinate q, its derivative, and the time) and the derivative of the generalized coordinate dq_dt (which depends on q itself and the time). This term minus the Lagrange Function (of q, the impulse, and the time) is the Hamilton Function." Well, that's how it parses in my head anyway. The parser will generate a tree like this: Operator { type => difference, operands => ( Operator { type => product, operands => ( Variable { name => p_q, dependencies => q, dq_dt, t }, Variable { name => dq_dt, dependencies => q, t } ) }, Variable { name => Lagrange, dependencies => q, p_q, t } ) } Possibly a simpler example would be 'amplitude * sin(phi(t))' which descibes an oscillation. sin(...) is assumed to be the sine function, amplitude is assumed to be a symbol / variable that doesn't depend on any others. phi is recognized as a variable that changes over time (t). So phi(t) is actually a function of t that hasn't yet been specified. phi(t) could look like 'omega*t + theta' where strictly speaking, omega, t, and theta are all symbols without dependencies. So omega and theta would be treated as constants if you derived them in respect to t. Figuratively speaking, omega would be a frequency and theta would be a initial value. =head2 PARSING DERIVATIVES The traditional way of specifying a derivative for parsing was C where C can be any valid expression and C is a variable name. The syntax denotes a partial derivative of the expression with respect to the variable. The same syntax is available for total derivatives. With version 0.511, a new syntax for specifying partial derivatives was added to the parser(s). C denotes the first partial derivative of C with respect to C. If C<(x)> is omitted, C defaults to using C. C is the second order partial derivative with respect to C. If there are multiple variables in the parenthesis, a la C, the first variable is used for the derivatives. =head2 EXPORT None by default. =head1 CLASS DATA While working with this module, you might get into the not-so-convient position of having to debug the parser and/or its grammar. In order to make this possible, there's the $DEBUG package variable which, when set to 1, makes the parser warn which grammar elements are being processed. Note, however, that their order is bottom-up, not top-down. =cut package Math::Symbolic::Parser; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic::ExportConstants qw/:all/; #use Parse::RecDescent; my $Required_Parse_RecDescent = 0; our $VERSION = '0.612'; our $DEBUG = 0; # Functions that are parsed and translated to specific M::S trees # *by the parser*. our %Parser_Functions = ( 'exp' => sub { my $func = shift; my $arg = shift; return Math::Symbolic::Operator->new( '^', Math::Symbolic::Constant->euler(), $arg ); }, 'sqrt' => sub { my $func = shift; my $arg = shift; return Math::Symbolic::Operator->new( '^', $arg, Math::Symbolic::Constant->new(0.5) ); }, ); our $Grammar = <<'GRAMMAR_END'; parse: expr /^\Z/ { $return = $item[1] } | // {undef} expr: addition { #warn 'expr ' if $Math::Symbolic::Parser::DEBUG; $item[1] } addition: { #warn 'addition ' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } } add_op: '+' | '-' multiplication: { #warn 'multiplication ' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } } mult_op: '*' | '/' exp: { #warn 'exp ' if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = reverse @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( '^', shift(@it), $tree ); } $tree; } } factor: /(?:\+|-)*/ number { #warn 'unary_n ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } } | /(?:\+|-)*/ function { #warn 'unary_f ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } } | /(?:\+|-)*/ variable { #warn 'unary_v ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } } | /(?:\+|-)*/ '(' expr ')' { #warn 'unary_expr ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[3]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[3] } } number: /([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/ { #warn 'number ' # if $Math::Symbolic::Parser::DEBUG; Math::Symbolic::Constant->new($item[1]) } function: function_name '(' expr_list ')' { #warn 'function ' # if $Math::Symbolic::Parser::DEBUG; my $fname = $item[1]; my $function; if (exists($Math::Symbolic::Parser::Parser_Functions{$fname})) { $function = $Math::Symbolic::Parser::Parser_Functions{$fname}->($fname, @{$item[3]}); die "Invalid function '$fname'!" unless defined $function; } else { $function = $Math::Symbolic::Operator::Op_Symbols{ $fname }; die "Invalid function '$fname'!" unless defined $function; $function = Math::Symbolic::Operator->new( { type => $function, operands => $item[3] } ); } $function } function_name: 'log' | 'partial_derivative' | 'total_derivative' | 'sinh' | 'cosh' | 'asinh' | 'acosh' | 'asin' | 'acos' | 'atan2' | 'atan' | 'acot' | 'sin' | 'cos' | 'tan' | 'cot' | 'exp' | 'sqrt' expr_list: { #warn 'expr_list ' # if $Math::Symbolic::Parser::DEBUG; $item[1] } variable: /[a-zA-Z][a-zA-Z0-9_]*/ /\'*/ '(' identifier_list ')' { #warn 'variable ' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $sig = $item[4] || ['x']; my $dep_var = $sig->[0]; my $return = Math::Symbolic::Variable->new( { name => $varname, signature => $sig } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $dep_var, ); } $return; } else { Math::Symbolic::Variable->new( { name => $varname, signature => $item[4] } ); } } | /[a-zA-Z][a-zA-Z0-9_]*/ /\'*/ { #warn 'variable ' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $return = Math::Symbolic::Variable->new( { name => $varname, signature => ['x'] } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, 'x', ); } $return; } else { Math::Symbolic::Variable->new( $varname ); } } identifier_list: { #warn 'identifier_list ' # if $Math::Symbolic::Parser::DEBUG; $item[1] } GRAMMAR_END =head2 Constructor new This constructor does not expect any arguments and returns a Parse::RecDescent parser to parse algebraic expressions from a string into Math::Symbolic trees. The constructor takes key/value pairs of options. You can regenerate the parser from the grammar in the scalar C<$Math::Symbolic::Parser::Grammar> instead of using the (slightly faster) precompiled grammar from L. You can enable recompilation from the grammar with the option C 1>. This only has an effect if the implementation is the L based parser (which is the default). If you care about parsing speed more than about being able to extend the parser at run-time, you can specify the C option. Currently recognized are C and C implementations. C is the default and C is significantly faster. The L based implementation may not support all extension modules. It has been tested with Math::SymbolicX::ParserExtensionFactory and Math::SymbolicX::Complex. =cut sub new { my $class = shift; my %args = @_; my $impl = $args{implementation} || 'RecDescent'; if ($impl eq 'RecDescent') { return $class->_new_recdescent(\%args); } elsif ($impl eq 'Yapp') { return $class->_new_yapp(\%args); } else { croak("'implementation' must be one of RecDescent or Yapp"); } } sub _new_recdescent { my $class = shift; my $args = shift; if ( not $Required_Parse_RecDescent ) { local $@; eval 'require Parse::RecDescent;'; croak "Could not require Parse::RecDescent. Please install\n" . "Parse::RecDescent in order to use Math::Symbolic::Parser.\n" . "(Error: $@)" if $@; } my $parser; if ( $args->{recompile} ) { $parser = Parse::RecDescent->new($Grammar); $parser->{__PRIV_EXT_FUNC_REGEX} = qr/(?!)/; } else { eval 'require Math::Symbolic::Parser::Precompiled;'; if ($@) { $parser = Parse::RecDescent->new($Grammar); $parser->{__PRIV_EXT_FUNC_REGEX} = qr/(?!)/; } else { $parser = Math::Symbolic::Parser::Precompiled->new(); $parser->{__PRIV_EXT_FUNC_REGEX} = qr/(?!)/; } } return $parser; } sub _new_yapp { my $class = shift; my $args = shift; eval 'require Math::Symbolic::Parser::Yapp'; my %yapp_args; $yapp_args{predicates} = $args->{yapp_predicates} if $args->{yapp_predicates}; if ($@) { croak("Could not load Math::Symbolic::Parser::Yapp. Error: $@"); } else { return Math::Symbolic::Parser::Yapp->new(%yapp_args); } } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L =head1 ADDITIONAL COPYRIGHT NOTICE This package is distributed under the same license as the rest of the Math::Symbolic distribution (Artistic+GPL), but the author of Parse::Yapp has requested that his copyright and the licensing terms of Parse::Yapp derived works be reproduced. Note that the license is the same as Math::Symbolic's license. We're using the "standalone parser" option. The Parse::Yapp module and its related modules and shell scripts are copyright (c) 1998-2001 Francois Desarmenien, France. All rights reserved. You may use and distribute them under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. If you use the "standalone parser" option so people don't need to install Parse::Yapp on their systems in order to run you software, this copyright notice should be included in your software copyright too, and the copyright notice in the embedded driver should be left untouched. =cut Math-Symbolic-0.612/lib/Math/Symbolic/MiscAlgebra.pm000444001750001750 2003612157534055 21371 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::MiscAlgebra - Miscellaneous algebra routines like det() =head1 SYNOPSIS use Math::Symbolic qw/:all/; use Math::Symbolic::MiscAlgebra qw/:all/; # not loaded by Math::Symbolic @matrix = (['x*y', 'z*x', 'y*z'],['x', 'z', 'z'],['x', 'x', 'y']); $det = det @matrix; @vector = ('x', 'y', 'z'); $solution = solve_linear(\@matrix, \@vector); =head1 DESCRIPTION This module provides several subroutines related to algebra such as computing the determinant of quadratic matrices, solving linear equation systems and computation of Bell Polynomials. Please note that the code herein may or may not be refactored into the OO-interface of the Math::Symbolic module in the future. =head2 EXPORT None by default. You may choose to have any of the following routines exported to the calling namespace. ':all' tag exports all of the following: det linear_solve bell_polynomial =head1 SUBROUTINES =cut package Math::Symbolic::MiscAlgebra; use 5.006; use strict; use warnings; use Carp; use Memoize; use Math::Symbolic qw/:all/; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( det bell_polynomial linear_solve ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our $VERSION = '0.612'; =head2 det det() computes the determinant of a matrix of Math::Symbolic trees (or strings that can be parsed as such). First argument must be a literal array: "det @matrix", where @matrix is an n x n matrix. Please note that calculating determinants of matrices using the straightforward Laplace algorithm is a slow (O(n!)) operation. This implementation cannot make use of the various optimizations resulting from the determinant properties since we are dealing with symbolic matrix elements. If you have a matrix of reals, it is strongly suggested that you use Math::MatrixReal or Math::Pari to get the determinant which can be calculated using LR decomposition much faster. On a related note: Calculating the determinant of a 20x20 matrix would take over 77146 years if your Perl could do 1 million calculations per second. Given that we're talking about several method calls per calculation, that's much more than todays computers could do. On the other hand, if you'd be using this straightforward algorithm with numbers only and in C, you might be done in 26 years alright, so please go for the smarter route (better algorithm) instead if you have numbers only. =cut sub det (\@) { my $matrix = shift; my $size = @$matrix; foreach (@$matrix) { croak "det(Matrix) requires n x n matrix!" if @$_ != $size; foreach (@$_) { $_ = Math::Symbolic::parse_from_string($_) if ref($_) !~ /^Math::Symbolic/; } } return $matrix->[0][0] if $size == 1; return $matrix->[0][0] * $matrix->[1][1] - $matrix->[1][0] * $matrix->[0][1] if $size == 2; return _det_helper( $matrix, $size ); } sub _det_helper { my $matrix = shift; my $size = shift; return $matrix->[0][0] * $matrix->[1][1] * $matrix->[2][2] + $matrix->[1][0] * $matrix->[2][1] * $matrix->[0][2] + $matrix->[2][0] * $matrix->[0][1] * $matrix->[1][2] - $matrix->[0][2] * $matrix->[1][1] * $matrix->[2][0] - $matrix->[1][2] * $matrix->[2][1] * $matrix->[0][0] - $matrix->[2][2] * $matrix->[0][1] * $matrix->[1][0] if $size == 3; my $det; foreach ( 0 .. $size - 1 ) { if ( $_ % 2 ) { $det -= $matrix->[0][$_] * _det_helper( _matrix_slice( $matrix, 0, $_ ), $size - 1 ); } else { $det += $matrix->[0][$_] * _det_helper( _matrix_slice( $matrix, 0, $_ ), $size - 1 ); } } return $det; } sub _matrix_slice { my $matrix = shift; my $x = shift; my $y = shift; return [ map { [ @{$_}[ 0 .. $y - 1, $y + 1 ... $#$_ ] ] } @{$matrix}[ 0 .. $x - 1, $x + 1 .. $#$matrix ] ]; } =head2 linear_solve Calculates the solutions x (vector) of a linear equation system of the form C with C being a matrix, C a vector and the solution C a vector. Due to implementation limitations, C must be a quadratic matrix and C must have a dimension that is equivalent to that of C. Furthermore, the determinant of C must be non-zero. The algorithm used is devised from Cramer's Rule and thus inefficient. The preferred algorithm for this task is Gaussian Elimination. If you have a matrix and a vector of real numbers, please consider using either Math::MatrixReal or Math::Pari instead. First argument must be a reference to a matrix (array of arrays) of symbolic terms, second argument must be a reference to a vector (array) of symbolic terms. Strings will be automatically converted to Math::Symbolic trees. Returns a reference to the solution vector. =cut sub linear_solve { my ( $m, $v ) = @_; my $dim = @$v; croak "linear_solve(Matrix, Vector) requires n x n matrix and n-vector!" if @$m != $dim; foreach (@$m) { croak "linear_solve(Matrix, Vector) requires n x n matrix and n-vector!" if @$_ != $dim; foreach (@$_) { $_ = Math::Symbolic::parse_from_string($_) if ref($_) !~ /^Math::Symbolic/; } } foreach (@$v) { $_ = Math::Symbolic::parse_from_string($_) if ref($_) !~ /^Math::Symbolic/; } my $det = det @$m; my @vec; foreach my $i ( 0 .. $#$m ) { my $nm = _replace_col( $m, $v, $i ); my $det_i = det @$nm; push @vec, $det_i / $det; } return \@vec; } sub _replace_col { my $m = shift; my $v = shift; my $col = shift; my $nm = []; foreach my $i ( 0 .. $#$m ) { $nm->[$i] = [ @{ $m->[$i] }[ 0 .. $col - 1 ], $v->[$i], @{ $m->[$i] }[ $col + 1 .. $#$m ] ]; } return $nm; } =head2 bell_polynomial This functions returns the nth Bell Polynomial. It uses memoization for speed increase. First argument is the n. Second (optional) argument is the variable or variable name to use in the polynomial. Defaults to 'x'. The Bell Polynomial is defined as follows: phi_0 (x) = 1 phi_n+1(x) = x * ( phi_n(x) + partial_derivative( phi_n(x), x ) ) Bell Polynomials are Exponential Polynimals with phi_n(1) = the nth bell number. Please refer to the bell_number() function in the Math::Symbolic::AuxFunctions module for a method of generating these numbers. =cut memoize('bell_polynomial'); sub bell_polynomial { my $n = shift; my $var = shift; $var = 'x' if not defined $var; $var = Math::Symbolic::Variable->new($var); return undef if $n < 0; return Math::Symbolic::Constant->new(1) if $n == 0; return $var if $n == 1; my $bell = bell_polynomial( $n - 1 ); $bell = Math::Symbolic::Operator->new( '+', Math::Symbolic::Operator->new( '*', $var, $bell )->simplify(), Math::Symbolic::Operator->new( '*', $var, Math::Symbolic::Operator->new( 'partial_derivative', $bell, $var ) ->apply_derivatives()->simplify() )->simplify() ); return $bell; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Custom.pm000444001750001750 1230512157534055 20472 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Custom - Aggregate class for tree tests and transformations =head1 SYNOPSIS # Extending the class: package Math::Symbolic::Custom::MyTransformations; use Math::Symbolic::Custom::Base; BEGIN {*import = \&Math::Symbolic::Custom::Base::aggregate_import} our $Aggregate_Export = [qw/apply_transformation1 .../]; sub apply_transformation1 { # ... } # ... # Using the custom class: use Math::Symbolic; use Math::Symbolic::Custom::MyTransformations; # later... $tree->apply_transformation1(); $tree->mod_transformation2(); die unless $tree->is_type1(); die unless $tree->test_condition1(); die if $tree->contains_something1(); print $tree->to_latex(); =head1 DESCRIPTION This is an aggregate class for all custom modification, transformation, testing and output extensions for Math::Symbolic trees. Some default transformations and tests are implemented in the Math::Symbolic::Custom::DefaultMods and Math::Symbolic::Custom::DefaultTests packages, default output routines in Math::Symbolic::Custom::DefaultDumpers which are automatically loaded by the Math::Symbolic::Custom class. Math::Symbolic::Custom imports all constants from Math::Symbolic::ExportConstants =head2 EXPORT None by default. =cut package Math::Symbolic::Custom; use 5.006; use strict; use warnings; use Carp; use Math::Symbolic::ExportConstants qw/:all/; our $VERSION = '0.612'; our $AUTOLOAD; use Math::Symbolic::Custom::DefaultTests; use Math::Symbolic::Custom::DefaultMods; use Math::Symbolic::Custom::DefaultDumpers; 1; __END__ =head1 EXTENDING THE MODULE In order to extend the functionality of Math::Symbolic, you have to go through the following steps: (also see the synopsis in this document.) =over 4 =item Choose an appropriate namespace in the Math::Symbolic::Custom::* hierarchy or if you desparately wish, somewhere else. =item Create a new module (probably using "h2xs -AX MODULENAME") and put the following lines of code in it: # To make sure we're cooperating with Math::Symbolic's idea of # method delegation. use Math::Symbolic::Custom::Base; BEGIN {*import = \&Math::Symbolic::Custom::Base::aggregate_import} our $Aggregate_Export = [ # Put the list of method names to be exported. /]; =item Think well about the naming of your exported methods. Answer the following questions: Does the name start with 'is_', 'test_', 'mod_', 'apply_', 'contains_', or 'to_'? If not, find a suitable name that does. Does the name clash with any of the methods exported by Math::Symbolic::Custom::DefaultTests, Math::Symbolic::Custom::DefaultMods, or Math::Symbolic::Custom::DefaultDumpers? If so, please consider choosing a different name. Does the name map to the idea behind the method prefix ('is_', ...)? Only methods starting with one of the prefixes listed above can be delegated. Any others will never be called. The idea behind delegating methods with several prefixes is to provide for a reasonable choice for naming methods. 'is_' and 'contains_' are meant to be used for accurate tests like "is_constant". 'test_' is meant for all tests that either make use of heuristics or can't be fitted into either 'is_' or 'contains_'. The prefixes 'mod_' and 'apply_' are meant for use with methods that modify the Math::Symbolic tree. Finally, the prefix 'to_' is meant to be used with conversion and output methods like 'to_latex' or 'to_string'. (Though as of version 0.122, to_string is implemented in the core Math::Symbolic modules.) =item Make sure you document exactly what your methods do. Do they modify the Math::Symbolic tree in-place or do they clone using the new() constructor and return a copy? Make sure you mention the behaviour in the docs. =item Consider packaging your extensions as a CPAN distribution to help others in their development with Math::Symbolic. If you think the extensions are generic enough to be a worthwhile addition to the core distribution, try sending your extensions to the Math::Symbolic developers mailing list instead. =item Load your extension module after loading the Math::Symbolic module. =item Start using your custom enhancements as methods to the Math::Symbolic trees (any term types). =item Send bug reports and feedback to the Math::Symbolic support mailing list. =back =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L L L L =cut Math-Symbolic-0.612/lib/Math/Symbolic/ExportConstants.pm000444001750001750 651412157534055 22363 0ustar00tseetsee000000000000 =encoding utf8 =cut package Math::Symbolic::ExportConstants; use 5.006; use strict; use warnings; require Exporter; use constant EULER => 2.718281828459045235360287; use constant PI => 3.141592653589793238462643; use constant B_SUM => 0; use constant B_DIFFERENCE => 1; use constant B_PRODUCT => 2; use constant B_DIVISION => 3; use constant U_MINUS => 4; use constant U_P_DERIVATIVE => 5; use constant U_T_DERIVATIVE => 6; use constant B_EXP => 7; use constant B_LOG => 8; use constant U_SINE => 9; use constant U_COSINE => 10; use constant U_TANGENT => 11; use constant U_COTANGENT => 12; use constant U_ARCSINE => 13; use constant U_ARCCOSINE => 14; use constant U_ARCTANGENT => 15; use constant U_ARCCOTANGENT => 16; use constant U_SINE_H => 17; use constant U_COSINE_H => 18; use constant U_AREASINE_H => 19; use constant U_AREACOSINE_H => 20; use constant B_ARCTANGENT_TWO => 21; use constant T_OPERATOR => 0; use constant T_CONSTANT => 1; use constant T_VARIABLE => 2; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( EULER PI B_SUM B_DIFFERENCE B_PRODUCT B_DIVISION B_EXP B_LOG U_MINUS U_P_DERIVATIVE U_T_DERIVATIVE U_SINE U_COSINE U_TANGENT U_COTANGENT U_ARCSINE U_ARCCOSINE U_ARCTANGENT U_ARCCOTANGENT U_SINE_H U_COSINE_H U_AREASINE_H U_AREACOSINE_H B_ARCTANGENT_TWO T_OPERATOR T_CONSTANT T_VARIABLE ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.612'; 1; __END__ =head1 NAME Math::Symbolic::ExportConstants - Export constants used for Math::Symbolic =head1 SYNOPSIS use Math::Symbolic::ExportConstants qw/:all/; =head1 DESCRIPTION This just exports a number of constants on demand. Usually, you'd want to rather use Math::Symbolic instead. Math::Symbolic allows you to optionally export the same constants as this module, but using the ':constants' tag instead of the ':all' tag that you'd have to use with this module. Please refer to the documentation of the Math::Symbolic module for a list of constants. =head2 EXPORT None by default. But since exporting symbols is the only functionality of this module, you'll want to export the :all group of constants. =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Operator.pm000444001750001750 10177612157534055 21046 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Operator - Operators in symbolic calculations =head1 SYNOPSIS use Math::Symbolic::Operator; my $sum = Math::Symbolic::Operator->new('+', $term1, $term2); # or: my $division = Math::Symbolic::Operator->new( { type => B_DIVISON, operands => [$term1, $term2], } ); my $derivative = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [$term], } ); =head1 DESCRIPTION This module implements all Math::Symbolic::Operator objects. These objects are overloaded in stringification-context to call the to_string() method on the object. In numeric and boolean context, they evaluate to their numerical representation. For a list of supported operators, please refer to the list found below, in the documentation for the new() constructor. Math::Symbolic::Operator inherits from Math::Symbolic::Base. =head2 EXPORT None. =cut package Math::Symbolic::Operator; use 5.006; use strict; use warnings; no warnings 'recursion'; use Carp; use Math::Symbolic::ExportConstants qw/:all/; use Math::Symbolic::Derivative qw//; use base 'Math::Symbolic::Base'; our $VERSION = '0.612'; =head1 CLASS DATA Math::Symbolic::Operator contains several class data structures. Usually, you should not worry about dealing with any of them because they are mostly an implementation detail, but for the sake of completeness, here's the gist, but feel free to skip this section of the docs: One of these is the %Op_Symbols hash that associates operator (and function) symbols with the corresponding constant as exported by Math::Symbolic or Math::Symbolic::ExportConstants. (For example, '+' => B_SUM which in turn is 0, if I recall correctly. But I didn't tell you that. Because you're supposed to use the supplied (inlined and hence fast) constants so I can change their internal order if I deem it necessary.) =cut our %Op_Symbols = ( '+' => B_SUM, '-' => B_DIFFERENCE, '*' => B_PRODUCT, '/' => B_DIVISION, 'log' => B_LOG, '^' => B_EXP, 'neg' => U_MINUS, 'partial_derivative' => U_P_DERIVATIVE, 'total_derivative' => U_T_DERIVATIVE, 'sin' => U_SINE, 'cos' => U_COSINE, 'tan' => U_TANGENT, 'cot' => U_COTANGENT, 'asin' => U_ARCSINE, 'acos' => U_ARCCOSINE, 'atan' => U_ARCTANGENT, 'acot' => U_ARCCOTANGENT, 'sinh' => U_SINE_H, 'cosh' => U_COSINE_H, 'asinh' => U_AREASINE_H, 'acosh' => U_AREACOSINE_H, 'atan2' => B_ARCTANGENT_TWO, ); =pod The array @Op_Types associates operator indices (recall those nifty constants?) with anonymous hash datastructures that contain some info on the operator such as its arity, the rule used to derive it, its infix string, its prefix string, and information on how to actually apply it to numbers. =cut our @Op_Types = ( # B_SUM { arity => 2, derive => 'each operand', infix_string => '+', prefix_string => 'add', application => '$_[0] + $_[1]', commutative => 1, }, # B_DIFFERENCE { arity => 2, derive => 'each operand', infix_string => '-', prefix_string => 'subtract', application => '$_[0] - $_[1]', #commutative => 0, }, # B_PRODUCT { arity => 2, derive => 'product rule', infix_string => '*', prefix_string => 'multiply', application => '$_[0] * $_[1]', commutative => 1, }, # B_DIVISION { derive => 'quotient rule', arity => 2, infix_string => '/', prefix_string => 'divide', application => '$_[0] / $_[1]', #commutative => 0, }, # U_MINUS { arity => 1, derive => 'each operand', infix_string => '-', prefix_string => 'negate', application => '-$_[0]', }, # U_P_DERIVATIVE { arity => 2, derive => 'derivative commutation', infix_string => undef, prefix_string => 'partial_derivative', application => \&Math::Symbolic::Derivative::partial_derivative, }, # U_T_DERIVATIVE { arity => 2, derive => 'derivative commutation', infix_string => undef, prefix_string => 'total_derivative', application => \&Math::Symbolic::Derivative::total_derivative, }, # B_EXP { arity => 2, derive => 'logarithmic chain rule after ln', infix_string => '^', prefix_string => 'exponentiate', application => '$_[0] ** $_[1]', #commutative => 0, }, # B_LOG { arity => 2, derive => 'logarithmic chain rule', infix_string => undef, prefix_string => 'log', application => 'log($_[1]) / log($_[0])', #commutative => 0, }, # U_SINE { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'sin', application => 'sin($_[0])', }, # U_COSINE { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'cos', application => 'cos($_[0])', }, # U_TANGENT { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'tan', application => 'sin($_[0])/cos($_[0])', }, # U_COTANGENT { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'cot', application => 'cos($_[0])/sin($_[0])', }, # U_ARCSINE { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'asin', #application => 'Math::Symbolic::AuxFunctions::asin($_[0])', application => 'atan2( $_[0], sqrt( 1 - $_[0] * $_[0] ) )', }, # U_ARCCOSINE { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'acos', application => 'atan2( sqrt( 1 - $_[0] * $_[0] ), $_[0] ) ', #application => 'Math::Symbolic::AuxFunctions::acos($_[0])', }, # U_ARCTANGENT { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'atan', application => 'atan2($_[0], 1)', #application => 'Math::Symbolic::AuxFunctions::atan($_[0])', }, # U_ARCCOTANGENT { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'acot', application => 'atan2(1 / $_[0], 1)', #application => 'Math::Symbolic::AuxFunctions::acot($_[0])', }, # U_SINE_H { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'sinh', #application => '0.5*(EULER**$_[0] - EULER**(-$_[0]))', application => '0.5*('.EULER.'**$_[0] - '.EULER.'**(-$_[0]))', }, # U_COSINE_H { arity => 1, derive => 'trigonometric derivatives', infix_string => undef, prefix_string => 'cosh', application => '0.5*('.EULER.'**$_[0] + '.EULER.'**(-$_[0]))', #application => '0.5*(EULER**$_[0] + EULER**(-$_[0]))', }, # U_AREASINE_H { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'asinh', application => 'log( $_[0] + sqrt( $_[0] * $_[0] + 1 ) ) ', #application => 'Math::Symbolic::AuxFunctions::asinh($_[0])', }, # U_AREACOSINE_H { arity => 1, derive => 'inverse trigonometric derivatives', infix_string => undef, prefix_string => 'acosh', application => 'log( $_[0] + sqrt( $_[0] * $_[0] - 1 ) ) ', #application => 'Math::Symbolic::AuxFunctions::acosh($_[0])', }, # B_ARCTANGENT_TWO { arity => 2, derive => 'inverse atan2', infix_string => undef, prefix_string => 'atan2', application => 'atan2($_[0], $_[1])', #application => 'Math::Symbolic::AuxFunctions::atan($_[0])', #commutative => 0, }, ); =head1 METHODS =head2 Constructor new Expects a hash reference as first argument. That hash's contents will be treated as key-value pairs of object attributes. Important attributes are 'type' => OPERATORTYPE (use constants as exported by Math::Symbolic::ExportConstants!) and 'operands=>[op1,op2,...]'. Where the operands themselves may either be valid Math::Symbolic::* objects or strings that will be parsed as such. Special case: if no hash reference was found, first argument is assumed to be the operator's symbol and the operator is assumed to be binary. The following 2 arguments will be treated as operands. This special case will ignore attempts to clone objects but if the operands are no valid Math::Symbolic::* objects, they will be sent through a Math::Symbolic::Parser to construct Math::Symbolic trees. Returns a Math::Symbolic::Operator. Supported operator symbols: (number of operands and their function in parens) + => sum (2) - => difference (2) * => product (2) / => division (2) log => logarithm (2: base, function) ^ => exponentiation (2: base, exponent) neg => unary minus (1) partial_derivative => partial derivative (2: function, var) total_derivative => total derivative (2: function, var) sin => sine (1) cos => cosine (1) tan => tangent (1) cot => cotangent (1) asin => arc sine (1) acos => arc cosine (1) atan => arc tangent (1) atan2 => arc tangent of y/x (2: y, x) acot => arc cotangent (1) sinh => hyperbolic sine (1) cosh => hyperbolic cosine (1) asinh => hyperbolic area sine (1) acosh => hyperbolic area cosine (1) =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; if ( @_ and not( ref( $_[0] ) eq 'HASH' ) ) { my $symbol = shift; my $type = $Op_Symbols{$symbol}; croak "Invalid operator type specified ($symbol)." unless defined $type; my $operands = [ @_[ 0 .. $Op_Types[$type]{arity} - 1 ] ]; croak "Undefined operands not supported by " . "Math::Symbolic::Operator objects." if grep +( not defined($_) ), @$operands; @$operands = map { ref($_) =~ /^Math::Symbolic/ ? $_ : Math::Symbolic::parse_from_string($_) } @$operands; return bless { type => $type, operands => $operands, } => $class; } my %args; %args = %{ $_[0] } if @_; # and ref( $_[0] ) eq 'HASH'; # above condition isn't necessary since that'd otherwise have been # the above branch. my $operands = []; if ( ref $proto ) { foreach ( @{ $proto->{operands} } ) { push @$operands, $_->new(); } } my $self = { type => undef, ( ref($proto) ? %$proto : () ), operands => $operands, %args, }; @{ $self->{operands} } = map { ref($_) =~ /^Math::Symbolic/ ? $_ : Math::Symbolic::parse_from_string($_) } @{ $self->{operands} }; bless $self => $class; } =head2 Method arity Returns the operator's arity as an integer. =cut sub arity { my $self = shift; return $Op_Types[ $self->{type} ]{arity}; } =head2 Method type Optional integer argument that sets the operator's type. Returns the operator's type as an integer. =cut sub type { my $self = shift; $self->{type} = shift if @_; return $self->{type}; } =head2 Method to_string Returns a string representation of the operator and its operands. Optional argument: 'prefix' or 'infix'. Defaults to 'infix'. =cut sub to_string { my $self = shift; my $string_type = shift; $string_type = 'infix' unless defined $string_type and $string_type eq 'prefix'; no warnings 'recursion'; my $string = ''; if ( $string_type eq 'prefix' ) { $string .= $self->_to_string_prefix(); } else { $string .= $self->_to_string_infix(); } return $string; } sub _to_string_infix { my $self = shift; my $op = $Op_Types[ $self->{type} ]; my $op_str = $op->{infix_string}; my $string; if ( $op->{arity} == 2 ) { my $op1 = $self->{operands}[0]->term_type() == T_OPERATOR; my $op2 = $self->{operands}[1]->term_type() == T_OPERATOR; if ( not defined $op_str ) { $op_str = $op->{prefix_string}; $string = "$op_str("; $string .= join( ', ', map { $_->to_string('infix') } @{ $self->{operands} } ); $string .= ')'; } else { $string = ( $op1 ? '(' : '' ) . $self->{operands}[0]->to_string('infix') . ( $op1 ? ')' : '' ) . " $op_str " . ( $op2 ? '(' : '' ) . $self->{operands}[1]->to_string('infix') . ( $op2 ? ')' : '' ); } } elsif ( $op->{arity} == 1 ) { my $is_op1 = $self->{operands}[0]->term_type() == T_OPERATOR; if ( not defined $op_str ) { $op_str = $op->{prefix_string}; $string = "$op_str(" . $self->{operands}[0]->to_string('infix') . ")"; } else { $string = "$op_str" . ( $is_op1 ? '(' : '' ) . $self->{operands}[0]->to_string('infix') . ( $is_op1 ? ')' : '' ); } } else { $string = $self->_to_string_prefix(); } return $string; } sub _to_string_prefix { my $self = shift; my $op = $Op_Types[ $self->{type} ]; my $op_str = $op->{prefix_string}; my $string = "$op_str("; $string .= join( ', ', map { $_->to_string('prefix') } @{ $self->{operands} } ); $string .= ')'; return $string; } =head2 Method term_type Returns the type of the term. ( T_OPERATOR ) =cut sub term_type {T_OPERATOR} =head2 Method simplify Term simpilification. First argument: Boolean indicating that the tree does not need to be cloned, but can be restructured instead. While this is faster, you might not be able to use the old tree any more. Example: my $othertree = $tree->simplify(); # can use $othertree and $tree now. my $yetanothertree = $tree->simplify(1); # must not use $tree any more because its internal # representation might have been destroyed. If you want to optimize a routine and you're sure that you won't need the unsimplified tree any more, go ahead and use the first parameter. In all other cases, you should go the safe route. =cut sub simplify { my $self = shift; my $dont_clone = shift; $self = $self->new() unless $dont_clone; my $operands = $self->{operands}; my $op = $Op_Types[ $self->type() ]; # simplify operands without cloning. @$operands = map { $_->simplify(1) } @$operands; if ( $self->arity() == 2 ) { my $o1 = $operands->[0]; my $o2 = $operands->[1]; my $tt1 = $o1->term_type(); my $tt2 = $o2->term_type(); my $type = $self->type(); if ( $self->is_simple_constant() ) { return $self->apply(); } if ( $o1->is_identical($o2) ) { if ( $type == B_PRODUCT ) { my $two = Math::Symbolic::Constant->new(2); return $self->new( '^', $o1, $two )->simplify(1); } elsif ( $type == B_SUM ) { my $two = Math::Symbolic::Constant->new(2); return $self->new( '*', $two, $o1 )->simplify(1); } elsif ( $type == B_DIVISION ) { croak "Symbolic division by zero." if $o2->term_type() == T_CONSTANT and ($o2->value() == 0 or $o2->special() eq 'zero' ); return Math::Symbolic::Constant->one(); } elsif ( $type == B_DIFFERENCE ) { return Math::Symbolic::Constant->zero(); } } # exp(0) = 1 if ( $tt2 == T_CONSTANT and $tt1 == T_OPERATOR and $type == B_EXP and $o2->value() == 0 ) { return Math::Symbolic::Constant->one(); } # a^1 = a if ( $tt2 == T_CONSTANT and $type == B_EXP and ( $o2->value() == 1 or $o2->special() eq 'one' ) ) { return $o1; } # (a^b)^const = a^(const*b) if ( $tt2 == T_CONSTANT and $tt1 == T_OPERATOR and $type == B_EXP and $o1->type() == B_EXP ) { return $self->new( '^', $o1->op1(), $self->new( '*', $o2, $o1->op2() ) )->simplify(1); } # redundant # if ( $tt1 == T_VARIABLE # and $tt2 == T_VARIABLE # and $o1->name() eq $o2->name() ) # { # if ( $type == B_SUM ) { # my $two = Math::Symbolic::Constant->new(2); # return $self->new( '*', $two, $o1 ); # } # elsif ( $type == B_DIFFERENCE ) { # return Math::Symbolic::Constant->zero(); # } # elsif ( $type == B_PRODUCT ) { # my $two = Math::Symbolic::Constant->new(2); # return $self->new( '^', $o1, $two ); # } # elsif ( $type == B_DIVISION ) { # return Math::Symbolic::Constant->one(); # } # } if ( $tt1 == T_CONSTANT or $tt2 == T_CONSTANT ) { my $const = ( $tt1 == T_CONSTANT ? $o1 : $o2 ); my $not_c = ( $tt1 == T_CONSTANT ? $o2 : $o1 ); my $constant_first = $tt1 == T_CONSTANT; if ( $type == B_SUM ) { return $not_c if $const->value() == 0; return $not_c->mod_add_constant($const); } if ( $type == B_DIFFERENCE ) { if (!$constant_first) { my $value = $const->value(); return $not_c if $value == 0; return $not_c->mod_add_constant(-$value); } if ( $constant_first and $const->value == 0 ) { return Math::Symbolic::Operator->new( { type => U_MINUS, operands => [$not_c], } ); } } if ( $type == B_PRODUCT ) { return $not_c if $const->value() == 1; return Math::Symbolic::Constant->zero() if $const->value == 0; if ( $not_c->term_type() == T_OPERATOR and $not_c->type() == B_PRODUCT and $not_c->op1()->term_type() == T_CONSTANT || $not_c->op2()->term_type() == T_CONSTANT ) { my ( $c, $nc ) = ( $not_c->op1()->term_type() == T_CONSTANT ? ( $not_c->op1, $not_c->op2 ) : ( $not_c->op2, $not_c->op1 ) ); my $c_product = $not_c->new( '*', $const, $c )->apply(); return $not_c->new( '*', $c_product, $nc ); } elsif ( $not_c->term_type() == T_OPERATOR and $not_c->type() == B_DIVISION and $not_c->op1()->term_type() == T_CONSTANT ) { return Math::Symbolic::Operator->new( '/', Math::Symbolic::Constant->new( $const->value() * $not_c->op1()->value() ), $not_c->op2() ); } } elsif ( $type == B_DIVISION ) { return $not_c if !$constant_first and $const->value == 1; return Math::Symbolic::Constant->new('#Inf') if !$constant_first and $const->value == 0; return Math::Symbolic::Constant->zero() if $const->value == 0; } } elsif ( $type == B_PRODUCT ) { if ( $tt2 == T_CONSTANT ) { return $o1->mod_multiply_constant($o2); } elsif ( $tt1 == T_CONSTANT ) { return $o2->mod_multiply_constant($o1); } elsif ( $tt1 == T_OPERATOR and $tt2 == T_VARIABLE ) { return $self->new( '*', $o2, $o1 ); } } if ( $type == B_SUM ) { my @ops; my @const; my @todo = ( $o1, $o2 ); my %vars; while (@todo) { my $this = shift @todo; if ( $this->term_type() == T_OPERATOR ) { my $t = $this->type(); if ( $t == B_SUM ) { push @todo, @{ $this->{operands} }; } elsif ( $t == B_DIFFERENCE ) { push @todo, $this->op1(), Math::Symbolic::Operator->new( 'neg', $this->op2() ); } elsif ( $t == U_MINUS ) { my $op = $this->op1(); my $tt = $op->term_type(); if ( $tt == T_VARIABLE ) { $vars{$op->name}--; } elsif ( $tt == T_CONSTANT ) { push @const, $todo[0]->value(); } else { my $ti = $op->type(); if ( $ti == U_MINUS ) { push @todo, $op->op1(); } elsif ( $ti == B_SUM ) { push @todo, Math::Symbolic::Operator->new( 'neg', $op->op1() ), Math::Symbolic::Operator->new( 'neg', $op->op2() ); } elsif ( $ti == B_DIFFERENCE ) { push @todo, $op->op2(), Math::Symbolic::Operator->new( 'neg', $op->op1() ); } else { push @ops, $this; } } } elsif ( $t == B_PRODUCT ) { my ($o1, $o2) = @{$this->{operands}}; my $tl = $o1->term_type(); my $tr = $o2->term_type(); if ($tl == T_VARIABLE and $tr == T_CONSTANT) { $vars{$o1->name}+= $o2->value(); } elsif ($tr == T_VARIABLE and $tl == T_CONSTANT) { $vars{$o2->name}+= $o1->value(); } else { push @ops, $this; } } else { push @ops, $this; } } elsif ( $this->term_type() == T_VARIABLE ) { $vars{$this->name}++; } else { push @const, $this->value(); } } my @vars = (); foreach (keys %vars) { my $num = $vars{$_}; if (!$num) { next; } if ($num == 1) { push @vars, Math::Symbolic::Variable->new($_); next; } my $mul = Math::Symbolic::Operator->new( '*', Math::Symbolic::Constant->new(abs($num)), Math::Symbolic::Variable->new($_) ); push @ops, $num < 0 ? Math::Symbolic::Operator->new('neg', $mul) : $mul; } my $const; $const = Math::Symbolic::Constant->new($const) if defined $const and $const != 0; $const = shift @vars if not defined $const; foreach ( @vars ) { $const = Math::Symbolic::Operator->new('+', $const, $_); } @ops = map {$_->simplify(1)} @ops; my @newops; push @newops, $const if defined $const; foreach my $out ( 0 .. $#ops ) { next if not defined $ops[$out]; my $identical = 0; foreach my $in ( 0 .. $#ops ) { next if $in == $out or not defined $ops[$in]; if ( $ops[$out]->is_identical( $ops[$in] ) ) { $identical++; $ops[$in] = undef; } } if ( not $identical ) { push @newops, $ops[$out]; } else { push @newops, Math::Symbolic::Operator->new( '*', $identical + 1, $ops[$out] ); } } my $sumops; if (@newops) { $sumops = shift @newops; $sumops += $_ foreach @newops; } else {return Math::Symbolic::Constant->zero()} return $sumops; } } elsif ( $self->arity() == 1 ) { my $o = $operands->[0]; my $tt = $o->term_type(); my $type = $self->type(); if ( $type == U_MINUS ) { if ( $tt == T_CONSTANT ) { return Math::Symbolic::Constant->new( -$o->value(), ); } elsif ( $tt == T_OPERATOR ) { my $inner_type = $o->type(); if ( $inner_type == U_MINUS ) { return $o->{operands}[0]; } elsif ( $inner_type == B_DIFFERENCE ) { return $o->new( '-', @{$o->{operands}}[1,0] ); } } } } return $self; } =head2 Methods op1 and op2 Returns first/second operand of the operator if it exists or undef. =cut sub op1 { return $_[0]{operands}[0] if @{ $_[0]{operands} } >= 1; return undef; } sub op2 { return $_[0]{operands}[1] if @{ $_[0]{operands} } >= 2; } =head2 Method apply Applies the operation to its operands' value() and returns the result as a constant (-object). Without arguments, all variables in the tree are required to have a value. If any don't, the call to apply() returns undef. To (temorarily, for this single method call) assign values to variables in the tree, you may provide key/value pairs of variable names and values. Instead of passing a list of key/value pairs, you may also pass a single hash reference containing the variable mappings. You usually want to call the value() instead of this. =cut sub apply { my $self = shift; my $args = ( @_ == 1 ? $_[0] : +{ @_ } ); my $op_type = $self->type(); my $op = $Op_Types[$op_type]; my $operands = $self->{operands}; my $application = $op->{application}; if ( ref($application) ne 'CODE' ) { local @_; local $@; eval { @_ = map { my $v = $_->value($args); ( defined $v ? $v : croak "Undefined operand in Math::Symbolic::Operator->apply()" ) } @$operands; }; return undef if $@; return undef if $op_type == B_DIVISION and $_[1] == 0; my $result = eval $application; die "Invalid operator application: $@" if $@; die "Undefined result from operator application." if not defined $result; return Math::Symbolic::Constant->new($result); } else { return $application->(@$operands); } } =head2 Method value value() evaluates the Math::Symbolic tree to its numeric representation. value() without arguments requires that every variable in the tree contains a defined value attribute. Please note that this refers to every variable I, not just every named variable. value() with one argument sets the object's value if you're dealing with Variables or Constants. In case of operators, a call with one argument will assume that the argument is a hash reference. (see next paragraph) value() with named arguments (key/value pairs) associates variables in the tree with the value-arguments if the corresponging key matches the variable name. (Can one say this any more complicated?) Since version 0.132, an equivalent and valid syntax is to pass a single hash reference instead of a list. Example: $tree->value(x => 1, y => 2, z => 3, t => 0) assigns the value 1 to any occurrances of variables of the name "x", aso. If a variable in the tree has no value set (and no argument of value sets it temporarily), the call to value() returns undef. =cut sub value { my $self = shift; my $args = ( @_ == 1 ? $_[0] : +{@_} ); my $applied = $self->apply($args); return undef unless defined $applied; return $applied->value($args); } =head2 Method signature signature() returns a tree's signature. In the context of Math::Symbolic, signatures are the list of variables any given tree depends on. That means the tree "v*t+x" depends on the variables v, t, and x. Thus, applying signature() on the tree that would be parsed from above example yields the sorted list ('t', 'v', 'x'). Constants do not depend on any variables and therefore return the empty list. Obviously, operators' dependencies vary. Math::Symbolic::Variable objects, however, may have a slightly more involved signature. By convention, Math::Symbolic variables depend on themselves. That means their signature contains their own name. But they can also depend on various other variables because variables themselves can be viewed as placeholders for more compicated terms. For example in mechanics, the acceleration of a particle depends on its mass and the sum of all forces acting on it. So the variable 'acceleration' would have the signature ('acceleration', 'force1', 'force2',..., 'mass', 'time'). If you're just looking for a list of the names of all variables in the tree, you should use the explicit_signature() method instead. =cut sub signature { my $self = shift; my %sig; foreach my $o ( $self->descending_operands('all_vars') ) { $sig{$_} = undef for $o->signature(); } return sort keys %sig; } =head2 Method explicit_signature explicit_signature() returns a lexicographically sorted list of variable names in the tree. See also: signature(). =cut sub explicit_signature { my $self = shift; my %sig; foreach my $o ( $self->descending_operands('all_vars') ) { $sig{$_} = undef for $o->explicit_signature(); } return sort keys %sig; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Compiler.pm000444001750001750 2513112157534055 20773 0ustar00tseetsee000000000000=encoding utf8 =head1 NAME Math::Symbolic::Compiler - Compile Math::Symbolic trees to Perl code =head1 SYNOPSIS use Math::Symbolic::Compiler; # A tree to compile my $tree = Math::Symbolic->parse_from_string('a^2 + b * c * 2'); # The Math::Symbolic::Variable 'a' will be evaluated to $_[1], etc. my $vars = [qw(b a c)]; my ($closure, $code, $trees) = Math::Symbolic::Compiler->compile($tree, $vars); print $closure->(2, 3, 5); # (b, a, c) # prints 29 (= 3^2 + 2 * 5 * 2) # or: ($closure, $trees) = Math::Symbolic::Compiler->compile_to_sub($tree, $vars); ($code, $trees) = Math::Symbolic::Compiler->compile_to_code($tree, $vars); =head1 DESCRIPTION This module allows one to compile Math::Symbolic trees to Perl code and/or anonymous subroutines whose arguments will be positionally mapped to the variables of the compiled Math::Symbolic tree. The reason you'd want to do this is that evaluating a Math::Symbolic tree to its numeric value is extremely slow. So is compiling, but once you've done all necessary symbolic calculations, you can take advantage of the speed gain of invoking a closure instead of evaluating a tree. =head2 UNCOMPILED LEFTOVER TREES Not all, however, is well in the land of compiled Math::Symbolic trees. There may occasionally be trees that cannot be compiled (such as a derivative) which need to be included into the code as trees. These trees will be returned in a referenced array by the compile*() methods. The closures will have access to the required trees as a special variable '@_TREES inside the closure's scope, so you need not worry about them in that case. But if you plan to use the generated code itself, you need to supply an array named @_TREES that contains the trees as returned by the compile*() methods in the scope of the eval() you evaluate the code with. Note that you give away all performance benefits compiling the tree might have if the closure contains uncompiled trees. You can tell there are any by checking the length of the referenced array that contains the trees. If it's 0, then there are no trees left to worry about. =head2 AVOIDING LEFTOVER TREES In most cases, this is pretty simple. Just apply all derivatives in the tree to make sure that there are none left in the tree. As of version 0.130, there is no operator except derivatives that cannot be compiled. There may, however, be some operators you cannot get rid of this easily some time in the future. If you have problems getting a tree to compile, try using the means of simplification provided by Math::Symbolic::* to get a simpler tree for compilation. =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 standard Exporter semantics including the ':all' tag. =head1 SUBROUTINES =cut package Math::Symbolic::Compiler; use 5.006; use strict; use warnings; use Math::Symbolic::ExportConstants qw/:all/; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( compile compile_to_sub compile_to_code ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.612'; =head2 ($code, $trees) = compile_to_code($tree, $vars) The compile_to_code() class method takes one mandatory argument which is the Math::Symbolic tree to be compiled. Second argument is optional and an array reference to an array of variable mappings. See L for details on how this works. compile_to_code() returns a string and an array reference. The string contains the compiled Perl code that uses the values stored in @_ as described in the section on positional variable passing. It also accesses a special variable @_TREES if there were any sub-trees (inside the tree that has been compiled) that were impossible to compile. The array reference returned by this method contains any of the aforementioned trees that failed to compile. If there are any such trees that did not compile, you may put them into the @_TREES variable in scope of the eval() that evaluates the compiled code in the same order that they were returned by this method. If you do that, the code will run and determine the value of the tree at run-time. Needless to say, that is slow. =cut sub compile_to_code { 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 $code = _rec_ms_to_sub( $tree, \%vars, \@trees ); return ( $code, \@trees ); } =head2 ($sub, $trees) = compile_to_sub($tree, $vars) The compile_to_sub() class method takes one mandatory argument which is the Math::Symbolic tree to be compiled. Second argument is optional and an array reference to an array of variable mappings. See L for details on how this works. compile_to_sub() returns a list of two elements, the first being the compiled anonymous subroutine. For details on the second element, please refer to the docs on the compile_to_code() subroutine. =cut sub compile_to_sub { my ( $code, $trees ) = Math::Symbolic::Compiler::compile_to_code(@_); my $sub = _compile_sub( 'sub {' . $code . '}', @$trees ); return ( $sub, $trees ); } =head2 ($sub, $code, $trees) = compile($tree, $vars) The compile() class method takes one mandatory argument which is the Math::Symbolic tree to be compiled. Second argument is optional and an array reference to an array of variable mappings. See L for details on how this works. compile() returns a list of three elements, the first being the compiled anonymous subroutine, the second being the compiled code. For details on the second and third elements, please refer to the docs on the compile_to_code() subroutine. =cut sub compile { my ( $code, $trees ) = Math::Symbolic::Compiler::compile_to_code(@_); my $sub = _compile_sub( 'sub {' . $code . '}', @$trees ); return ( $sub, $code, $trees ); } sub _compile_sub { my @_TREES; @_TREES = @_[ 1 .. $#_ ] if @_ > 1; my $sub = eval $_[0]; die "$@" if $@; return $sub; } sub _rec_ms_to_sub { my $tree = shift; my $vars = shift; my $trees = shift; my $code = ''; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT ) { $code .= $tree->value(); } elsif ( $ttype == T_VARIABLE ) { $code .= '$_[' . $vars->{ $tree->name() } . ']'; } else { my $type = $tree->type(); my $otype = $Math::Symbolic::Operator::Op_Types[$type]; my $app = $otype->{application}; if ( ref($app) eq 'CODE' ) { push @$trees, $tree->new(); my $arg_str = join( ', ', map { "'$_' => \$_[" . $vars->{$_} . ']' } keys %$vars ); my $index = $#$trees; $code .= <value($arg_str)) HERE } else { my @app = split /\$_\[(\d+)\]/, $app; if ( @app > 1 ) { for ( my $i = 1 ; $i < @app ; $i += 2 ) { $app[$i] = '(' . _rec_ms_to_sub( $tree->{operands}[ $app[$i] ], $vars, $trees ) . ')'; } } $code .= join '', @app; } } return $code; } 1; __END__ =head2 VARIABLE PASSING STYLES Currently, the Math::Symbolic compiler only supports compiling to subs with positional variable passing. At some point, the user should be able to choose between positional- and named variable passing styles. The difference is best explained by an example: # positional: $sub->(4, 5, 1); # named: (NOT IMPLEMENTED!) $sub->(a => 5, b => 4, x => 1); With positional variable passing, the subroutine statically maps its arguments to its internal variables. The way the subroutine does that has been fixed at compile-time. It is determined by the second argument to the various compile_* functions found in this package. This second argument is expected to be a reference to an array of variable names. The order of the variable names determines which parameter of the compiled sub will be assigned to the variable. Example: my ($sub) = Math::Symbolic::Compiler->compile_to_sub($tree, [qw/c a b/]); # First argument will be mapped to c, second to a, and third to b # All others will be ignored. $sub->(4, 5, 6, 7); # Variable mapping: a = 5, b = 6, c = 4 One important note remains: if any (or all) variables in the tree are unaccounted for, they will be lexicographically sorted and appended to the variable mapping in that order. That means if you don't map variables yourself, they will be sorted lexicographically. Thanks to Henrik Edlund's input, it's possible to pass a hash reference as second argument to the compile* functions instead of an array reference. The order of the mapped variables is then determined by their associated value, which should be an integer starting with 0. Example: Math::Symbolic::Compiler->compile_to_sub($tree, {b => 2, a => 1, c => 0}); Would result in the order c, a, b. =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Custom000755001750001750 012157534055 17756 5ustar00tseetsee000000000000Math-Symbolic-0.612/lib/Math/Symbolic/Custom/DefaultMods.pm000444001750001750 2763112157534055 22711 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Custom::DefaultMods - Default Math::Symbolic transformations =head1 SYNOPSIS use Math::Symbolic; =head1 DESCRIPTION This is a class of default transformations for Math::Symbolic trees. Likewise, Math::Symbolic::Custom::DefaultTests defines default tree testing routines. For details on how the custom method delegation model works, please have a look at the Math::Symbolic::Custom and Math::Symbolic::Custom::Base classes. =head2 EXPORT Please see the docs for Math::Symbolic::Custom::Base for details, but you should not try to use the standard Exporter semantics with this class. =head1 SUBROUTINES =cut package Math::Symbolic::Custom::DefaultMods; use 5.006; use strict; use warnings; no warnings 'recursion'; our $VERSION = '0.612'; use Math::Symbolic::Custom::Base; BEGIN { *import = \&Math::Symbolic::Custom::Base::aggregate_import } use Math::Symbolic::ExportConstants qw/:all/; use Carp; # Class Data: Special variable required by Math::Symbolic::Custom # importing/exporting functionality. # All subroutines that are to be exported to the Math::Symbolic::Custom # namespace should be listed here. our $Aggregate_Export = [ qw/ apply_derivatives apply_constant_fold mod_add_constant mod_multiply_constant / ]; =head2 apply_derivatives() Never modifies the tree in-place, but returns a modified copy of the original tree instead. Applied to variables and constants, this method just clones. Applied to operators and if the operator is a derivative, this applies the derivative to the derivative's first operand. Regardless what kind of operator this is called on, apply_derivatives will be applied recursively on its operands. If the first parameter to this function is an integer, at maximum that number of derivatives are applied (from top down the tree if possible). =cut sub apply_derivatives { my $tree = shift; my $n = shift || -1; return $tree->descend( in_place => 0, before => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT || $ttype == T_VARIABLE ) { return undef; } elsif ( $ttype == T_OPERATOR ) { my $max_derivatives = $n; my $type = $tree->type(); while ( $n && ( $type == U_P_DERIVATIVE or $type == U_T_DERIVATIVE ) ) { my $op = $Math::Symbolic::Operator::Op_Types[$type]; my $operands = $tree->{operands}; my $application = $op->{application}; if ( $type == U_T_DERIVATIVE and $operands->[0]->term_type() == T_VARIABLE ) { my @sig = $operands->[0]->signature(); my $name = $operands->[1]->name(); if ( ( grep { $_ eq $name } @sig ) > 0 and not(@sig == 1 and $sig[0] eq $name ) ) { return undef; } } $tree->replace( $application->(@$operands) ); return undef unless $tree->term_type() == T_OPERATOR; $type = $tree->type(); $n--; } return (); } else { croak "apply_derivatives called on invalid " . "tree type."; } die "Sanity check in apply_derivatives() should not " . "be reached."; }, ); } =head2 apply_constant_fold() Does not modify the tree in-place by default, but returns a modified copy of the original tree instead. If the first argument is true, the tree will not be cloned. If it is false or not existant, the tree will be cloned. Applied to variables and constants, this method just clones. Applied to operators, all tree segments that contain constants and operators only will be replaced with Constant objects. =cut sub apply_constant_fold { my $tree = shift; my $in_place = shift; return $tree->descend( in_place => $in_place, before => sub { my $tree = shift; if ( $tree->is_simple_constant() ) { $tree->replace( $tree->apply() ) unless $tree->term_type() == T_CONSTANT; return undef; } return undef if $tree->term_type() == T_VARIABLE; return { in_place => 1, descend_into => [] }; } ); return $tree; } =head2 mod_add_constant Given a constant (object or number) as argument, this method tries hard to fold it into an existing constant of the object this is called on is already a sum or a difference. Basically, this is the same as C<$tree + $constant> but does some simplification. =cut sub mod_add_constant { my $tree = shift; my $constant = shift; return $tree if not $constant; $constant = $constant->value() if ref($constant); my $tt = $tree->term_type(); if ($tt == T_CONSTANT) { return Math::Symbolic::Constant->new($tree->{value}+$constant); } elsif ($tt == T_OPERATOR) { my $type = $tree->type(); if ($type == B_SUM || $type == B_DIFFERENCE) { my $ops = $tree->{operands}; my $const_op; if ($ops->[0]->is_simple_constant()) { $const_op = 0; } elsif ($ops->[1]->is_simple_constant()) { $const_op = 1; } if (defined $const_op) { my $value = $ops->[$const_op]->value(); my $other = $ops->[($const_op+1)%2]; if ($const_op == 0) { $value += $constant; } else { # second $value = $type==B_SUM ? $value + $constant : $value - $constant; } if ($value == 0) { return $other if $const_op == 1 or $type == B_SUM; return Math::Symbolic::Constant->new(-$other->{value}); } return Math::Symbolic::Operator->new( ($type == B_DIFFERENCE ? '-' : '+'), # op-type $const_op == 0 # order of ops ?($value, $other) :($other, $value) ); } if ($ops->[1]->term_type() == T_OPERATOR) { my $otype = $ops->[1]->type(); if ($otype == B_SUM || $otype == B_DIFFERENCE) { return Math::Symbolic::Operator->new( ($type == B_SUM ? '+' : '-'), $ops->[0], $ops->[1]->mod_add_constant($constant) ); } } else { return Math::Symbolic::Operator->new( ($type == B_SUM ? '+' : '-'), $ops->[0]->mod_add_constant($constant), $ops->[1], ); } } } # fallback: variable, didn't apply, etc. return Math::Symbolic::Operator->new( '+', Math::Symbolic::Constant->new($constant), $tree ); } =head2 mod_multiply_constant Given a constant (object or number) as argument, this method tries hard to fold it into an existing constant of the object this is called on is already a product or a division. Basically, this is the same as C<$tree * $constant> but does some simplification. =cut sub mod_multiply_constant { my $tree = shift; my $constant = shift; return $tree if not defined $constant; $constant = $constant->value() if ref($constant); return $tree if $constant == 1; return Math::Symbolic::Constant->zero() if $constant == 0; my $tt = $tree->term_type(); if ($tt == T_CONSTANT) { return Math::Symbolic::Constant->new($tree->{value}*$constant); } elsif ($tt == T_OPERATOR) { my $type = $tree->type(); if ($type == B_PRODUCT || $type == B_DIVISION) { my $ops = $tree->{operands}; my $const_op; if ($ops->[0]->is_simple_constant()) { $const_op = 0; } elsif ($ops->[1]->is_simple_constant()) { $const_op = 1; } if (defined $const_op) { my $value = $ops->[$const_op]->value(); my $other = $ops->[($const_op+1)%2]; if ($const_op == 0) { $value *= $constant; } else { # second $value = $type==B_PRODUCT ? $value * $constant : $value / $constant; } if ($value == 1) { return $other if $const_op == 1 or $type == B_PRODUCT; return Math::Symbolic::Constant->new(1/$other->{value}); } return Math::Symbolic::Operator->new( ($type == B_DIVISION ? '/' : '*'), # op-type $const_op == 0 # order of ops ?($value, $other) :($other, $value) ); } if ($ops->[1]->term_type() == T_OPERATOR) { my $otype = $ops->[1]->type(); if ($otype == B_PRODUCT || $otype == B_DIVISION) { return Math::Symbolic::Operator->new( ($type == B_PRODUCT ? '*' : '/'), $ops->[0], $ops->[1]->mod_multiply_constant($constant) ); } } else { return Math::Symbolic::Operator->new( ($type == B_PRODUCT ? '*' : '('), $ops->[0]->mod_multiply_constant($constant), $ops->[1], ); } } } # fallback: variable, didn't apply, etc. return Math::Symbolic::Operator->new( '*', Math::Symbolic::Constant->new($constant), $tree ); } =begin comment warn "mod_join_simple to be implemented in DefaultMods!"; sub mod_join_simple { my $o1 = shift; my $o2 = shift; my $type = shift; if ( $type == B_PRODUCT ) { return undef unless Math::Symbolic::Custom::is_identical_base( $o1, $o2 ); my $tt1 = $o1->term_type(); my $tt2 = $o2->term_type(); my ( $base, $exp1 ) = ( $tt1 == T_OPERATOR and $o1->type() == B_EXP ) ? ( $o1->op1(), $o1->op2() ) : ( $o1, Math::Symbolic::Constant->one() ); my $exp2 = ( $tt2 == T_OPERATOR and $o2->type() == B_EXP ) ? $o2->op2() : Math::Symbolic::Constant->one(); return Math::Symbolic::Operator->new( '^', $base, Math::Symbolic::Operator->new( '+', $exp1, $exp2 )->simplify() ); } } =end comment =cut 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L L L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Custom/DefaultDumpers.pm000444001750001750 1002512157534055 23413 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Custom::DefaultDumpers - Default Math::Symbolic output routines =head1 SYNOPSIS use Math::Symbolic qw/parse_from_string/; $term = parse_from_string(...); my ($sub, $leftover_trees) = $term->to_sub(); =head1 DESCRIPTION This is a class of default output routines for Math::Symbolic trees. Likewise, Math::Symbolic::Custom::DefaultTests defines default tree testing routines and Math::Symbolic::Custom::DefaultMods has default tree modification methods. For details on how the custom method delegation model works, please have a look at the Math::Symbolic::Custom and Math::Symbolic::Custom::Base classes. =head2 EXPORT Please see the docs for Math::Symbolic::Custom::Base for details, but you should not try to use the standard Exporter semantics with this class. =head1 SUBROUTINES =cut package Math::Symbolic::Custom::DefaultDumpers; use 5.006; use strict; use warnings; no warnings 'recursion'; our $VERSION = '0.612'; use Math::Symbolic::Custom::Base; BEGIN { *import = \&Math::Symbolic::Custom::Base::aggregate_import } use Math::Symbolic::ExportConstants qw/:all/; use Carp; # Class Data: Special variable required by Math::Symbolic::Custom # importing/exporting functionality. # All subroutines that are to be exported to the Math::Symbolic::Custom # namespace should be listed here. our $Aggregate_Export = [ qw/ to_code to_sub / ]; =head2 to_string The to_string method is currently implemented in the module core namespaces and will be moved to Math::Symbolic::DefaultDumpers in a future release. Takes one optional argument indicating whether the Math::Symbolic tree should be transformed to a string using 'postfix' notation or using 'infix' notation. Default is infix which is also more likely to be reparseable by the Math::Symbolic parser. =head2 to_code This method is a wrapper around the compile_to_code class method in the Math::Symbolic::Compiler module. Takes key/value pairs of variables and integers as argument. The integers should starting at 0 and they determine the order of the variables/parameters to the compiled code. Returns the compiled code and a reference to an array of possible leftover tree elements that could not be compiled. Please refer to the Math::Symbolic::Compiler man page for details. =cut sub to_code { my $self = shift; my $args = [@_]; # \@_ would be evil. @_ is not a real Perl array return Math::Symbolic::Compiler->compile_to_code( $self, $args ); } =head2 to_sub This method is a wrapper around the compile_to_sub class method in the Math::Symbolic::Compiler module. Takes key/value pairs of variables and integers as argument. The integers should starting at 0 and they determine the order of the variables/parameters to the compiled code. Returns the compiled sub and a reference to an array of possible leftover tree elements that could not be compiled. Please refer to the Math::Symbolic::Compiler man page for details. =cut sub to_sub { my $self = shift; my $args = [@_]; # \@_ would be evil. @_ is not a real Perl array return Math::Symbolic::Compiler->compile_to_sub( $self, $args ); } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L L L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Custom/Base.pm000444001750001750 502112157534055 21321 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Custom::Base - Base class for tree tests and transformations =head1 SYNOPSIS # Extending the Math::Symbolic::Custom class: package Math::Symbolic::Custom::MyTransformations; use Math::Symbolic::Custom::Base; BEGIN {*import = \&Math::Symbolic::Custom::Base::aggregate_import} our $Aggregate_Export = [qw/apply_transformation1 .../]; sub apply_transformation1 { # ... } =head1 DESCRIPTION This is a base class for your extensions to the Math::Symbolic::Custom class. To extend the class, just use the following template for your custom class: package Math::Symbolic::Custom::MyTransformations; use Math::Symbolic::Custom::Base; BEGIN {*import = \&Math::Symbolic::Custom::Base::aggregate_import} our $Aggregate_Export = [...]; # exported subroutines listed here. # Now implement the subroutines. # Exported subroutine names must start with 'apply_', 'mod_', # 'is_', 'test_', 'contains_', or 'to_' # ... 1; =head2 EXPORT Uses a custom exporter implementation to export certain routines from the invoking namespace to the Math::Symbolic::Custom namespace. But... Nevermind. =head1 SUBROUTINES =cut package Math::Symbolic::Custom::Base; use 5.006; use strict; use warnings; our $VERSION = '0.612'; our $AUTOLOAD; =head2 aggregate_import aggregate_import() is the only public subroutine defined by Math::Symbolic::Custom::Base and should only be called in BEGIN blocks like the one shown in the SYNOPSIS above. =cut sub aggregate_import { my $class = shift; no strict 'refs'; my $subs = ${"${class}::Aggregate_Export"}; foreach my $sub (@$subs) { *{"Math::Symbolic::Custom::$sub"} = \&{"$class\:\:$sub"}; } } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Custom/DefaultTests.pm000444001750001750 3624412157534055 23111 0ustar00tseetsee000000000000 =encoding utf8 =head1 NAME Math::Symbolic::Custom::DefaultTests - Default Math::Symbolic tree tests =head1 SYNOPSIS use Math::Symbolic; =head1 DESCRIPTION This is a class of default tests for Math::Symbolic trees. Likewise, Math::Symbolic::Custom::DefaultMods defines default tree transformation routines. For details on how the custom method delegation model works, please have a look at the Math::Symbolic::Custom and Math::Symbolic::Custom::Base classes. =head2 EXPORT Please see the docs for Math::Symbolic::Custom::Base for details, but you should not try to use the standard Exporter semantics with this class. =head1 SUBROUTINES =cut package Math::Symbolic::Custom::DefaultTests; use 5.006; use strict; use warnings; use Data::Dumper; # for numerical equivalence test no warnings 'recursion'; our $VERSION = '0.612'; use Math::Symbolic::Custom::Base; BEGIN { *import = \&Math::Symbolic::Custom::Base::aggregate_import } use Math::Symbolic::ExportConstants qw/:all/; use Carp; # Class Data: Special variable required by Math::Symbolic::Custom # importing/exporting functionality. # All subroutines that are to be exported to the Math::Symbolic::Custom # namespace should be listed here. our $Aggregate_Export = [ qw/ is_one is_zero is_zero_or_one is_sum is_constant is_simple_constant is_integer is_identical is_identical_base test_num_equiv / ]; =head2 is_zero() Returns true (1) of the tree is a constant and '0'. Returns false (0) otherwise. =cut sub is_zero { my $tree = shift; return 0 unless $tree->term_type() == T_CONSTANT; return 1 if $tree->{value} == 0; return 0; } =head2 is_one() Returns true (1) of the tree is a constant and '1'. Returns false (0) otherwise. =cut sub is_one { my $tree = shift; return 0 unless $tree->term_type() == T_CONSTANT; return 1 if $tree->{value} == 1; return 0; } =head2 is_zero_or_one() Returns true ('1' for 1, '0E0' for 0) of the tree is a constant and '1' or '0'. Returns false (0) otherwise. =cut sub is_zero_or_one { my $tree = shift; return 0 unless $tree->term_type() == T_CONSTANT; return 1 if $tree->{value} == 1; return "0E0" if $tree->{value} == 0; return 0; } =head2 is_integer() is_integer() returns a boolean. It returns true (1) if the tree is a constant object representing an integer value. It does I compute the value of the tree. (eg. '5*10' is I considered an integer, but '50' is.) It returns false (0) otherwise. =cut sub is_integer { my $tree = shift; return 0 unless $tree->term_type() == T_CONSTANT; my $value = $tree->value(); return ( int($value) == $value ); } =head2 is_simple_constant() is_simple_constant() returns a boolean. It returns true if the tree consists of only constants and operators. As opposed to is_constant(), is_simple_constant() does not apply derivatives if necessary. It returns false (0) otherwise. =cut sub is_simple_constant { my $tree = shift; my $return = 1; $tree->descend( in_place => 1, before => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT ) { return undef; } elsif ( $ttype == T_VARIABLE ) { $return = 0; return undef; } elsif ( $ttype == T_OPERATOR ) { return (); } else { croak "is_simple_constant called on " . "invalid tree type."; } }, ); return $return; } =head2 is_constant() is_constant() returns a boolean. It returns true (1) if the tree consists of only constants and operators or if it becomes a tree of only constants and operators after application of derivatives. It returns false (0) otherwise. If you need not pay the price of applying derivatives, you should use the is_simple_constant() method instead. =cut sub is_constant { my $tree = shift; my $return = 1; $tree->descend( in_place => 1, before => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT ) { return undef; } elsif ( $ttype == T_VARIABLE ) { $return = 0; return undef; } elsif ( $ttype == T_OPERATOR ) { my $tree = $tree->apply_derivatives(); $ttype = $tree->term_type(); return undef if $ttype == T_CONSTANT; ( $return = 0 ), return undef if $ttype == T_VARIABLE; return { descend_into => [ @{ $tree->{operands} } ], }; } else { croak "is_constant called on " . "invalid tree type."; } }, ); return $return; } =head2 is_identical() is_identical() returns a boolean. It compares the tree it is called on to its first argument. If the first argument is not a Math::Symbolic tree, it is sent through the parser. is_identical() returns true (1) if the trees are completely identical. That includes operands of commutating operators having the same order, etc. This does I test of mathematical equivalence! (Which is B harder to test for. If you know how to, I let me know!) It returns false (0) otherwise. =cut sub is_identical { my $tree1 = shift; my $tree2 = shift; $tree2 = Math::Symbolic::parse_from_string($tree2) if not ref($tree2) =~ /^Math::Symbolic/; my $tt1 = $tree1->term_type(); my $tt2 = $tree2->term_type(); if ( $tt1 != $tt2 ) { return 0; } else { if ( $tt1 == T_VARIABLE ) { return 0 if $tree1->name() ne $tree2->name(); my @sig1 = $tree1->signature(); my @sig2 = $tree2->signature(); return 0 if scalar(@sig1) != scalar(@sig2); for ( my $i = 0 ; $i < @sig1 ; $i++ ) { return 0 if $sig1[$i] ne $sig2[$i]; } return 1; } elsif ( $tt1 == T_CONSTANT ) { my $sp1 = $tree1->special(); my $sp2 = $tree2->special(); if ( defined $sp1 and defined $sp2 and $sp1 eq $sp2 and $sp1 ne '' and $sp1 =~ /\S/ ) { return 1; } return 1 if $tree1->value() == $tree2->value(); return 0; } elsif ( $tt1 == T_OPERATOR ) { my $t1 = $tree1->type(); my $t2 = $tree2->type(); return 0 if $t1 != $t2; return 0 if @{ $tree1->{operands} } != @{ $tree2->{operands} }; my $i = 0; foreach ( @{ $tree1->{operands} } ) { return 0 unless is_identical( $_, $tree2->{operands}[ $i++ ] ); } return 1; } else { croak "is_identical() called on invalid term type."; } die "Sanity check in is_identical(). Should not be reached."; } } =head2 is_identical_base is_identical_base() returns a boolean. It compares the tree it is called on to its first argument. If the first argument is not a Math::Symbolic tree, it is sent through the parser. is_identical_base() returns true (1) if the trees are identical or if they are exponentiations with the same base. The same gotchas that apply to is_identical apply here, too. For example, 'x*y' and '(x*y)^e' result in a true return value because 'x*y' is equal to '(x*y)^1' and this has the same base as '(x*y)^e'. It returns false (0) otherwise. =cut sub is_identical_base { my $o1 = shift; my $o2 = shift; $o2 = Math::Symbolic::parse_from_string($o2) if ref($o2) !~ /^Math::Symbolic/; my $tt1 = $o1->term_type(); my $tt2 = $o2->term_type(); my $so1 = ( $tt1 == T_OPERATOR and $o1->type() == B_EXP ) ? $o1->op1() : $o1; my $so2 = ( $tt2 == T_OPERATOR and $o2->type() == B_EXP ) ? $o2->op1() : $o2; return Math::Symbolic::Custom::is_identical( $so1, $so2 ); } =head2 is_sum() (beta) is_constant() returns a boolean. It returns true (1) if the tree contains no variables (because it can then be evaluated to a single constant which is a sum). It also returns true if it is a sum or difference of constants and variables. Furthermore, it is true for products of integers and constants because those products are really sums of variables. If none of the above cases match, it applies all derivatives and tries again. It returns false (0) otherwise. Please contact the author in case you encounter bugs in the specs or implementation. The heuristics aren't all that great. =cut sub is_sum { my $tree = shift; my $return = 1; $tree->descend( in_place => 1, before => sub { my $tree = shift; my $ttype = $tree->term_type(); if ( $ttype == T_CONSTANT or $ttype == T_VARIABLE ) { return undef; } elsif ( $ttype == T_OPERATOR ) { my $type = $tree->type(); if ( $type == B_SUM or $type == B_DIFFERENCE or $type == U_MINUS ) { return (); } elsif ( $type == B_PRODUCT ) { $return = $tree->{operands}[0]->is_integer() || $tree->{operands}[1]->is_integer(); return undef; } elsif ($type == U_P_DERIVATIVE or $type == U_T_DERIVATIVE ) { my $tree = $tree->apply_derivatives(); $tree = $tree->simplify(); my $ttype = $tree->term_type(); return undef if ( $ttype == T_CONSTANT or $ttype == T_VARIABLE ); if ( $ttype == T_OPERATOR ) { my $type = $tree->type(); if ( $type == U_P_DERIVATIVE || $type == U_T_DERIVATIVE ) { $return = 0; return undef; } else { return { descend_into => [$tree] }; } } else { die "apply_derivatives " . "screwed the pooch in " . "is_sum()."; } } elsif ( is_constant($tree) ) { return undef; } else { $return = 0; return undef; } } else { croak "is_sum called on invalid tree type."; } die; }, ); return $return; } =head2 test_num_equiv() Takes another Math::Symbolic tree or a code ref as first argument. Tests the tree it is called on and the one passed in as first argument for equivalence by sampling random numbers for their parameters and evaluating them. This is no guarantee that the functions are actually similar. The computation required for this test may be very high for large numbers of tests. In case of a subroutine reference passed in, the values of the parameters of the Math::Symbolic tree are passed to the sub ref sorted by the parameter names. Following the test-tree, there may be various options as key/value pairs: limits: A hash reference with parameter names as keys and code refs as arguments. A code ref for parameter 'x', will be executed for every number of 'x' that is generated. If the code returns false, the number is discarded and regenerated. tests: The number of tests to carry out. Default: 20 epsilon: The accuracy of the numeric comparison. Default: 1e-7 retries: The number of attempts to make if a function evaluation throws an error. upper: Upper limit of the random numbers. Default: 10 lower: Lower limit of the random numbers. Default: -10 =cut sub test_num_equiv { my ($t1, $t2) = (shift(), shift()); if (ref($t1) !~ /^Math::Symbolic/) { croak("test_numeric_equivalence() must be called on Math::Symbolic tree"); } if (ref($t2) !~ /^Math::Symbolic/ and ref($t2) ne 'CODE') { croak("first argument to test_numeric_equivalence() must be a Math::Symbolic tree or a code reference"); } my $is_code = ref($t2) eq 'CODE' ? 1 : 0; my %args = @_; my $limits = $args{limits} || {}; my $tests = $args{tests} || 20; my $eps = $args{epsilon} || 1e-7; my $retries = $args{retries} || 5; my $upper = $args{upper} || 10; my $lower = $args{lower} || -10; my @s1 = $t1->signature(); my @s2 = $is_code ? () : $t2->signature(); my %sig = map {($_=>undef)} @s1, @s2; my $mult = $upper-$lower; my $retry = 0; foreach (1..$tests) { croak("Could not evaluate test functions with numbers -10..10") if $retry > $retries-1; for (keys %sig) { my $num = rand()*$mult - $mult/2; redo if $limits->{$_} and not $limits->{$_}->($num); $sig{$_} = $num; } no warnings; my($y1, $y2); eval {$y1 = $t1->value(%sig);}; if ($@) { warn "error during evaluation: $@"; $retry++; $mult /= 2; redo; } if ($is_code) { eval {$y2 = $t2->(map {$sig{$_}} sort keys %sig)}; } else { eval {$y2 = $t2->value(%sig);}; } if ($@) { warn "error during evaluation: $@"; $retry++; $mult /= 2; redo; } if (not defined $y1) { warn "Result of '$t1' not defined; ".Dumper(\%sig); next if not defined $y2; $retry++; redo; } elsif (not defined $y2) { warn "Result of '$t2' not defined; ".Dumper(\%sig); $retry++; redo; } warn("1: $y1, 2: $y2; ".Dumper(\%sig)), return 0 if $y1+$eps < $y2 or $y1-$eps > $y2; $mult = $upper-$lower; $retry = 0; } return 1; } 1; __END__ =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L L L =cut Math-Symbolic-0.612/lib/Math/Symbolic/Parser000755001750001750 012157534055 17740 5ustar00tseetsee000000000000Math-Symbolic-0.612/lib/Math/Symbolic/Parser/Yapp.pm000444001750001750 6123212157534055 21370 0ustar00tseetsee000000000000package Math::Symbolic::Parser::Yapp::Driver; use strict; our $VERSION = '1.05'; #################################################################### # # This file was generated using Parse::Yapp version 1.05. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package Math::Symbolic::Parser::Yapp; use vars qw ( @ISA ); use strict; @ISA= qw ( Math::Symbolic::Parser::Yapp::Driver ); #Included Parse/Yapp/Driver.pm file---------------------------------------- { # # Module Parse::Yapp::Driver # # This module is part of the Parse::Yapp package available on your # nearest CPAN # # Any use of this module in a standalone parser make the included # text under the same copyright as the Parse::Yapp module itself. # # This notice should remain unchanged. # # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved. # (see the pod text in Parse::Yapp module for use and distribution rights) # package Math::Symbolic::Parser::Yapp::Driver; require 5.004; use strict; use vars qw ( $VERSION $COMPATIBLE $FILENAME ); $VERSION = '1.05'; $COMPATIBLE = '0.07'; $FILENAME=__FILE__; use Carp; #Known parameters, all starting with YY (leading YY will be discarded) my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '', YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => ''); #Mandatory parameters my(@params)=('LEX','RULES','STATES'); sub new { my($class)=shift; my($errst,$nberr,$token,$value,$check,$dotpos); my($self)={ ERROR => \&_Error, ERRST => \$errst, NBERR => \$nberr, TOKEN => \$token, VALUE => \$value, DOTPOS => \$dotpos, STACK => [], DEBUG => 0, CHECK => \$check }; _CheckParams( [], \%params, \@_, $self ); exists($$self{VERSION}) and $$self{VERSION} < $COMPATIBLE and croak "Yapp driver version $VERSION ". "incompatible with version $$self{VERSION}:\n". "Please recompile parser module."; ref($class) and $class=ref($class); bless($self,$class); } sub YYParse { my($self)=shift; my($retval); _CheckParams( \@params, \%params, \@_, $self ); if($$self{DEBUG}) { _DBLoad(); $retval = eval '$self->_DBParse()';#Do not create stab entry on compile $@ and die $@; } else { $retval = $self->_Parse(); } $retval } sub YYData { my($self)=shift; exists($$self{USER}) or $$self{USER}={}; $$self{USER}; } sub YYErrok { my($self)=shift; ${$$self{ERRST}}=0; undef; } sub YYNberr { my($self)=shift; ${$$self{NBERR}}; } sub YYRecovering { my($self)=shift; ${$$self{ERRST}} != 0; } sub YYAbort { my($self)=shift; ${$$self{CHECK}}='ABORT'; undef; } sub YYAccept { my($self)=shift; ${$$self{CHECK}}='ACCEPT'; undef; } sub YYError { my($self)=shift; ${$$self{CHECK}}='ERROR'; undef; } sub YYSemval { my($self)=shift; my($index)= $_[0] - ${$$self{DOTPOS}} - 1; $index < 0 and -$index <= @{$$self{STACK}} and return $$self{STACK}[$index][1]; undef; #Invalid index } sub YYCurtok { my($self)=shift; @_ and ${$$self{TOKEN}}=$_[0]; ${$$self{TOKEN}}; } sub YYCurval { my($self)=shift; @_ and ${$$self{VALUE}}=$_[0]; ${$$self{VALUE}}; } sub YYExpect { my($self)=shift; keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}} } sub YYLexer { my($self)=shift; $$self{LEX}; } ################# # Private stuff # ################# sub _CheckParams { my($mandatory,$checklist,$inarray,$outhash)=@_; my($prm,$value); my($prmlst)={}; while(($prm,$value)=splice(@$inarray,0,2)) { $prm=uc($prm); exists($$checklist{$prm}) or croak("Unknow parameter '$prm'"); ref($value) eq $$checklist{$prm} or croak("Invalid value for parameter '$prm'"); $prm=unpack('@2A*',$prm); $$outhash{$prm}=$value; } for (@$mandatory) { exists($$outhash{$_}) or croak("Missing mandatory parameter '".lc($_)."'"); } } sub _Error { print "Parse error.\n"; } sub _DBLoad { { no strict 'refs'; exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ? and return; } my($fname)=__FILE__; my(@drv); open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname"; while() { /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/ and do { s/^#DBG>//; push(@drv,$_); } } close(DRV); $drv[0]=~s/_P/_DBP/; eval join('',@drv); } #Note that for loading debugging version of the driver, #this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive. #So, DO NOT remove comment at end of sub !!! sub _Parse { my($self)=shift; my($rules,$states,$lex,$error) = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' }; my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos) = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' }; #DBG> my($debug)=$$self{DEBUG}; #DBG> my($dbgerror)=0; #DBG> my($ShowCurToken) = sub { #DBG> my($tok)='>'; #DBG> for (split('',$$token)) { #DBG> $tok.= (ord($_) < 32 or ord($_) > 126) #DBG> ? sprintf('<%02X>',ord($_)) #DBG> : $_; #DBG> } #DBG> $tok.='<'; #DBG> }; $$errstatus=0; $$nberror=0; ($$token,$$value)=(undef,undef); @$stack=( [ 0, undef ] ); $$check=''; while(1) { my($actions,$act,$stateno); $stateno=$$stack[-1][0]; $actions=$$states[$stateno]; #DBG> print STDERR ('-' x 40),"\n"; #DBG> $debug & 0x2 #DBG> and print STDERR "In state $stateno:\n"; #DBG> $debug & 0x08 #DBG> and print STDERR "Stack:[". #DBG> join(',',map { $$_[0] } @$stack). #DBG> "]\n"; if (exists($$actions{ACTIONS})) { defined($$token) or do { ($$token,$$value)=&$lex($self); #DBG> $debug & 0x01 #DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n"; }; $act= exists($$actions{ACTIONS}{$$token}) ? $$actions{ACTIONS}{$$token} : exists($$actions{DEFAULT}) ? $$actions{DEFAULT} : undef; } else { $act=$$actions{DEFAULT}; #DBG> $debug & 0x01 #DBG> and print STDERR "Don't need token.\n"; } defined($act) and do { $act > 0 and do { #shift #DBG> $debug & 0x04 #DBG> and print STDERR "Shift and go to state $act.\n"; $$errstatus and do { --$$errstatus; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; }; push(@$stack,[ $act, $$value ]); $$token ne '' #Don't eat the eof and $$token=$$value=undef; next; }; #reduce my($lhs,$len,$code,@sempar,$semval); ($lhs,$len,$code)=@{$$rules[-$act]}; #DBG> $debug & 0x04 #DBG> and $act #DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): "; $act or $self->YYAccept(); $$dotpos=$len; unpack('A1',$lhs) eq '@' #In line rule and do { $lhs =~ /^\@[0-9]+\-([0-9]+)$/ or die "In line rule name '$lhs' ill formed: ". "report it as a BUG.\n"; $$dotpos = $1; }; @sempar = $$dotpos ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ] : (); $semval = $code ? &$code( $self, @sempar ) : @sempar ? $sempar[0] : undef; splice(@$stack,-$len,$len); $$check eq 'ACCEPT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Accept.\n"; return($semval); }; $$check eq 'ABORT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Abort.\n"; return(undef); }; #DBG> $debug & 0x04 #DBG> and print STDERR "Back to state $$stack[-1][0], then "; $$check eq 'ERROR' or do { #DBG> $debug & 0x04 #DBG> and print STDERR #DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n"; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; push(@$stack, [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]); $$check=''; next; }; #DBG> $debug & 0x04 #DBG> and print STDERR "Forced Error recovery.\n"; $$check=''; }; #Error $$errstatus or do { $$errstatus = 1; &$error($self); $$errstatus # if 0, then YYErrok has been called or next; # so continue parsing #DBG> $debug & 0x10 #DBG> and do { #DBG> print STDERR "**Entering Error recovery.\n"; #DBG> ++$dbgerror; #DBG> }; ++$$nberror; }; $$errstatus == 3 #The next token is not valid: discard it and do { $$token eq '' # End of input: no hope and do { #DBG> $debug & 0x10 #DBG> and print STDERR "**At eof: aborting.\n"; return(undef); }; #DBG> $debug & 0x10 #DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n"; $$token=$$value=undef; }; $$errstatus=3; while( @$stack and ( not exists($$states[$$stack[-1][0]]{ACTIONS}) or not exists($$states[$$stack[-1][0]]{ACTIONS}{error}) or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) { #DBG> $debug & 0x10 #DBG> and print STDERR "**Pop state $$stack[-1][0].\n"; pop(@$stack); } @$stack or do { #DBG> $debug & 0x10 #DBG> and print STDERR "**No state left on stack: aborting.\n"; return(undef); }; #shift the error token #DBG> $debug & 0x10 #DBG> and print STDERR "**Shift \$error token and go to state ". #DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}. #DBG> ".\n"; push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]); } #never reached croak("Error in driver logic. Please, report it as a BUG"); }#_Parse #DO NOT remove comment 1; } #End of include-------------------------------------------------- sub new { my($class)=shift; ref($class) and $class=ref($class); my($self)=$class->SUPER::new( yyversion => '1.05', yystates => [ {#State 0 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'EFUNC' => 8, 'VAR' => 9 }, GOTOS => { 'exp' => 2 } }, {#State 1 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 10 } }, {#State 2 ACTIONS => { '' => 12, "-" => 11, "^" => 15, "*" => 16, "+" => 13, "/" => 14 } }, {#State 3 ACTIONS => { "{" => 17 } }, {#State 4 DEFAULT => -4 }, {#State 5 ACTIONS => { "(" => 18 } }, {#State 6 DEFAULT => -1 }, {#State 7 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 19 } }, {#State 8 DEFAULT => -5 }, {#State 9 DEFAULT => -6 }, {#State 10 ACTIONS => { "^" => 15 }, DEFAULT => -11 }, {#State 11 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 20 } }, {#State 12 DEFAULT => 0 }, {#State 13 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 21 } }, {#State 14 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 22 } }, {#State 15 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 23 } }, {#State 16 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 24 } }, {#State 17 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 25 } }, {#State 18 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 26, 'list' => 27 } }, {#State 19 ACTIONS => { "-" => 11, "^" => 15, "*" => 16, "+" => 13, "/" => 14, ")" => 28 } }, {#State 20 ACTIONS => { "/" => 14, "^" => 15, "*" => 16 }, DEFAULT => -8 }, {#State 21 ACTIONS => { "/" => 14, "^" => 15, "*" => 16 }, DEFAULT => -7 }, {#State 22 ACTIONS => { "^" => 15 }, DEFAULT => -10 }, {#State 23 ACTIONS => { "^" => 15 }, DEFAULT => -12 }, {#State 24 ACTIONS => { "^" => 15 }, DEFAULT => -9 }, {#State 25 ACTIONS => { "}" => 29, "-" => 11, "^" => 15, "*" => 16, "+" => 13, "/" => 14 } }, {#State 26 ACTIONS => { "-" => 11, "+" => 13, "/" => 14, "," => 30, "^" => 15, "*" => 16 }, DEFAULT => -15 }, {#State 27 ACTIONS => { ")" => 31 } }, {#State 28 DEFAULT => -13 }, {#State 29 DEFAULT => -3 }, {#State 30 ACTIONS => { "-" => 1, 'PRED' => 3, 'PRIVEFUNC' => 4, 'FUNC' => 5, 'NUM' => 6, "(" => 7, 'VAR' => 9, 'EFUNC' => 8 }, GOTOS => { 'exp' => 26, 'list' => 32 } }, {#State 31 DEFAULT => -2 }, {#State 32 DEFAULT => -14 } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'exp', 1, sub { $_[1] } ], [#Rule 2 'exp', 4, sub { if (exists($Math::Symbolic::Parser::Parser_Functions{$_[1]})) { $Math::Symbolic::Parser::Parser_Functions{$_[1]}->($_[1], @{$_[3]}) } else { Math::Symbolic::Operator->new($_[1], @{$_[3]}) } } ], [#Rule 3 'exp', 4, sub { Math::Symbolic::Variable->new( 'TRANSFORMATION_HOOK', [$_[1], $_[3]] ); } ], [#Rule 4 'exp', 1, sub { $_[1] =~ /^([^(]+)\((.*)\)$/ or die "invalid per-object parser extension function: '$_[1]'"; $_[0]->{__PRIV_EXT_FUNCTIONS}->{$1}->($2); } ], [#Rule 5 'exp', 1, sub { $_[1] =~ /^([^(]+)\((.*)\)$/ or die "invalid global parser extension function: '$_[1]'"; $Math::SymbolicX::ParserExtensionFactory::Functions->{$1}->($2) } ], [#Rule 6 'exp', 1, sub { $_[1] } ], [#Rule 7 'exp', 3, sub { Math::Symbolic::Operator->new('+', $_[1], $_[3]) } ], [#Rule 8 'exp', 3, sub { Math::Symbolic::Operator->new('-', $_[1], $_[3]) } ], [#Rule 9 'exp', 3, sub { Math::Symbolic::Operator->new('*', $_[1], $_[3]) } ], [#Rule 10 'exp', 3, sub { Math::Symbolic::Operator->new('/', $_[1], $_[3]) } ], [#Rule 11 'exp', 2, sub { Math::Symbolic::Operator->new('neg', $_[2]) } ], [#Rule 12 'exp', 3, sub { Math::Symbolic::Operator->new('^', $_[1], $_[3]) } ], [#Rule 13 'exp', 3, sub { $_[2] } ], [#Rule 14 'list', 3, sub { unshift @{$_[3]}, $_[1]; $_[3] } ], [#Rule 15 'list', 1, sub { [$_[1]] } ] ], @_); bless($self,$class); } use strict; use warnings; use Math::Symbolic qw//; use constant DAT => 0; use constant OP => 1; sub _Error { exists $_[0]->YYData->{ERRMSG} and do { my $x = $_[0]->YYData->{ERRMSG}; delete $_[0]->YYData->{ERRMSG}; die $x; }; die "Syntax error in input string while parsing the following string: '".$_[0]->{USER}{INPUT}."'\n"; } my $Num = qr/[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee]([+-]?\d+))?/o; my $Ident = qr/[a-zA-Z][a-zA-Z0-9_]*/o; my $Op = qr/\+|\-|\*|\/|\^/o; my $Func = qr/log|partial_derivative|total_derivative|a?(?:sin|sinh|cos|cosh|tan|cot)|exp|sqrt/; my $Unary = qr/\+|\-/o; # taken from perlre my $balanced_parens_re; $balanced_parens_re = qr{\((?:(?>[^()]+)|(??{$balanced_parens_re}))*\)}; # This is a hack so we can hook into the new() method. { no warnings; no strict; *real_new = \&new; *new = sub { my $class = shift; my %args = @_; my $predicates = $args{predicates}; delete $args{predicates}; my $parser = real_new($class, %args); if ($predicates) { $parser->{__PREDICATES} = $predicates; } return $parser; }; } sub _Lexer { my($parser)=shift; my $ExtFunc = $Math::SymbolicX::ParserExtensionFactory::RegularExpression || qr/(?!)/; my $PrivExtFunc = $parser->{__PRIV_EXT_FUNC_REGEX}; my $data = $parser->{USER}; my $predicates = $parser->{__PREDICATES}; pos($data->{INPUT}) < length($data->{INPUT}) or return('',undef); # This is a huge hack if (defined $predicates) { for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($PrivExtFunc ? $data->{INPUT} =~ /\G($PrivExtFunc$balanced_parens_re)/cg : 0) { $data->{STATE} = OP; return('PRIVEFUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($predicates)(?=\{)/cg) { return('PRED', $1); } elsif ($data->{INPUT} =~ /\G($Ident)((?>\'*))(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; my $name = $1; my $ticks = $2; my $sig = $3; my $n; if (defined $ticks and ($n = length($ticks))) { my @sig = defined($sig) ? (split /,/, $sig) : ('x'); my $return = Math::Symbolic::Variable->new( {name=>$name, signature=>\@sig} ); my $var = $sig[0]; foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $var, ); } return('VAR', $return); } elsif (defined $sig) { return( 'VAR', Math::Symbolic::Variable->new({name=>$name, signature=>[split /,/, $sig]}) ); } else { return('VAR', Math::Symbolic::Variable->new($name)); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G\{/cgo) { return('{', '{'); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G\}/cgo) { return('}', '}'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end if defined $predicates else { # {{{ not defined $predicates for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($PrivExtFunc ? $data->{INPUT} =~ /\G($PrivExtFunc\s*$balanced_parens_re)/cg : 0) { $data->{STATE} = OP; return('PRIVEFUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc\s*$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($Ident)((?>\'*))(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; my $name = $1; my $ticks = $2; my $sig = $3; my $n; if (defined $ticks and ($n = length($ticks))) { my @sig = defined($sig) ? (split /,/, $sig) : ('x'); my $return = Math::Symbolic::Variable->new( {name=>$name, signature=>\@sig} ); my $var = $sig[0]; foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $var, ); } return('VAR', $return); } elsif (defined $sig) { return( 'VAR', Math::Symbolic::Variable->new({name=>$name, signature=>[split /,/, $sig]}) ); } else { return('VAR', Math::Symbolic::Variable->new($name)); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end else => not defined $predicates } sub parse { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error ); } sub parsedebug { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yydebug => 0x1F, yylex => \&_Lexer, yyerror => \&_Error ); } 1; 1; Math-Symbolic-0.612/lib/Math/Symbolic/Parser/Precompiled.pm000444001750001750 113407212157534055 22766 0ustar00tseetsee000000000000package Math::Symbolic::Parser::Precompiled; our $VERSION = '0.612'; use strict; =head1 NAME Math::Symbolic::Parser::Precompiled - Precompiled Math::Symbolic Parser =head1 DESCRIPTION This module is a precompiled version of the Parse::RecDescent grammar that can be found in $Math::Symbolic::Parser::Grammar. It is used internally to improve startup performance. Please use the new() method in the Math::Symbolic::Parser namespace to generate new parsers. Also note that some modules on CPAN (like Math::SymbolicX::Complex, etc.) modify the parser which is stored in $Math::Symbolic::Parser at the time of loading the module. =head1 AUTHOR Please send feedback, bug reports, and support requests to the Math::Symbolic support mailing list: math-symbolic-support at lists dot sourceforge dot net. Please consider letting us know how you use Math::Symbolic. Thank you. If you're interested in helping with the development or extending the module's functionality, please contact the developers' mailing list: math-symbolic-develop at lists dot sourceforge dot net. List of contributors: Steffen Müller, symbolic-module at steffen-mueller dot net Stray Toaster, mwk at users dot sourceforge dot net Oliver Ebenhöh =head1 SEE ALSO New versions of this module can be found on http://steffen-mueller.net or CPAN. The module development takes place on Sourceforge at http://sourceforge.net/projects/math-symbolic/ L L =cut package Math::Symbolic::Parser::Precompiled; use Parse::RecDescent; { my $ERRORS; package Parse::RecDescent::Math::Symbolic::Parser::Precompiled; use strict; use vars qw($skip $AUTOLOAD ); @Parse::RecDescent::Math::Symbolic::Parser::Precompiled::ISA = (); $skip = '\s*'; { local $SIG{__WARN__} = sub {0}; # PRETEND TO BE IN Parse::RecDescent NAMESPACE *Parse::RecDescent::Math::Symbolic::Parser::Precompiled::AUTOLOAD = sub { no strict 'refs'; ${"AUTOLOAD"} =~ s/^Parse::RecDescent::Math::Symbolic::Parser::Precompiled/Parse::RecDescent/; goto &{${"AUTOLOAD"}}; } } push @Parse::RecDescent::Math::Symbolic::Parser::Precompiled::ISA, 'Parse::RecDescent'; # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::exp { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"exp"}; Parse::RecDescent::_trace(q{Trying rule: [exp]}, Parse::RecDescent::_tracefirst($_[1]), q{exp}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: []}, Parse::RecDescent::_tracefirst($_[1]), q{exp}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{exp}); %item = (__RULE__ => q{exp}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying operator: []}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $expectation->is(q{})->at($text); $_tok = undef; OPLOOP: while (1) { $repcount = 0; my @item; my %item; my $savetext = $text; my $backtrack; # MATCH (LEFTARG OP)(s) while ($repcount < 100000000) { $backtrack = 0; Parse::RecDescent::_trace(q{Trying subrule: [factor]}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{factor})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::factor($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [factor]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $item{q{factor}} = $_tok; push @item, $_tok; } $repcount++; $backtrack = 1; Parse::RecDescent::_trace(q{Trying terminal: ['^']}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{'^'})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\^/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; $savetext = $text; pop @item; } $text = $savetext; pop @item if $backtrack; # MATCH RIGHTARG Parse::RecDescent::_trace(q{Trying subrule: [factor]}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{factor})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::factor($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [factor]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $item{q{factor}} = $_tok; push @item, $_tok; } $repcount++; unless (@item) { undef $_tok; last } $_tok = [ @item ]; last; } # end of OPLOOP unless ($repcount>=1) { Parse::RecDescent::_trace(q{<]>>}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched operator: []<< (return value: [} . qq{@{$_tok||[]}} . q{]}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; push @item, $item{__DIRECTIVE1__}=$_tok||[]; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'exp ' if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = reverse @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( '^', shift(@it), $tree ); } $tree; } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: []<<}, Parse::RecDescent::_tracefirst($text), q{exp}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{exp}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{exp}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{exp}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{exp}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::variable { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"variable"}; Parse::RecDescent::_trace(q{Trying rule: [variable]}, Parse::RecDescent::_tracefirst($_[1]), q{variable}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/[a-zA-Z][a-zA-Z0-9_]*/}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/[a-zA-Z][a-zA-Z0-9_]*/ /\\'*/ '(' identifier_list ')']}, Parse::RecDescent::_tracefirst($_[1]), q{variable}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{variable}); %item = (__RULE__ => q{variable}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/[a-zA-Z][a-zA-Z0-9_]*/]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[a-zA-Z][a-zA-Z0-9_]*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: [/\\'*/]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/\\'*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:\'*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: ['(']}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{'('})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\(/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [identifier_list]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{identifier_list})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::identifier_list($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [identifier_list]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $item{q{identifier_list}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying terminal: [')']}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{')'})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING2__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'variable ' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $sig = $item[4] || ['x']; my $dep_var = $sig->[0]; my $return = Math::Symbolic::Variable->new( { name => $varname, signature => $sig } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, $dep_var, ); } $return; } else { Math::Symbolic::Variable->new( { name => $varname, signature => $item[4] } ); } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/[a-zA-Z][a-zA-Z0-9_]*/ /\\'*/ '(' identifier_list ')']<<}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/[a-zA-Z][a-zA-Z0-9_]*/ /\\'*/]}, Parse::RecDescent::_tracefirst($_[1]), q{variable}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{variable}); %item = (__RULE__ => q{variable}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/[a-zA-Z][a-zA-Z0-9_]*/]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[a-zA-Z][a-zA-Z0-9_]*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: [/\\'*/]}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/\\'*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:\'*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'variable ' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $return = Math::Symbolic::Variable->new( { name => $varname, signature => ['x'] } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( 'partial_derivative', $return, 'x', ); } $return; } else { Math::Symbolic::Variable->new( $varname ); } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/[a-zA-Z][a-zA-Z0-9_]*/ /\\'*/]<<}, Parse::RecDescent::_tracefirst($text), q{variable}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{variable}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{variable}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{variable}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{variable}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::function { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"function"}; Parse::RecDescent::_trace(q{Trying rule: [function]}, Parse::RecDescent::_tracefirst($_[1]), q{function}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{function_name}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [function_name '(' expr_list ')']}, Parse::RecDescent::_tracefirst($_[1]), q{function}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{function}); %item = (__RULE__ => q{function}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying subrule: [function_name]}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::function_name($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [function_name]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $item{q{function_name}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying terminal: ['(']}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{'('})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\(/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [expr_list]}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{expr_list})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr_list($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [expr_list]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $item{q{expr_list}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying terminal: [')']}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{')'})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING2__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'function ' # if $Math::Symbolic::Parser::DEBUG; my $fname = $item[1]; my $function; if (exists($Math::Symbolic::Parser::Parser_Functions{$fname})) { $function = $Math::Symbolic::Parser::Parser_Functions{$fname}->($fname, @{$item[3]}); die "Invalid function '$fname'!" unless defined $function; } else { $function = $Math::Symbolic::Operator::Op_Symbols{ $fname }; die "Invalid function '$fname'!" unless defined $function; $function = Math::Symbolic::Operator->new( { type => $function, operands => $item[3] } ); } $function }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [function_name '(' expr_list ')']<<}, Parse::RecDescent::_tracefirst($text), q{function}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{function}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{function}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{function}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{function}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::number { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"number"}; Parse::RecDescent::_trace(q{Trying rule: [number]}, Parse::RecDescent::_tracefirst($_[1]), q{number}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?/}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?/]}, Parse::RecDescent::_tracefirst($_[1]), q{number}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{number}); %item = (__RULE__ => q{number}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?/]}, Parse::RecDescent::_tracefirst($text), q{number}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{number}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'number ' # if $Math::Symbolic::Parser::DEBUG; Math::Symbolic::Constant->new($item[1]) }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?/]<<}, Parse::RecDescent::_tracefirst($text), q{number}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{number}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{number}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{number}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{number}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::multiplication { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"multiplication"}; Parse::RecDescent::_trace(q{Trying rule: [multiplication]}, Parse::RecDescent::_tracefirst($_[1]), q{multiplication}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: []}, Parse::RecDescent::_tracefirst($_[1]), q{multiplication}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{multiplication}); %item = (__RULE__ => q{multiplication}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying operator: []}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $expectation->is(q{})->at($text); $_tok = undef; OPLOOP: while (1) { $repcount = 0; my @item; my %item; # MATCH LEFTARG Parse::RecDescent::_trace(q{Trying subrule: [exp]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{exp})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::exp($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [exp]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $item{q{exp}} = $_tok; push @item, $_tok; } $repcount++; my $savetext = $text; my $backtrack; # MATCH (OP RIGHTARG)(s) while ($repcount < 100000000) { $backtrack = 0; Parse::RecDescent::_trace(q{Trying subrule: [mult_op]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{mult_op})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::mult_op($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [mult_op]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $item{q{mult_op}} = $_tok; push @item, $_tok; } $backtrack=1; Parse::RecDescent::_trace(q{Trying subrule: [exp]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{exp})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::exp($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [exp]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $item{q{exp}} = $_tok; push @item, $_tok; } $savetext = $text; $repcount++; } $text = $savetext; pop @item if $backtrack; unless (@item) { undef $_tok; last } $_tok = [ @item ]; last; } # end of OPLOOP unless ($repcount>=1) { Parse::RecDescent::_trace(q{<]>>}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched operator: []<< (return value: [} . qq{@{$_tok||[]}} . q{]}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; push @item, $item{__DIRECTIVE1__}=$_tok||[]; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'multiplication ' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: []<<}, Parse::RecDescent::_tracefirst($text), q{multiplication}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{multiplication}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{multiplication}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{multiplication}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{multiplication}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::parse { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"parse"}; Parse::RecDescent::_trace(q{Trying rule: [parse]}, Parse::RecDescent::_tracefirst($_[1]), q{parse}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{expr, or //}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [expr /^\\Z/]}, Parse::RecDescent::_tracefirst($_[1]), q{parse}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{parse}); %item = (__RULE__ => q{parse}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying subrule: [expr]}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [expr]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $item{q{expr}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying terminal: [/^\\Z/]}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/^\\Z/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^\Z)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { $return = $item[1] }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [expr /^\\Z/]<<}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [//]}, Parse::RecDescent::_tracefirst($_[1]), q{parse}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{parse}); %item = (__RULE__ => q{parse}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [//]}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do {undef}; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [//]<<}, Parse::RecDescent::_tracefirst($text), q{parse}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{parse}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{parse}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{parse}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{parse}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::addition { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"addition"}; Parse::RecDescent::_trace(q{Trying rule: [addition]}, Parse::RecDescent::_tracefirst($_[1]), q{addition}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: []}, Parse::RecDescent::_tracefirst($_[1]), q{addition}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{addition}); %item = (__RULE__ => q{addition}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying operator: []}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $expectation->is(q{})->at($text); $_tok = undef; OPLOOP: while (1) { $repcount = 0; my @item; my %item; # MATCH LEFTARG Parse::RecDescent::_trace(q{Trying subrule: [multiplication]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{multiplication})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::multiplication($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [multiplication]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $item{q{multiplication}} = $_tok; push @item, $_tok; } $repcount++; my $savetext = $text; my $backtrack; # MATCH (OP RIGHTARG)(s) while ($repcount < 100000000) { $backtrack = 0; Parse::RecDescent::_trace(q{Trying subrule: [add_op]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{add_op})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::add_op($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [add_op]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $item{q{add_op}} = $_tok; push @item, $_tok; } $backtrack=1; Parse::RecDescent::_trace(q{Trying subrule: [multiplication]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{multiplication})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::multiplication($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [multiplication]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $item{q{multiplication}} = $_tok; push @item, $_tok; } $savetext = $text; $repcount++; } $text = $savetext; pop @item if $backtrack; unless (@item) { undef $_tok; last } $_tok = [ @item ]; last; } # end of OPLOOP unless ($repcount>=1) { Parse::RecDescent::_trace(q{<]>>}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched operator: []<< (return value: [} . qq{@{$_tok||[]}} . q{]}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; push @item, $item{__DIRECTIVE1__}=$_tok||[]; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'addition ' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: []<<}, Parse::RecDescent::_tracefirst($text), q{addition}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{addition}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{addition}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{addition}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{addition}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::factor { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"factor"}; Parse::RecDescent::_trace(q{Trying rule: [factor]}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/(?:\\+|-)*/}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/(?:\\+|-)*/ number]}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{factor}); %item = (__RULE__ => q{factor}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\+|-)*/]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\+|-)*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [number]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{number})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::number($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [number]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $item{q{number}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'unary_n ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/(?:\\+|-)*/ number]<<}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/(?:\\+|-)*/ function]}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{factor}); %item = (__RULE__ => q{factor}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\+|-)*/]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\+|-)*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [function]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{function})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::function($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [function]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $item{q{function}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'unary_f ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/(?:\\+|-)*/ function]<<}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/(?:\\+|-)*/ variable]}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[2]; $text = $_[1]; my $_savetext; @item = (q{factor}); %item = (__RULE__ => q{factor}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\+|-)*/]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\+|-)*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [variable]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{variable})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::variable($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [variable]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $item{q{variable}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'unary_v ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[2] } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/(?:\\+|-)*/ variable]<<}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/(?:\\+|-)*/ '(' expr ')']}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[3]; $text = $_[1]; my $_savetext; @item = (q{factor}); %item = (__RULE__ => q{factor}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\+|-)*/]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\+|-)*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: ['(']}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{'('})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\(/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{Trying subrule: [expr]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{expr})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [expr]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $item{q{expr}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying terminal: [')']}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{')'})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING2__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'unary_expr ' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[3]; foreach (grep {$_ eq '-'} @it) { $ret = Math::Symbolic::Operator->new('neg',$ret); } $ret } else { $item[3] } }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [/(?:\\+|-)*/ '(' expr ')']<<}, Parse::RecDescent::_tracefirst($text), q{factor}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{factor}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{factor}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{factor}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{factor}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::identifier_list { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"identifier_list"}; Parse::RecDescent::_trace(q{Trying rule: [identifier_list]}, Parse::RecDescent::_tracefirst($_[1]), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: []}, Parse::RecDescent::_tracefirst($_[1]), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{identifier_list}); %item = (__RULE__ => q{identifier_list}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying operator: []}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; $expectation->is(q{})->at($text); $_tok = undef; OPLOOP: while (1) { $repcount = 0; my @item; my %item; # MATCH LEFTARG Parse::RecDescent::_trace(q{Trying terminal: [/[a-zA-Z][a-zA-Z0-9_]*/]}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/[a-zA-Z][a-zA-Z0-9_]*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[a-zA-Z][a-zA-Z0-9_]*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; $repcount++; my $savetext = $text; my $backtrack; # MATCH (OP RIGHTARG)(s) while ($repcount < 100000000) { $backtrack = 0; Parse::RecDescent::_trace(q{Trying terminal: [',']}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{','})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\,/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; pop @item; Parse::RecDescent::_trace(q{Trying terminal: [/[a-zA-Z][a-zA-Z0-9_]*/]}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/[a-zA-Z][a-zA-Z0-9_]*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[a-zA-Z][a-zA-Z0-9_]*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; $savetext = $text; $repcount++; } $text = $savetext; pop @item if $backtrack; unless (@item) { undef $_tok; last } $_tok = [ @item ]; last; } # end of OPLOOP unless ($repcount>=1) { Parse::RecDescent::_trace(q{<]>>}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched operator: []<< (return value: [} . qq{@{$_tok||[]}} . q{]}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; push @item, $item{__DIRECTIVE1__}=$_tok||[]; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'identifier_list ' # if $Math::Symbolic::Parser::DEBUG; $item[1] }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: []<<}, Parse::RecDescent::_tracefirst($text), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{identifier_list}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{identifier_list}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{identifier_list}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{identifier_list}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"expr"}; Parse::RecDescent::_trace(q{Trying rule: [expr]}, Parse::RecDescent::_tracefirst($_[1]), q{expr}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{addition}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [addition]}, Parse::RecDescent::_tracefirst($_[1]), q{expr}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{expr}); %item = (__RULE__ => q{expr}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying subrule: [addition]}, Parse::RecDescent::_tracefirst($text), q{expr}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::addition($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{expr}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [addition]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{expr}, $tracelevel) if defined $::RD_TRACE; $item{q{addition}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{expr}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'expr ' if $Math::Symbolic::Parser::DEBUG; $item[1] }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: [addition]<<}, Parse::RecDescent::_tracefirst($text), q{expr}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{expr}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{expr}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{expr}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{expr}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::mult_op { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"mult_op"}; Parse::RecDescent::_trace(q{Trying rule: [mult_op]}, Parse::RecDescent::_tracefirst($_[1]), q{mult_op}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'*', or '/'}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['*']}, Parse::RecDescent::_tracefirst($_[1]), q{mult_op}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{mult_op}); %item = (__RULE__ => q{mult_op}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['*']}, Parse::RecDescent::_tracefirst($text), q{mult_op}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\*/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['*']<<}, Parse::RecDescent::_tracefirst($text), q{mult_op}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['/']}, Parse::RecDescent::_tracefirst($_[1]), q{mult_op}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{mult_op}); %item = (__RULE__ => q{mult_op}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['/']}, Parse::RecDescent::_tracefirst($text), q{mult_op}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\//) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['/']<<}, Parse::RecDescent::_tracefirst($text), q{mult_op}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{mult_op}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{mult_op}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{mult_op}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{mult_op}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::function_name { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"function_name"}; Parse::RecDescent::_trace(q{Trying rule: [function_name]}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'log', or 'partial_derivative', or 'total_derivative', or 'sinh', or 'cosh', or 'asinh', or 'acosh', or 'asin', or 'acos', or 'atan2', or 'atan', or 'acot', or 'sin', or 'cos', or 'tan', or 'cot', or 'exp', or 'sqrt'}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['log']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['log']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Alog/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['log']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['partial_derivative']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['partial_derivative']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Apartial_derivative/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['partial_derivative']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['total_derivative']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[2]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['total_derivative']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Atotal_derivative/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['total_derivative']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['sinh']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[3]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['sinh']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Asinh/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['sinh']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['cosh']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[4]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['cosh']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Acosh/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['cosh']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['asinh']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[5]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['asinh']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aasinh/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['asinh']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['acosh']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[6]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['acosh']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aacosh/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['acosh']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['asin']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[7]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['asin']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aasin/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['asin']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['acos']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[8]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['acos']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aacos/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['acos']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['atan2']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[9]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['atan2']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aatan2/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['atan2']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['atan']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[10]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['atan']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aatan/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['atan']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['acot']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[11]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['acot']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aacot/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['acot']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['sin']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[12]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['sin']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Asin/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['sin']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['cos']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[13]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['cos']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Acos/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['cos']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['tan']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[14]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['tan']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Atan/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['tan']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['cot']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[15]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['cot']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Acot/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['cot']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['exp']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[16]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['exp']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Aexp/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['exp']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['sqrt']}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[17]; $text = $_[1]; my $_savetext; @item = (q{function_name}); %item = (__RULE__ => q{function_name}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['sqrt']}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\Asqrt/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['sqrt']<<}, Parse::RecDescent::_tracefirst($text), q{function_name}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{function_name}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{function_name}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{function_name}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{function_name}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::add_op { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"add_op"}; Parse::RecDescent::_trace(q{Trying rule: [add_op]}, Parse::RecDescent::_tracefirst($_[1]), q{add_op}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'+', or '-'}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['+']}, Parse::RecDescent::_tracefirst($_[1]), q{add_op}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{add_op}); %item = (__RULE__ => q{add_op}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['+']}, Parse::RecDescent::_tracefirst($text), q{add_op}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\+/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['+']<<}, Parse::RecDescent::_tracefirst($text), q{add_op}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: ['-']}, Parse::RecDescent::_tracefirst($_[1]), q{add_op}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[1]; $text = $_[1]; my $_savetext; @item = (q{add_op}); %item = (__RULE__ => q{add_op}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: ['-']}, Parse::RecDescent::_tracefirst($text), q{add_op}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\-/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: ['-']<<}, Parse::RecDescent::_tracefirst($text), q{add_op}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{add_op}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{add_op}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{add_op}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{add_op}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) sub Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr_list { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"expr_list"}; Parse::RecDescent::_trace(q{Trying rule: [expr_list]}, Parse::RecDescent::_tracefirst($_[1]), q{expr_list}, $tracelevel) if defined $::RD_TRACE; my $err_at = @{$thisparser->{errors}}; my $score; my $score_return; my $_tok; my $return = undef; my $_matched=0; my $commit=0; my @item = (); my %item = (); my $repeating = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: []}, Parse::RecDescent::_tracefirst($_[1]), q{expr_list}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{expr_list}); %item = (__RULE__ => q{expr_list}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying operator: []}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $expectation->is(q{})->at($text); $_tok = undef; OPLOOP: while (1) { $repcount = 0; my @item; my %item; # MATCH LEFTARG Parse::RecDescent::_trace(q{Trying subrule: [expr]}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{expr})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [expr]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $item{q{expr}} = $_tok; push @item, $_tok; } $repcount++; my $savetext = $text; my $backtrack; # MATCH (OP RIGHTARG)(s) while ($repcount < 100000000) { $backtrack = 0; Parse::RecDescent::_trace(q{Trying terminal: [',']}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{','})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\,/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; pop @item; Parse::RecDescent::_trace(q{Trying subrule: [expr]}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; if (1) { no strict qw{refs}; $expectation->is(q{expr})->at($text); unless (defined ($_tok = Parse::RecDescent::Math::Symbolic::Parser::Precompiled::expr($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [expr]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $item{q{expr}} = $_tok; push @item, $_tok; } $savetext = $text; $repcount++; } $text = $savetext; pop @item if $backtrack; unless (@item) { undef $_tok; last } $_tok = [ @item ]; last; } # end of OPLOOP unless ($repcount>=1) { Parse::RecDescent::_trace(q{<]>>}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched operator: []<< (return value: [} . qq{@{$_tok||[]}} . q{]}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; push @item, $item{__DIRECTIVE1__}=$_tok||[]; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $_tok = ($_noactions) ? 0 : do { #warn 'expr_list ' # if $Math::Symbolic::Parser::DEBUG; $item[1] }; unless (defined $_tok) { Parse::RecDescent::_trace(q{<> (return value: [undef])}) if defined $::RD_TRACE; last; } Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} . $_tok . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $_tok; $item{__ACTION1__}=$_tok; Parse::RecDescent::_trace(q{>>Matched production: []<<}, Parse::RecDescent::_tracefirst($text), q{expr_list}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || defined($score) ) { $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{expr_list}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{expr_list}, $tracelevel) if defined $::RD_TRACE; $return = $score_return; } splice @{$thisparser->{errors}}, $err_at; $return = $item[$#item] unless defined $return; if (defined $::RD_TRACE) { Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . $return . q{])}, "", q{expr_list}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{expr_list}, $tracelevel) } $_[1] = $text; return $return; } } package Math::Symbolic::Parser::Precompiled; sub new { my $self = bless( { 'localvars' => '', 'startcode' => '', 'namespace' => 'Parse::RecDescent::Math::Symbolic::Parser::Precompiled', 'rules' => { 'exp' => bless( { 'impcount' => 0, 'calls' => [ 'factor' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 1, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'op' => [], 'items' => [ bless( { 'expected' => '', 'min' => 1, 'name' => '', 'max' => 100000000, 'leftarg' => bless( { 'subrule' => 'factor', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 58 }, 'Parse::RecDescent::Subrule' ), 'rightarg' => bless( { 'subrule' => 'factor', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 58 }, 'Parse::RecDescent::Subrule' ), 'hashname' => '__DIRECTIVE1__', 'type' => 'rightop', 'op' => bless( { 'pattern' => '^', 'hashname' => '__STRING1__', 'description' => '\'^\'', 'lookahead' => 0, 'line' => 58 }, 'Parse::RecDescent::Literal' ) }, 'Parse::RecDescent::Operator' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 59, 'code' => '{ #warn \'exp \' if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = reverse @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( \'^\', shift(@it), $tree ); } $tree; } }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'exp', 'vars' => '', 'changed' => 0, 'line' => 58 }, 'Parse::RecDescent::Rule' ), 'variable' => bless( { 'impcount' => 0, 'calls' => [ 'identifier_list' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 2, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 2, 'actcount' => 1, 'items' => [ bless( { 'description' => '/[a-zA-Z][a-zA-Z0-9_]*/', 'rdelim' => '/', 'pattern' => '[a-zA-Z][a-zA-Z0-9_]*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 200 }, 'Parse::RecDescent::Token' ), bless( { 'description' => '/\\\\\'*/', 'rdelim' => '/', 'pattern' => '\\\'*', 'hashname' => '__PATTERN2__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 200 }, 'Parse::RecDescent::Token' ), bless( { 'pattern' => '(', 'hashname' => '__STRING1__', 'description' => '\'(\'', 'lookahead' => 0, 'line' => 200 }, 'Parse::RecDescent::Literal' ), bless( { 'subrule' => 'identifier_list', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 200 }, 'Parse::RecDescent::Subrule' ), bless( { 'pattern' => ')', 'hashname' => '__STRING2__', 'description' => '\')\'', 'lookahead' => 0, 'line' => 200 }, 'Parse::RecDescent::Literal' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 201, 'code' => '{ #warn \'variable \' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $sig = $item[4] || [\'x\']; my $dep_var = $sig->[0]; my $return = Math::Symbolic::Variable->new( { name => $varname, signature => $sig } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( \'partial_derivative\', $return, $dep_var, ); } $return; } else { Math::Symbolic::Variable->new( { name => $varname, signature => $item[4] } ); } }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 2, 'actcount' => 1, 'items' => [ bless( { 'description' => '/[a-zA-Z][a-zA-Z0-9_]*/', 'rdelim' => '/', 'pattern' => '[a-zA-Z][a-zA-Z0-9_]*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 228 }, 'Parse::RecDescent::Token' ), bless( { 'description' => '/\\\\\'*/', 'rdelim' => '/', 'pattern' => '\\\'*', 'hashname' => '__PATTERN2__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 228 }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 229, 'code' => '{ #warn \'variable \' # if $Math::Symbolic::Parser::DEBUG; my $varname = $item[1]; my $ticks = $item[2]; if ($ticks) { my $n = length($ticks); my $return = Math::Symbolic::Variable->new( { name => $varname, signature => [\'x\'] } ); foreach (1..$n) { $return = Math::Symbolic::Operator->new( \'partial_derivative\', $return, \'x\', ); } $return; } else { Math::Symbolic::Variable->new( $varname ); } }' }, 'Parse::RecDescent::Action' ) ], 'line' => 228 }, 'Parse::RecDescent::Production' ) ], 'name' => 'variable', 'vars' => '', 'changed' => 0, 'line' => 200 }, 'Parse::RecDescent::Rule' ), 'function' => bless( { 'impcount' => 0, 'calls' => [ 'function_name', 'expr_list' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 2, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'items' => [ bless( { 'subrule' => 'function_name', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 151 }, 'Parse::RecDescent::Subrule' ), bless( { 'pattern' => '(', 'hashname' => '__STRING1__', 'description' => '\'(\'', 'lookahead' => 0, 'line' => 151 }, 'Parse::RecDescent::Literal' ), bless( { 'subrule' => 'expr_list', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 151 }, 'Parse::RecDescent::Subrule' ), bless( { 'pattern' => ')', 'hashname' => '__STRING2__', 'description' => '\')\'', 'lookahead' => 0, 'line' => 151 }, 'Parse::RecDescent::Literal' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 152, 'code' => '{ #warn \'function \' # if $Math::Symbolic::Parser::DEBUG; my $fname = $item[1]; my $function; if (exists($Math::Symbolic::Parser::Parser_Functions{$fname})) { $function = $Math::Symbolic::Parser::Parser_Functions{$fname}->($fname, @{$item[3]}); die "Invalid function \'$fname\'!" unless defined $function; } else { $function = $Math::Symbolic::Operator::Op_Symbols{ $fname }; die "Invalid function \'$fname\'!" unless defined $function; $function = Math::Symbolic::Operator->new( { type => $function, operands => $item[3] } ); } $function }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'function', 'vars' => '', 'changed' => 0, 'line' => 151 }, 'Parse::RecDescent::Rule' ), 'number' => bless( { 'impcount' => 0, 'calls' => [], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '/([+-]?)(?=\\\\d|\\\\.\\\\d)\\\\d*(\\\\.\\\\d*)?([Ee]([+-]?\\\\d+))?/', 'rdelim' => '/', 'pattern' => '([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 144 }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 145, 'code' => '{ #warn \'number \' # if $Math::Symbolic::Parser::DEBUG; Math::Symbolic::Constant->new($item[1]) }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'number', 'vars' => '', 'changed' => 0, 'line' => 144 }, 'Parse::RecDescent::Rule' ), 'multiplication' => bless( { 'impcount' => 0, 'calls' => [ 'exp', 'mult_op' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 1, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'op' => [], 'items' => [ bless( { 'expected' => '', 'min' => 1, 'name' => '', 'max' => 100000000, 'leftarg' => bless( { 'subrule' => 'exp', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 35 }, 'Parse::RecDescent::Subrule' ), 'rightarg' => bless( { 'subrule' => 'exp', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 35 }, 'Parse::RecDescent::Subrule' ), 'hashname' => '__DIRECTIVE1__', 'type' => 'leftop', 'op' => bless( { 'subrule' => 'mult_op', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 35 }, 'Parse::RecDescent::Subrule' ) }, 'Parse::RecDescent::Operator' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 36, 'code' => '{ #warn \'multiplication \' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'multiplication', 'vars' => '', 'changed' => 0, 'line' => 35 }, 'Parse::RecDescent::Rule' ), 'parse' => bless( { 'impcount' => 0, 'calls' => [ 'expr' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'subrule' => 'expr', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 1 }, 'Parse::RecDescent::Subrule' ), bless( { 'description' => '/^\\\\Z/', 'rdelim' => '/', 'pattern' => '^\\Z', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 1 }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 2, 'code' => '{ $return = $item[1] }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '//', 'rdelim' => '/', 'pattern' => '', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 5 }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 5, 'code' => '{undef}' }, 'Parse::RecDescent::Action' ) ], 'line' => 5 }, 'Parse::RecDescent::Production' ) ], 'name' => 'parse', 'vars' => '', 'changed' => 0, 'line' => 1 }, 'Parse::RecDescent::Rule' ), 'addition' => bless( { 'impcount' => 0, 'calls' => [ 'multiplication', 'add_op' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 1, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'op' => [], 'items' => [ bless( { 'expected' => '', 'min' => 1, 'name' => '', 'max' => 100000000, 'leftarg' => bless( { 'subrule' => 'multiplication', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 13 }, 'Parse::RecDescent::Subrule' ), 'rightarg' => bless( { 'subrule' => 'multiplication', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 13 }, 'Parse::RecDescent::Subrule' ), 'hashname' => '__DIRECTIVE1__', 'type' => 'leftop', 'op' => bless( { 'subrule' => 'add_op', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 13 }, 'Parse::RecDescent::Subrule' ) }, 'Parse::RecDescent::Operator' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 14, 'code' => '{ #warn \'addition \' # if $Math::Symbolic::Parser::DEBUG; if (@{$item[1]} == 1) { $item[1][0] } else { my @it = @{$item[1]}; my $tree = shift @it; while (@it) { $tree = Math::Symbolic::Operator->new( shift(@it), $tree, shift(@it) ); } $tree; } }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'addition', 'vars' => '', 'changed' => 0, 'line' => 13 }, 'Parse::RecDescent::Rule' ), 'factor' => bless( { 'impcount' => 0, 'calls' => [ 'number', 'function', 'variable', 'expr' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '/(?:\\\\+|-)*/', 'rdelim' => '/', 'pattern' => '(?:\\+|-)*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 76 }, 'Parse::RecDescent::Token' ), bless( { 'subrule' => 'number', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 76 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 77, 'code' => '{ #warn \'unary_n \' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq \'-\'} @it) { $ret = Math::Symbolic::Operator->new(\'neg\',$ret); } $ret } else { $item[2] } }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '/(?:\\\\+|-)*/', 'rdelim' => '/', 'pattern' => '(?:\\+|-)*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 93 }, 'Parse::RecDescent::Token' ), bless( { 'subrule' => 'function', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 93 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 94, 'code' => '{ #warn \'unary_f \' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq \'-\'} @it) { $ret = Math::Symbolic::Operator->new(\'neg\',$ret); } $ret } else { $item[2] } }' }, 'Parse::RecDescent::Action' ) ], 'line' => 93 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 2, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '/(?:\\\\+|-)*/', 'rdelim' => '/', 'pattern' => '(?:\\+|-)*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 110 }, 'Parse::RecDescent::Token' ), bless( { 'subrule' => 'variable', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 110 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 111, 'code' => '{ #warn \'unary_v \' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[2]; foreach (grep {$_ eq \'-\'} @it) { $ret = Math::Symbolic::Operator->new(\'neg\',$ret); } $ret } else { $item[2] } }' }, 'Parse::RecDescent::Action' ) ], 'line' => 110 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 3, 'strcount' => 2, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 1, 'actcount' => 1, 'items' => [ bless( { 'description' => '/(?:\\\\+|-)*/', 'rdelim' => '/', 'pattern' => '(?:\\+|-)*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 127 }, 'Parse::RecDescent::Token' ), bless( { 'pattern' => '(', 'hashname' => '__STRING1__', 'description' => '\'(\'', 'lookahead' => 0, 'line' => 127 }, 'Parse::RecDescent::Literal' ), bless( { 'subrule' => 'expr', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 127 }, 'Parse::RecDescent::Subrule' ), bless( { 'pattern' => ')', 'hashname' => '__STRING2__', 'description' => '\')\'', 'lookahead' => 0, 'line' => 127 }, 'Parse::RecDescent::Literal' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 128, 'code' => '{ #warn \'unary_expr \' # if $Math::Symbolic::Parser::DEBUG; if ($item[1]) { my @it = split //, $item[1]; my $ret = $item[3]; foreach (grep {$_ eq \'-\'} @it) { $ret = Math::Symbolic::Operator->new(\'neg\',$ret); } $ret } else { $item[3] } }' }, 'Parse::RecDescent::Action' ) ], 'line' => 127 }, 'Parse::RecDescent::Production' ) ], 'name' => 'factor', 'vars' => '', 'changed' => 0, 'line' => 76 }, 'Parse::RecDescent::Rule' ), 'identifier_list' => bless( { 'impcount' => 0, 'calls' => [], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 1, 'uncommit' => undef, 'error' => undef, 'patcount' => 2, 'actcount' => 1, 'op' => [], 'items' => [ bless( { 'expected' => '', 'min' => 1, 'name' => '', 'max' => 100000000, 'leftarg' => bless( { 'description' => '/[a-zA-Z][a-zA-Z0-9_]*/', 'rdelim' => '/', 'pattern' => '[a-zA-Z][a-zA-Z0-9_]*', 'hashname' => '__PATTERN1__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 252 }, 'Parse::RecDescent::Token' ), 'rightarg' => bless( { 'description' => '/[a-zA-Z][a-zA-Z0-9_]*/', 'rdelim' => '/', 'pattern' => '[a-zA-Z][a-zA-Z0-9_]*', 'hashname' => '__PATTERN2__', 'lookahead' => 0, 'ldelim' => '/', 'mod' => '', 'line' => 252 }, 'Parse::RecDescent::Token' ), 'hashname' => '__DIRECTIVE1__', 'type' => 'leftop', 'op' => bless( { 'pattern' => ',', 'hashname' => '__STRING1__', 'description' => '\',\'', 'lookahead' => 0, 'line' => 252 }, 'Parse::RecDescent::Literal' ) }, 'Parse::RecDescent::Operator' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 253, 'code' => '{ #warn \'identifier_list \' # if $Math::Symbolic::Parser::DEBUG; $item[1] }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'identifier_list', 'vars' => '', 'changed' => 0, 'line' => 252 }, 'Parse::RecDescent::Rule' ), 'expr' => bless( { 'impcount' => 0, 'calls' => [ 'addition' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'items' => [ bless( { 'subrule' => 'addition', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 7 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 8, 'code' => '{ #warn \'expr \' if $Math::Symbolic::Parser::DEBUG; $item[1] }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'expr', 'vars' => '', 'changed' => 0, 'line' => 7 }, 'Parse::RecDescent::Rule' ), 'mult_op' => bless( { 'impcount' => 0, 'calls' => [], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => '*', 'hashname' => '__STRING1__', 'description' => '\'*\'', 'lookahead' => 0, 'line' => 54 }, 'Parse::RecDescent::Literal' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => '/', 'hashname' => '__STRING1__', 'description' => '\'/\'', 'lookahead' => 0, 'line' => 55 }, 'Parse::RecDescent::Literal' ) ], 'line' => 55 }, 'Parse::RecDescent::Production' ) ], 'name' => 'mult_op', 'vars' => '', 'changed' => 0, 'line' => 54 }, 'Parse::RecDescent::Rule' ), 'function_name' => bless( { 'impcount' => 0, 'calls' => [], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'log', 'hashname' => '__STRING1__', 'description' => '\'log\'', 'lookahead' => 0, 'line' => 173 }, 'Parse::RecDescent::Literal' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'partial_derivative', 'hashname' => '__STRING1__', 'description' => '\'partial_derivative\'', 'lookahead' => 0, 'line' => 174 }, 'Parse::RecDescent::Literal' ) ], 'line' => 174 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 2, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'total_derivative', 'hashname' => '__STRING1__', 'description' => '\'total_derivative\'', 'lookahead' => 0, 'line' => 175 }, 'Parse::RecDescent::Literal' ) ], 'line' => 175 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 3, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'sinh', 'hashname' => '__STRING1__', 'description' => '\'sinh\'', 'lookahead' => 0, 'line' => 176 }, 'Parse::RecDescent::Literal' ) ], 'line' => 176 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 4, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'cosh', 'hashname' => '__STRING1__', 'description' => '\'cosh\'', 'lookahead' => 0, 'line' => 177 }, 'Parse::RecDescent::Literal' ) ], 'line' => 177 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 5, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'asinh', 'hashname' => '__STRING1__', 'description' => '\'asinh\'', 'lookahead' => 0, 'line' => 178 }, 'Parse::RecDescent::Literal' ) ], 'line' => 178 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 6, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'acosh', 'hashname' => '__STRING1__', 'description' => '\'acosh\'', 'lookahead' => 0, 'line' => 179 }, 'Parse::RecDescent::Literal' ) ], 'line' => 179 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 7, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'asin', 'hashname' => '__STRING1__', 'description' => '\'asin\'', 'lookahead' => 0, 'line' => 180 }, 'Parse::RecDescent::Literal' ) ], 'line' => 180 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 8, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'acos', 'hashname' => '__STRING1__', 'description' => '\'acos\'', 'lookahead' => 0, 'line' => 181 }, 'Parse::RecDescent::Literal' ) ], 'line' => 181 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 9, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'atan2', 'hashname' => '__STRING1__', 'description' => '\'atan2\'', 'lookahead' => 0, 'line' => 182 }, 'Parse::RecDescent::Literal' ) ], 'line' => 182 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 10, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'atan', 'hashname' => '__STRING1__', 'description' => '\'atan\'', 'lookahead' => 0, 'line' => 183 }, 'Parse::RecDescent::Literal' ) ], 'line' => 183 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 11, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'acot', 'hashname' => '__STRING1__', 'description' => '\'acot\'', 'lookahead' => 0, 'line' => 184 }, 'Parse::RecDescent::Literal' ) ], 'line' => 184 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 12, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'sin', 'hashname' => '__STRING1__', 'description' => '\'sin\'', 'lookahead' => 0, 'line' => 185 }, 'Parse::RecDescent::Literal' ) ], 'line' => 185 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 13, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'cos', 'hashname' => '__STRING1__', 'description' => '\'cos\'', 'lookahead' => 0, 'line' => 186 }, 'Parse::RecDescent::Literal' ) ], 'line' => 186 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 14, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'tan', 'hashname' => '__STRING1__', 'description' => '\'tan\'', 'lookahead' => 0, 'line' => 187 }, 'Parse::RecDescent::Literal' ) ], 'line' => 187 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 15, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'cot', 'hashname' => '__STRING1__', 'description' => '\'cot\'', 'lookahead' => 0, 'line' => 188 }, 'Parse::RecDescent::Literal' ) ], 'line' => 188 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 16, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'exp', 'hashname' => '__STRING1__', 'description' => '\'exp\'', 'lookahead' => 0, 'line' => 189 }, 'Parse::RecDescent::Literal' ) ], 'line' => 189 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 17, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => 'sqrt', 'hashname' => '__STRING1__', 'description' => '\'sqrt\'', 'lookahead' => 0, 'line' => 190 }, 'Parse::RecDescent::Literal' ) ], 'line' => 190 }, 'Parse::RecDescent::Production' ) ], 'name' => 'function_name', 'vars' => '', 'changed' => 0, 'line' => 173 }, 'Parse::RecDescent::Rule' ), 'add_op' => bless( { 'impcount' => 0, 'calls' => [], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => '+', 'hashname' => '__STRING1__', 'description' => '\'+\'', 'lookahead' => 0, 'line' => 32 }, 'Parse::RecDescent::Literal' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'strcount' => 1, 'dircount' => 0, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 0, 'items' => [ bless( { 'pattern' => '-', 'hashname' => '__STRING1__', 'description' => '\'-\'', 'lookahead' => 0, 'line' => 33 }, 'Parse::RecDescent::Literal' ) ], 'line' => 33 }, 'Parse::RecDescent::Production' ) ], 'name' => 'add_op', 'vars' => '', 'changed' => 0, 'line' => 32 }, 'Parse::RecDescent::Rule' ), 'expr_list' => bless( { 'impcount' => 0, 'calls' => [ 'expr' ], 'opcount' => 0, 'prods' => [ bless( { 'number' => 0, 'strcount' => 1, 'dircount' => 1, 'uncommit' => undef, 'error' => undef, 'patcount' => 0, 'actcount' => 1, 'op' => [], 'items' => [ bless( { 'expected' => '', 'min' => 1, 'name' => '', 'max' => 100000000, 'leftarg' => bless( { 'subrule' => 'expr', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 193 }, 'Parse::RecDescent::Subrule' ), 'rightarg' => bless( { 'subrule' => 'expr', 'matchrule' => 0, 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, 'line' => 193 }, 'Parse::RecDescent::Subrule' ), 'hashname' => '__DIRECTIVE1__', 'type' => 'leftop', 'op' => bless( { 'pattern' => ',', 'hashname' => '__STRING1__', 'description' => '\',\'', 'lookahead' => 0, 'line' => 193 }, 'Parse::RecDescent::Literal' ) }, 'Parse::RecDescent::Operator' ), bless( { 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 194, 'code' => '{ #warn \'expr_list \' # if $Math::Symbolic::Parser::DEBUG; $item[1] }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef }, 'Parse::RecDescent::Production' ) ], 'name' => 'expr_list', 'vars' => '', 'changed' => 0, 'line' => 193 }, 'Parse::RecDescent::Rule' ) }, '_AUTOTREE' => undef, '_check' => { 'thisoffset' => '', 'itempos' => '', 'prevoffset' => '', 'prevline' => '', 'prevcolumn' => '', 'thiscolumn' => '' }, '_AUTOACTION' => undef }, 'Parse::RecDescent' ); } 1; Math-Symbolic-0.612/xt000755001750001750 012157534055 13717 5ustar00tseetsee000000000000Math-Symbolic-0.612/xt/00podcover.t000444001750001750 220412157534055 16220 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More; my @packages = qw( Math::Symbolic Math::Symbolic::AuxFunctions Math::Symbolic::Base Math::Symbolic::Compiler Math::Symbolic::Constant Math::Symbolic::Custom Math::Symbolic::Custom::Base Math::Symbolic::Custom::DefaultDumpers Math::Symbolic::Custom::DefaultMods Math::Symbolic::Custom::DefaultTests Math::Symbolic::Derivative Math::Symbolic::ExportConstants Math::Symbolic::MiscAlgebra Math::Symbolic::MiscCalculus Math::Symbolic::Operator Math::Symbolic::Parser Math::Symbolic::Variable Math::Symbolic::VectorCalculus ); eval { require Test::Pod::Coverage; }; if ($@) { plan skip_all => 'Test::Pod::Coverage not installed'; exit; } else { import Test::Pod::Coverage; plan tests => (4+scalar(@packages)); } use_ok('Math::Symbolic'); use_ok('Math::Symbolic::MiscAlgebra'); use_ok('Math::Symbolic::VectorCalculus'); use_ok('Math::Symbolic::MiscCalculus'); my $also_private = {also_private=> [qr/^_/, qr/^\(/, qr/^AUTOLOAD$/, qr/^DESTROY$/, '^can$']}; foreach my $namespace (@packages) { pod_coverage_ok( $namespace, $also_private ); } Math-Symbolic-0.612/xt/00dist.t000444001750001750 42212157534055 15322 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More; BEGIN { eval { require Test::Distribution; }; if ($@) { plan skip_all => 'Test::Distribution not installed'; } else { Test::Distribution->import( not => [qw(sig prereq podcover)] ); } } Math-Symbolic-0.612/xt/00pod.t000444001750001750 22512157534055 15142 0ustar00tseetsee000000000000#!perl use strict; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Math-Symbolic-0.612/t000755001750001750 012157534055 13527 5ustar00tseetsee000000000000Math-Symbolic-0.612/t/09hyperbolic.t000444001750001750 466312157534055 16373 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 7; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); my $c = Math::Symbolic::Constant->zero(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin; undef $@; eval <<'HERE'; $sin = $op->new('sinh', $op->new('*', $two, $a)); HERE ok( !$@, 'hyperbolic sine creation' ); my $asin; undef $@; eval <<'HERE'; $asin = $op->new('asinh', $op->new('*', $two, $a)); HERE ok( !$@ && defined($asin), 'area hyperbolic sine creation' ); print "Expression: sinh(2*x) and asinh(2*x)\n\n"; print "prefix notation and evaluation:\n"; undef $@; eval <<'HERE'; print $sin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'h. sine to_string' ); undef $@; eval <<'HERE'; print $asin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'area h. sine to_string' ); print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $sin, $a ], } ); my $n_tree2 = $op->new( { type => U_P_DERIVATIVE, operands => [ $asin, $a ], } ); print $n_tree->to_string('prefix') . "\n\n"; print $n_tree2->to_string('prefix') . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived; undef $@; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'h. sine derivative' ); my $derived2; undef $@; eval <<'HERE'; $derived2 = $n_tree2->apply_derivatives(); HERE ok( !$@, 'area h. sine derivative' ); print "$derived\n\n"; print "$derived2\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); $derived2 = $derived2->simplify(); print "$derived\n\n"; print "$derived2\n\n"; print "Now, we do this two more times:\n"; for ( 1 .. 2 ) { $derived = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived, $a ], } )->apply_derivatives()->simplify(); $derived2 = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived2, $a ], } )->apply_derivatives()->simplify(); } print "$derived\n\n"; print "$derived2\n\n"; Math-Symbolic-0.612/t/07simple_trig.t000444001750001750 1227712157534055 16567 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 28; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); my $c = Math::Symbolic::Constant->zero(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin; eval <<'HERE'; $sin = $op->new('sin', $op->new('*', $two, $a)); HERE ok( !$@, 'sine creation'.($@?" Error: $@":'') ); print "Expression: sin(2*x)\n\n"; print "prefix notation and evaluation:\n"; eval <<'HERE'; print $sin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'sine to_string' ); print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $sin, $a ], } ); print $n_tree->to_string('prefix') . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'sine derivative'.($@?" Error: $@":'') ); print "$derived\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); print "$derived\n\n"; print "Now, we do this three more times:\n"; for ( 1 .. 3 ) { $derived = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived, $a ], } )->apply_derivatives()->simplify(); } print "$derived\n\n"; # tests for some trig functions use Math::Symbolic qw/PI/; my $tan = Math::Symbolic->parse_from_string('tan(x)'); ok(ref($tan) =~ /^Math::Symbolic/, 'tan(x) parses'); ok( $tan->test_num_equiv( sub {sin($_[0])/cos($_[0])}, limits => {x => sub {my $x = $_[0] % PI; $x > PI / 2 + 1e-5 or $x < PI / 2 - 1e-5}}, ), 'tan() is a real tan' ); ok( $tan->test_num_equiv( \&Math::Symbolic::AuxFunctions::tan, limits => {x => sub {my $x = $_[0] % PI; $x > PI / 2 + 1e-5 or $x < PI / 2 - 1e-5}}, ), 'M::S::AuxF::tan is a real tan' ); my $cot = Math::Symbolic->parse_from_string('cot(x)'); ok(ref($cot) =~ /^Math::Symbolic/, 'cot(x) parses'); ok( $cot->test_num_equiv( sub {cos($_[0])/sin($_[0])}, limits => {x => sub {my $x = $_[0] % PI; $x > 1e-5 and $x < PI - 1e-5}}, ), 'cot() is a real cot' ); ok( $cot->test_num_equiv( \&Math::Symbolic::AuxFunctions::cot, limits => {x => sub {my $x = $_[0] % PI; $x > 1e-5 and $x < PI - 1e-5}}, ), 'M::S::AuxF::cot is a real cot' ); my $asin = Math::Symbolic->parse_from_string('asin(x)'); ok(ref($asin) =~ /^Math::Symbolic/, 'asin(x) parses'); ok( $asin->test_num_equiv( sub {atan2($_[0], sqrt(1-$_[0]**2))}, limits => {x => sub {my $x=shift; $x > 0 and $x < 1}}, ), 'asin() is a real asin' ); ok( $asin->test_num_equiv( \&Math::Symbolic::AuxFunctions::asin, limits => {x => sub {my $x=shift; $x > 0 and $x < 1}}, ), 'M::S::AuxF::asin is a real asin' ); my $acos = Math::Symbolic->parse_from_string('acos(x)'); ok(ref($acos) =~ /^Math::Symbolic/, 'acos(x) parses'); ok( $acos->test_num_equiv( sub {atan2(sqrt(1-$_[0]**2), $_[0])}, limits => {x => sub {my $x=shift; $x > 0 and $x < 1}}, ), 'acos() is a real acos' ); ok( $acos->test_num_equiv( \&Math::Symbolic::AuxFunctions::acos, limits => {x => sub {my $x=shift; $x > 0 and $x < 1}}, ), 'M::S::AuxF::acos is a real acos' ); my $atan = Math::Symbolic->parse_from_string('atan(x)'); ok(ref($atan) =~ /^Math::Symbolic/, 'atan(x) parses'); ok( $atan->test_num_equiv( sub {atan2($_[0], 1)}, ), 'atan() is a real atan' ); ok( $atan->test_num_equiv( \&Math::Symbolic::AuxFunctions::atan, ), 'M::S::AuxF::atan is a real atan' ); my $acot = Math::Symbolic->parse_from_string('acot(x)'); ok(ref($acot) =~ /^Math::Symbolic/, 'acot(x) parses'); ok( $acot->test_num_equiv( sub {atan2(1/$_[0], 1)}, limits => {x => sub {my $x=shift; $x > 1e-6 or $x < -1e-6}}, ), 'acot() is a real acot' ); ok( $acot->test_num_equiv( \&Math::Symbolic::AuxFunctions::acot, limits => {x => sub {my $x=shift; $x > 1e-6 or $x < -1e-6}}, ), 'M::S::AuxF::acot is a real acot' ); my $asinh = Math::Symbolic->parse_from_string('asinh(x)'); ok(ref($asinh) =~ /^Math::Symbolic/, 'asinh(x) parses'); ok( $asinh->test_num_equiv( sub {log($_[0] + sqrt($_[0]**2 + 1))}, ), 'asinh() is a real asinh' ); ok( $asinh->test_num_equiv( \&Math::Symbolic::AuxFunctions::asinh, ), 'M::S::AuxF::asinh is a real asinh' ); my $acosh = Math::Symbolic->parse_from_string('acosh(x)'); ok(ref($acosh) =~ /^Math::Symbolic/, 'acosh(x) parses'); ok( $acosh->test_num_equiv( sub {log($_[0] + sqrt($_[0]**2 - 1))}, limits => {x => sub {$_[0] > 1}}, ), 'acosh() is a real acosh' ); ok( $acosh->test_num_equiv( \&Math::Symbolic::AuxFunctions::acosh, limits => {x => sub {$_[0] > 1}}, ), 'M::S::AuxF::acosh is a real acosh' ); Math-Symbolic-0.612/t/16tests.t000444001750001750 1435512157534055 15412 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 48; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic qw/:all/; use Math::Symbolic::ExportConstants qw/:all/; my $x = Math::Symbolic::parse_from_string('1'); ok( $x->is_constant(), 'is_constant true for constants' ); $x = Math::Symbolic::parse_from_string('a'); ok( !$x->is_constant(), 'is_constant false for vars' ); $x = Math::Symbolic::parse_from_string('1+1/5*log(2,3)^5'); ok( $x->is_constant(), 'is_constant true for constant expressions' ); $x = Math::Symbolic::parse_from_string('1+1/5*log(2,a)^5'); ok( !$x->is_constant(), 'is_constant false for non-constant expressions' ); $x = Math::Symbolic::parse_from_string('partial_derivative(1+1/5*log(2,2)^5-a,a)'); ok( $x->is_constant(), 'is_constant true for expressions that become constant after del/delx' ); $x = Math::Symbolic::parse_from_string('total_derivative(1+1/5*log(2,2)^5-a,a)'); ok( $x->is_constant(), 'is_constant true for expressions that become constant after d/dx' ); $x = Math::Symbolic::parse_from_string( 'total_derivative(b(a)+1/5*log(2,2)^5-a,a)'); ok( !$x->is_constant(), 'is_constant true for expressions that become constant after d/dx' ); $x = Math::Symbolic::parse_from_string('a'); ok( !$x->is_integer(), 'is_integer false for vars' ); $x = Math::Symbolic::parse_from_string('1.5'); ok( !$x->is_integer(), 'is_integer false for fractions' ); $x = Math::Symbolic::parse_from_string('2000'); ok( $x->is_integer(), 'is_integer true for integers' ); $x = Math::Symbolic::parse_from_string('0'); ok( $x->is_integer(), 'is_integer true for zero' ); $x = Math::Symbolic::parse_from_string('2000*2000'); ok( !$x->is_integer(), 'is_integer false for operators' ); $x = Math::Symbolic::parse_from_string('1'); ok( $x->is_sum(), 'is_sum true for constant' ); $x = Math::Symbolic::parse_from_string('1+2'); ok( $x->is_sum(), 'is_sum true for constant sum' ); $x = Math::Symbolic::parse_from_string('1*a'); ok( $x->is_sum(), 'is_sum true for constant times variable' ); $x = Math::Symbolic::parse_from_string('1*a'); ok( $x->is_sum(), 'is_sum true for integer constant times variable' ); $x = Math::Symbolic::parse_from_string('1.5*a'); ok( !$x->is_sum(), 'is_sum false for non-integer constant times variable' ); $x = Math::Symbolic::parse_from_string('1*a+(-b)-3*sin(2)'); ok( $x->is_sum(), 'is_sum true for sum of variables and constant terms' ); $x = Math::Symbolic::parse_from_string( 'partial_derivative(10*a^2+(-1/b)-3*sin(2),a)'); ok( $x->is_sum(), 'is_sum true for del/delx that evaluates to a sum' ); my $y = Math::Symbolic::parse_from_string( 'partial_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); $x = Math::Symbolic::parse_from_string( 'partial_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); ok( $x->is_identical($y), 'is_identical true involved term' ); $y = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(c(d,f,g,i,a)-2),a)'); $x = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(c(d,f,g,i,a)-2),a)'); ok( $x->is_identical($y), 'is_identical true involved term' ); $y = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(a))-3*sin(2),a)'); $x = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); ok( !$x->is_identical($y), 'is_identical false involved term differing in signature' ); $y = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-2/b(x))-3*sin(2),a)'); $x = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); ok( !$x->is_identical($y), 'is_identical false involved term differing in constant' ); $y = Math::Symbolic::parse_from_string( 'total_derivative(10*x^2+(-1/b(x))-3*sin(2),a)'); $x = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); ok( !$x->is_identical($y), 'is_identical false involved term differing in variable' ); $y = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1*b(x))-3*sin(2),a)'); $x = Math::Symbolic::parse_from_string( 'total_derivative(10*a^2+(-1/b(x))-3*sin(2),a)'); ok( !$x->is_identical($y), 'is_identical false involved term differing in operator' ); ok( ( $x->can('descend') and defined( ref( $x->can('descend') ) ) and ref( $x->can('descend') ) eq 'CODE' ), 'can() returns code ref for builtin method.' ); ok( ( $x->can('is_constant') and defined( ref( $x->can('is_constant') ) ) and ref( $x->can('is_constant') ) eq 'CODE' ), 'can() returns code ref for delegated method.' ); ok( !$x->can('bdasjkhdsajhdsakasjlh'), 'can() returns false for non-existant builtin method.' ); ok( !$x->can('is_ashdgsajhgdasjhg'), 'can() returns false for non-existant delegated method.' ); ok( parse_from_string('x*y')->is_identical_base('x*y'), 'is_identical_base trivial' ); ok( parse_from_string('(x*y)^2')->is_identical_base('x*y'), 'is_identical_base simple' ); ok( parse_from_string('(x*y)^(a*b)')->is_identical_base('x*y'), 'more is_identical_base tests' ); ok( parse_from_string('(x*y)^(a*b)')->is_identical_base('(x*y)^3'), 'more is_identical_base tests' ); ok( parse_from_string('(x*y^3)')->is_identical_base('(x*y^3)^3'), 'more is_identical_base tests' ); ok( not( parse_from_string('(y)^(a*b)')->is_identical_base('(x*y)^3') ), 'more is_identical_base tests' ); ok( parse_from_string('1')->is_one(), '1 is_one' ); ok( !parse_from_string('0')->is_one(), '!0 is_one' ); ok( !parse_from_string('4-3')->is_one(), '!4-3 is_one' ); ok( !parse_from_string('a')->is_one(), '!a is_one' ); ok( !parse_from_string('1')->is_zero(), '!1 is_zero' ); ok( parse_from_string('0')->is_zero(), '!0 is_zero' ); ok( !parse_from_string('4-4')->is_zero(), '!4-4 is_zero' ); ok( !parse_from_string('a')->is_zero(), '!a is_zero' ); ok( parse_from_string('1')->is_zero_or_one(), '1 is_zero_or_one' ); ok( parse_from_string('0')->is_zero_or_one(), '0 is_zero_or_one' ); ok( !parse_from_string('4-4')->is_zero_or_one(), '!4-4 is_zero_or_one' ); ok( !parse_from_string('a')->is_zero_or_one(), '!a is_zero_or_one' ); Math-Symbolic-0.612/t/17modifications.t000444001750001750 575012157534055 17060 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 29; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $x = Math::Symbolic::parse_from_string('1+2'); ok( $x->apply_constant_fold()->to_string() eq '3', 'apply_constant_fold() working for simple case' ); $x = Math::Symbolic::parse_from_string('a'); ok( $x->apply_constant_fold()->to_string() eq 'a', 'apply_constant_fold() working for simple case' ); $x = Math::Symbolic::parse_from_string('a / (2 * 5)'); ok( $x->apply_constant_fold()->to_string() eq 'a / 10', 'apply_constant_fold() working for simple case' ); $x = Math::Symbolic::parse_from_string('d*acos(cos(1))'); ok( $x->apply_constant_fold()->to_string() eq 'd * 1', 'apply_constant_fold() working for simple case' ); $x = Math::Symbolic::parse_from_string('(1 + -2 * 7/(5+2) * 2^(3-1)) * d'); ok( $x->apply_constant_fold()->to_string() eq '-7 * d', 'apply_constant_fold() working for simple case' ); # test mod_add_constant: my @tests = ( # tree, constant, result [qw!x+x^2 3 3+(x+x^2) !], [qw!3+(x+x^2) -3 x+x^2 !], [qw!x-x^2 3 3+(x-x^2) !], [qw!2+(x+x^2) -1 1+(x+x^2) !], [qw!(x+x^2)+2 -1 (x+x^2)+1 !], [qw!(x+x^2)+1 -1 x+x^2 !], [qw!(x*x^2)+5 -4 x*x^2+1 !], [qw!(x+(x^2+2)) -4 x+(x^2+(-2))!], [qw!(x+(x^2+2)) -2 x+(x^2) !], [qw!(x+(x^2+2)) 0 x+(x^2+2) !], [qw!x+(x+(1+x)) 2 x+(x+(3+x))!], ); for (@tests) { my $tree = Math::Symbolic->parse_from_string($_->[0]); my $res = Math::Symbolic->parse_from_string($_->[2]); my $actual = $tree->mod_add_constant($_->[1]); ok( $actual->is_identical($res), "$_->[0] plus $_->[1] should be $_->[2] (result: $actual)" ); } # test mod_multiply_constant: @tests = ( # tree, constant, result [qw!x*x^2 3 3*(x*x^2) !], [qw!3*(x*x^2) 1/3 x*x^2 !], [qw!x/x^2 3 3*(x/x^2) !], [qw!x/x^2 0 0 !], [qw!4*(x*x^2) 1/2 2*(x*x^2) !], [qw!(x*x^2)*4 1/2 (x*x^2)*2 !], [qw!(x*x^2)*3 1/3 x*x^2 !], [qw!(x^x^2)*8 1/4 x^x^2*2 !], [qw!(x*(x^2*2)) 1/4 x*(x^2*0.5) !], [qw!(x*(x^2*2)) 1/2 x*(x^2) !], [qw!(x*(x^2*2)) 1 x*(x^2*2) !], [qw!x*(x*(2*x)) 3 x*(x*(6*x)) !], ); for (@tests) { my $c = eval "$_->[1]"; my $tree = Math::Symbolic->parse_from_string($_->[0]); my $res = Math::Symbolic->parse_from_string($_->[2]); my $actual = $tree->mod_multiply_constant($c); ok( $actual->is_identical($res), "$_->[0] times $_->[1] should be $_->[2] (result: $actual)" ); } Math-Symbolic-0.612/t/06parser.t000444001750001750 1262112157534055 15535 0ustar00tseetsee000000000000#!perl # BEGIN{$::RD_HINT = 1;} use strict; use warnings; use Test::More tests => 23+15+9; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $tree; undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('2'); HERE ok( ( !$@ and ref($tree) eq 'Math::Symbolic::Constant' ), 'Parsing constants' ); my $str; undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('2*2'); HERE $str = $tree->to_string(); $str =~ s/\(|\)|\s+//g; ok( ( !$@ and $str eq '2*2' ), 'Parsing multiplication' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('(2+2)*2'); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq '(2+2)*2' ), 'Parsing parens and addition, precedence' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('2-2+2-2'); HERE # as of version 0.160, this is no longer true. # The parser doesn't reorder the same way it used to. # It was a bad test anyway. #$str = $tree->to_string(); #$str =~ s/\s+//g; #ok( # ( !$@ and $str eq '((2+2)-2)-2' ), # 'Parsing difference, chaining, reordering' #); ok( !$@, 'no fatal error.'); is($tree->value(), 2+2-2-2, 'Parsing difference, chaining.' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('-2'); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq '-2' ), 'Parsing unary' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('5^log(2,4)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'exponentiate(5,log(2,4))' ), 'Parsing exp and log' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('1+2*(-5)^log(2,4)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'add(1,multiply(2,exponentiate(-5,log(2,4))))' or $str eq 'add(1,multiply(2,exponentiate(negate(5),log(2,4))))' ), 'Parsing complicated term' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('cos(sin(1+2*-5^log(2,4)))'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'cos(sin(add(1,multiply(2,exponentiate(-5,log(2,4))))))' or $str eq 'cos(sin(add(1,multiply(2,exponentiate(negate(5),log(2,4))))))' ), 'Parsing complicated term involving sine and cosine' ); my $res; eval { $res = Math::Symbolic->parse_from_string('blah[blubb'); }; ok((not defined($res)), 'Parse fails on invalid string.'); eval { $res = Math::Symbolic->parse_from_string('exp(a*b)'); }; ok( !$@, 'parsing exp() does not throw an error'); isa_ok($res, 'Math::Symbolic::Operator', 'parsing exp() returns an operator'); my $string = $res->to_string('prefix'); ok( ($string =~ /^exponentiate\(2\.7\d*,\s*multiply\(a,\s*b\)\)$/), 'Parse of exp() turns it into e^()' ); eval { $res = Math::Symbolic->parse_from_string('sqrt(a*b)'); }; ok( !$@, 'parsing sqrt() does not throw an error'); isa_ok($res, 'Math::Symbolic::Operator', 'parsing sqrt() returns an operator'); $string = $res->to_string('prefix'); ok( ($string =~ /^exponentiate\(multiply\(a,\s*b\), 0.5\)$/), 'Parse of sqrt() turns it into ()^0.5' ); # test the ' notation sub test_parse { my ($str, $type, $cmpregex) = @_; my $res; eval <parse_from_string(q{$str}); HERE ok( !$@, "parsing '$str' does not throw an error"); warn "Error was: $@" if $@; isa_ok($res, "Math::Symbolic::$type", "parsing '$str' returns an operator"); my $string = $res->to_string('prefix'); ok( ($string =~ $cmpregex), "Parse of '$str' turns it into $cmpregex" ); } my @testsets = ( [ "f'(x)", "Operator", qr/^partial_derivative\(f,\s*x\)$/, ], [ "f'", "Operator", qr/^partial_derivative\(f,\s*x\)$/, ], [ "f'(a)", "Operator", qr/^partial_derivative\(f,\s*a\)$/, ], [ "f'(a, x)", "Operator", qr/^partial_derivative\(f,\s*a\)$/, ], [ "f''(x)", "Operator", qr/^partial_derivative\(partial_derivative\(f,\s*x\),\s*x\)$/, ], [ "f''", "Operator", qr/^partial_derivative\(partial_derivative\(f,\s*x\),\s*x\)$/, ], [ "f''(a)", "Operator", qr/^partial_derivative\(partial_derivative\(f,\s*a\),\s*a\)$/, ], [ "f''(a, x)", "Operator", qr/^partial_derivative\(partial_derivative\(f,\s*a\),\s*a\)$/, ], ); foreach my $testset (@testsets) { test_parse(@$testset); } # test failure of parse_from_string eval { $res = Math::Symbolic::parse_from_string(); }; ok ($@, 'parse_from_string complains about being called without args'); eval { $res = Math::Symbolic->parse_from_string(); }; ok ($@, 'parse_from_string complains about being called as method without args'); $Math::Symbolic::Parser = undef; eval { $res = Math::Symbolic::parse_from_string('2'); }; ok(!$@ && ref($res) =~ /^Math::Symbolic/, 'parse_from_string creates a new parser if necessary'); my $yapp = Math::Symbolic::Parser->new(implementation => 'Yapp'); isa_ok($yapp, 'Math::Symbolic::Parser::Yapp'); my $rd = Math::Symbolic::Parser->new(implementation => 'RecDescent', recompile => 1); ok(defined($rd) && $rd->isa('Parse::RecDescent')||$rd->isa('Math::Symbolic::Parser::Precompiled'), 'chose implementation RecDescent'); eval {$rd = Math::Symbolic::Parser->new(implementation=>'foo');}; ok ($@, 'Cannot create parser of unknown implementation'); Math-Symbolic-0.612/t/20miscalgebra.t000444001750001750 324212157534055 16465 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 13; BEGIN { use_ok('Math::Symbolic'); use_ok('Math::Symbolic::MiscCalculus'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic qw/:all/; use Math::Symbolic::ExportConstants qw/:all/; use Math::Symbolic::MiscAlgebra qw/:all/; # Test det internals my @mat = ( [1, 2, 3, 4, 5], [2, 3, 4, 5, 6], [3, 4, 5, 6, 7], ); my $mslice = Math::Symbolic::MiscAlgebra::_matrix_slice(\@mat, 1, 1); my $resmat = [ [1, 3, 4, 5], [3, 5, 6, 7], ]; is_deeply($mslice, $resmat, "matrix_slice(..., 1, 1)"); $mslice = Math::Symbolic::MiscAlgebra::_matrix_slice(\@mat, 0, 0); $resmat = [ [3,4,5,6], [4,5,6,7], ]; is_deeply($mslice, $resmat, "matrix_slice(..., 0, 0)"); $mslice = Math::Symbolic::MiscAlgebra::_matrix_slice(\@mat, 2, 1); $resmat = [ [1,3,4,5], [2,4,5,6], ]; is_deeply($mslice, $resmat, "matrix_slice(..., 2, 1)"); @mat = ( [3, -2, 1, 5], [6, 1, 3, 0], [2, -5, 1, 7], [1, 2, 3, 5], ); my $d = det @mat; ok(abs($d->value() - 256)<1e-20, 'det(4x4)'); my @matrix = ( [ 'x', 'y' ], [ 'z', 'a' ], ); ok( det(@matrix)->is_identical('(x * a) - (z * y)'), '2x2 det' ); my $m = [ [qw/2 4 6/], [qw/1 3 7/], [qw/3 3 -2/], ]; my $v = [qw/12 16 -9/]; my $vec = linear_solve( $m, $v ); my $solution = [ 1, -2, 3 ]; foreach (@$vec) { ok( $_->value() == shift @$solution, 'linear_solve component' ); } ok( bell_polynomial(0)->is_identical('1'), 'bell_polynomial(0)' ); ok( bell_polynomial(1)->is_identical('x'), 'bell_polynomial(1)' ); ok( bell_polynomial(2)->is_identical('x^2 + x'), 'bell_polynomial(2)' ); Math-Symbolic-0.612/t/14compile.t000444001750001750 520712157534055 15652 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 21; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $x = $var->new( 'x' => 10 ); my $y = $var->new( 'y' => 5 ); my $z = $var->new( 'z' => 1 ); my ( $sub, $code, $trees ); my $func = $z + $x * 2 + $y; eval <<'HERE'; ($sub, $trees) = Math::Symbolic::Compiler->compile_to_sub($func); HERE ok( !$@, 'compile_to_sub(), one argument.' ); is_deeply( $trees, [], '- checking results.' ); ok( $sub->( 11, 2, 100 ) == 124, '- checking results.' ); ( $sub, $trees ) = ( undef, undef ); eval <<'HERE'; ($sub, $trees) = Math::Symbolic::Compiler->compile_to_sub( $func, [qw/y/] ); HERE ok( !$@, 'compile_to_sub(), two arguments.' ); is_deeply( $trees, [], '- checking results.' ); ok( $sub->( 11, 2, 100 ) == ( 11 + 2 * 2 + 100 ), '- checking results.' ); ( $sub, $trees ) = ( undef, undef ); eval <<'HERE'; ($sub, $trees) = Math::Symbolic::Compiler->compile_to_sub( $func, [qw/z y x/] ); HERE ok( !$@, 'compile_to_sub(), two arguments.' ); is_deeply( $trees, [], '- checking results.' ); ok( $sub->( 11, 2, 100 ) == ( 11 + 2 + 2 * 100 ), '- checking results.' ); ( $sub, $trees ) = ( undef, undef ); eval <<'HERE'; ($code, $trees) = Math::Symbolic::Compiler->compile_to_code($func); HERE ok( !$@, 'compile_to_code() - one argument.' ); is_deeply( $trees, [], '- checking results.' ); { local @_ = ( 2, 100, 3 ); my $res = eval $code; ok( $res == ( 3 + 100 + 2 * 2 ), '- checking results.' ); } ( $code, $trees ) = ( undef, undef ); eval <<'HERE'; ($code, $trees) = Math::Symbolic::Compiler->compile_to_code( $func, [qw/z y x/] ); HERE ok( !$@, 'compile_to_code() - two arguments.' ); is_deeply( $trees, [], '- checking results.' ); { local @_ = ( 2, 100, 3 ); my $res = eval $code; ok( $res == ( 2 * 3 + 100 + 2 ), '- checking results.' ); } ( $code, $trees ) = ( undef, undef ); eval <<'HERE'; ($code, $trees) = Math::Symbolic::Compiler->compile_to_code( $func, [qw/y/] ); HERE ok( !$@, 'compile_to_code() - two arguments.' ); is_deeply( $trees, [], '- checking results.' ); { local @_ = ( 2, 100, 3 ); my $res = eval $code; ok( $res == ( 3 + 2 * 100 + 2 ), '- checking results.' ); } ( $code, $trees ) = ( undef, undef ); $@ = undef; eval <<'HERE'; ($sub, $code, $trees) = Math::Symbolic::Compiler->compile($func, [qw/x/]); HERE ok( !$@, 'compile()' ); my $no = $sub->( 1, 2, 3 ); ok( $no == ( 2 + 2 + 3 ), 'Correct result of sub', ); Math-Symbolic-0.612/t/04deep_derivatives.t000444001750001750 275612157534055 17551 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 4; #use lib 'lib'; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); my $c = Math::Symbolic::Constant->zero(); my $e = $c->euler(); my $two = $c->new(2); print "Vars: a=" . $a->value() . " (Values are optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $two, $a ); my $exp1 = $op->new( '^', $e, $mul1 ); print "prefix notation and evaluation:\n"; print $exp1->to_string('prefix') . " = " . $exp1->value() . "\n\n"; print "Now, we derive this partially to 'a' (10 times): (infix)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $exp1, $a ], } ); foreach ( 1 .. 10 ) { print "$_\n"; $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $n_tree, $a ], } ); $n_tree = $n_tree->apply_derivatives(); $n_tree = $n_tree->simplify(); } print $n_tree->to_string('infix') . " = " . $n_tree->value() . "\n\n"; ok( abs($n_tree->op1()->value()-2048)<1e-10 , 'Large coefficient and op1() method' ); ok( $n_tree->op2()->op2()->op1()->value() == 2, 'op2() method' ); ok( $n_tree->op2()->op1()->{special} eq 'euler', 'op2() method, special euler trait' ); Math-Symbolic-0.612/t/21more_derivatives.t000444001750001750 403112157534055 17561 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Carp qw/croak/; use Test::More tests => 12; BEGIN { use_ok('Math::Symbolic'); } use Math::Symbolic qw/:all/; use Math::Symbolic::Derivative qw/partial_derivative/; if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } my @f = ( [ q{-a+b*x}, q{b} ], [ q{a+b*x+c*x^2}, q{b+2*c*x} ], [ q{a+x+}.join('+', map {"x^$_"} 2..10), '1+'.join('+', map {"$_*x^".($_-1)} 2..10) ], [ q{sin(2*x)*cos(3*x)}, q{2*cos(2*x)*cos(3*x)-3*sin(3*x)*sin(2*x)}, ], [ q{log(a, 2*x)}, q{2/(log(2.71828182845905, a)*2*x)}, { x => sub {$_[0] > 0}, a => sub {$_[0] > 0}, } ], [ q{x/x^2}, q{-1/x^2}, { x => sub {$_[0] > 0} }, ], [ q{2/x}, q{-2/x^2}, { x => sub {$_[0] > 0} }, ], [ q{c/x}, q{-c/x^2}, { x => sub {$_[0] > 0} }, ], ); foreach my $ref (@f) { my ($f, $deriv) = map { parse_from_string($_) } @{$ref}[0,1]; my $limits = $ref->[2]; die "parse of '$ref->[0]' failed" if not defined $f; die "parse of '$ref->[1]' failed" if not defined $deriv; my $d = partial_derivative($f, 'x'); ok($d->test_num_equiv($deriv, limits => $limits), "$d == $deriv"); } # Test for regression RT #43783 { my $formula1 = parse_from_string('K-C*exp(-L*x)'); my $formula2 = parse_from_string('K+-C*exp(-L*x)'); my %parameters = ( C => 0.8, K => 1., L => 1. ); my $deriv1 = partial_derivative($formula1, 'C')->apply_derivatives()->simplify(); my $deriv2 = partial_derivative($formula2, 'C')->apply_derivatives()->simplify(); foreach (1, 2, 3) { ok( float_eq( $deriv1->value(%parameters, x => $_), $deriv2->value(%parameters, x => $_) ), "Derivatives of semantically equivalent formulas equivalent at x=$_" ); } } sub float_eq { $_[0] + 1.e-6 > $_[1] and $_[0] - 1.e-6 < $_[1] } Math-Symbolic-0.612/t/10hyperbolic.t000444001750001750 465512157534055 16364 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 7; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); my $c = Math::Symbolic::Constant->zero(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin; undef $@; eval <<'HERE'; $sin = $op->new('cosh', $op->new('*', $two, $a)); HERE ok( !$@, 'hyperbolic cosine creation' ); my $asin; undef $@; eval <<'HERE'; $asin = $op->new('acosh', $op->new('*', $two, $a)); HERE ok( !$@, 'area hyperbolic cosine creation' ); print "Expression: cosh(2*x) and acosh(2*x)\n\n"; print "prefix notation and evaluation:\n"; undef $@; eval <<'HERE'; print $sin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'h. cosine to_string' ); undef $@; eval <<'HERE'; print $asin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'area h. cosine to_string' ); print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $sin, $a ], } ); my $n_tree2 = $op->new( { type => U_P_DERIVATIVE, operands => [ $asin, $a ], } ); print $n_tree->to_string('prefix') . "\n\n"; print $n_tree2->to_string('prefix') . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived; undef $@; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'h. cosine derivative' ); my $derived2; undef $@; eval <<'HERE'; $derived2 = $n_tree2->apply_derivatives(); HERE ok( !$@, 'area h. cosine derivative' ); print "$derived\n\n"; print "$derived2\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); $derived2 = $derived2->simplify(); print "$derived\n\n"; print "$derived2\n\n"; print "Now, we do this two more times:\n"; for ( 1 .. 2 ) { $derived = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived, $a ], } )->apply_derivatives()->simplify(); $derived2 = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived2, $a ], } )->apply_derivatives()->simplify(); } print "$derived\n\n"; print "$derived2\n\n"; Math-Symbolic-0.612/t/08parse_hyperbolic.t000444001750001750 176012157534055 17557 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 4; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $tree; my $str; undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('sinh(2)'); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'sinh(2)' ), "Parsing hyperbolic sine" ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('cosh(2)'); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'cosh(2)' ), 'Parsing hyperbolic cosine' ); undef $@; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string( 'tan(log(cosh(2),sin(2*1*3+1*3)*sinh(0)))' ); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'tan(log(cosh(2),(sin(((2*1)*3)+(1*3)))*(sinh(0))))' ), 'Parsing more complicated string involving sinh/cosh/tan.' ); Math-Symbolic-0.612/t/01basic.t000444001750001750 730412157534055 15277 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 32; BEGIN { use_ok('Math::Symbolic'); use_ok('Math::Symbolic::VectorCalculus'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); ok( ref($var) eq 'Math::Symbolic::Variable', 'Variable prototype' ); my $a = $var->new( 'a' => 2 ); ok( ref($a) eq 'Math::Symbolic::Variable' && $a->value() == 2 && $a->name() eq 'a', 'Variable creation, value(), and name()' ); my $b = $var->new( 'b' => 3 ); my $c = $var->new( 'c' => 4 ); print "Vars: a=" . $a->value() . " b=" . $b->value() . " c=" . $c->value() . " (Values are optional)\n\n"; my $op = Math::Symbolic::Operator->new(); ok( ref($op) eq 'Math::Symbolic::Operator', 'Operator prototype' ); my $add1 = $op->new( '+', $a, $c ); ok( ref($add1) eq 'Math::Symbolic::Operator' && $add1->type() == B_SUM, 'Operator creation, type()' ); my $mult1 = $op->new( '*', $a, $b ); my $div1 = $op->new( '/', $add1, $mult1 ); print "Expression: (a+c)/(a*b)\n\n"; print "prefix notation and evaluation:\n"; eval <<'HERE'; print $div1->to_string('prefix') . " = " . $div1->value() . "\n\n"; HERE ok( !$@, 'to_string("prefix") did not complain' ); print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree; eval <<'HERE'; $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [$div1, $a], } ); HERE ok( !$@, 'long-form partial derivative did not complain' ); ok( ref($n_tree) eq 'Math::Symbolic::Operator' && $n_tree->type() == U_P_DERIVATIVE, , 'long-form partial derivative returned derivative' ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; $@ = undef; my $derived; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'apply_derivatives() did not complain' ); print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $@ = undef; my $simplified; eval <<'HERE'; $simplified = $derived->simplify(); HERE ok( !$@&&defined($simplified), 'simplify() did not complain' ); print "$simplified = " . $derived->value() . "\n\n"; ok( Math::Symbolic::AuxFunctions::binomial_coeff( 0, 0 ) == 1, 'binomial_coeff(0, 0)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 1, 1 ) == 1, 'binomial_coeff(1, 1)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 4, 2 ) == 6, 'binomial_coeff(4, 2)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 5, 2 ) == 10, 'binomial_coeff(5, 2)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 5, 4 ) == 5, 'binomial_coeff(5, 4)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 2, 4 ) == 0, 'binomial_coeff(2, 4)' ); ok( Math::Symbolic::AuxFunctions::binomial_coeff( 2, -1 ) == 0, 'binomial_coeff(2, -1)' ); ok( !defined( Math::Symbolic::AuxFunctions::bell_number(-1) ), 'bell_number(-1)' ); my @bell_numbers = ( 1, 1, 2, 5, 15, 52, 203, 877, 4140, 21147, 115975 ); ok( Math::Symbolic::AuxFunctions::bell_number($_) == $bell_numbers[$_], "bell_number($_)" ) for 0 .. $#bell_numbers; my $special_constant = Math::Symbolic::Constant->zero(); ok( ( ref $special_constant eq 'Math::Symbolic::Constant' and $special_constant->{special} eq 'zero' ), "Special attribute on constants set correctly." ); $special_constant->value(1); ok( ( not defined $special_constant->{special} or $special_constant->{special} ne 'zero' ), "Special attribute on constans unset correctly on change of value." ); Math-Symbolic-0.612/t/05unary_minus.t000444001750001750 330412157534055 16567 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 6; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); print "Vars: a=" . $a->value() . " (Values are optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $umi; undef $@; eval <<'HERE'; $umi = $op->new({type=>U_MINUS, operands=>[ $a ]}); HERE ok( !$@, 'Unary minus creation' ); print "prefix notation and evaluation:\n"; undef $@; eval <<'HERE'; print $umi->to_string('prefix') . " = " . $umi->value() . "\n\n"; HERE ok( !$@, 'Unary minus to prefix' ); undef $@; eval <<'HERE'; print $umi->to_string('infix') . " = " . $umi->value() . "\n\n"; HERE ok( !$@, 'Unary minus to infix' ); undef $@; eval <<'HERE'; $umi = Math::Symbolic::Operator->new('neg', Math::Symbolic::Operator->new('-', Math::Symbolic::Variable->new('a'), Math::Symbolic::Variable->new('b'))); $umi = $umi->new('neg', $umi); HERE $umi = $umi->simplify(); my $str = $umi->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'subtract(a,b)' ), 'Unary minus simplification' ); undef $@; eval <<'HERE'; $umi = Math::Symbolic::Operator->new('neg', Math::Symbolic::Operator->new('-', Math::Symbolic::Variable->new('a'), Math::Symbolic::Variable->new('b'))); $umi = $umi->new('neg', $umi); $umi = $umi->new('neg', $umi); $umi = $umi->new('neg', $umi); $umi = $umi->new('neg', $umi); HERE $umi = $umi->simplify(); $str = $umi->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'subtract(b,a)' ), 'More unary minus simplification' ); Math-Symbolic-0.612/t/18vectorcalc.t000444001750001750 2372212157534055 16375 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 19; BEGIN { use_ok('Math::Symbolic'); use_ok('Math::Symbolic::VectorCalculus'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic qw/:all/; use Math::Symbolic::ExportConstants qw/:all/; use Math::Symbolic::VectorCalculus qw/:all/; my $func = 'x+y'; my @grad = grad 'x+y'; ok( ( @grad == 2 and $grad[0]->is_identical('partial_derivative(x + y, x)') and $grad[1]->is_identical('partial_derivative(x + y, y)') ), 'simple grad usage' ); $func = parse_from_string('2*x+y+3*z'); @grad = grad $func; ok( ( @grad == 3 and $grad[0]->is_identical('partial_derivative(((2*x)+y)+(3*z),x)') and $grad[1]->is_identical('partial_derivative(((2*x)+y)+(3*z),y)') and $grad[2]->is_identical('partial_derivative(((2*x)+y)+(3*z),z)') ), 'more simple grad usage' ); @grad = grad $func, @{ [qw/y x/] }; ok( ( @grad == 2 and $grad[0]->is_identical('partial_derivative(((2*x)+y)+(3*z),y)') and $grad[1]->is_identical('partial_derivative(((2*x)+y)+(3*z),x)') ), 'more grad usage with custom signature' ); my @func1 = ( 'x+y', 'x+z', 'z*y' ); my @func2 = map { parse_from_string($_) } @func1; my $div = div @func1; ok( $div->is_identical(<<'HERE'), 'simple divergence usage' ); ((partial_derivative(x + y, x)) + (partial_derivative(x + z, y))) + (partial_derivative(z * y, z)) HERE $div = div @func2; ok( $div->is_identical(<<'HERE'), 'more simple divergence usage' ); ((partial_derivative(x + y, x)) + (partial_derivative(x + z, y))) + (partial_derivative(z * y, z)) HERE $div = div @func2, @{ [ 'x', 'z', 'y' ] }; ok( $div->is_identical(<<'HERE'), 'divergence usage with custom signature' ); ((partial_derivative(x + y, x)) + (partial_derivative(x + z, z)) ) + (partial_derivative(z * y, y)) HERE my @rot = rot @func1; ok( ( @rot == 3 and $rot[0]->is_identical(<<'ROT0') (partial_derivative(z * y, y)) - (partial_derivative(x + z, z)) ROT0 and $rot[1]->is_identical(<<'ROT1'), (partial_derivative(x + y, z)) - (partial_derivative(z * y, x)) ROT1 and $rot[2]->is_identical(<<'ROT2'), (partial_derivative(x + z, x)) - (partial_derivative(x + y, y)) ROT2 ), 'basic rot usage' ); my @expected = ( 'partial_derivative(x + y, x)', 'partial_derivative(x + y, y)', 'partial_derivative(x + y, z)', 'partial_derivative(x + z, x)', 'partial_derivative(x + z, y)', 'partial_derivative(x + z, z)', 'partial_derivative(z * y, x)', 'partial_derivative(z * y, y)', 'partial_derivative(z * y, z)', ); my @matrix = Jacobi @func1; ok( ( @matrix == 3 and ( grep { $_->is_identical( shift @expected ) } map { (@$_) } @matrix ) == 9 ), 'basic Jacobi usage' ); @expected = ( 'partial_derivative(partial_derivative(x * y, x), x)', 'partial_derivative(partial_derivative(x * y, x), y)', 'partial_derivative(partial_derivative(x * y, y), x)', 'partial_derivative(partial_derivative(x * y, y), y)', ); @matrix = Hesse 'x*y'; ok( ( @matrix == 2 and not( grep { not $_->is_identical( shift @expected ) } map { (@$_) } @matrix ) ), 'basic Hesse usage' ); my $differential = TotalDifferential 'x*y'; ok( $differential->is_identical(<<'HERE'), 'basic TotalDifferential usage' ); partial_derivative(x_0*y_0,x_0)*(x-x_0) + partial_derivative(x_0*y_0,y_0)*(y-y_0) HERE $differential = TotalDifferential 'x*y+z', @{ [qw/z x/] }; ok( $differential->is_identical( <<'HERE'), 'more basic TotalDifferential usage' ); partial_derivative(x_0*y+z_0,z_0)*(z-z_0) + partial_derivative(x_0*y+z_0,x_0)*(x-x_0) HERE $differential = TotalDifferential 'x*y+z', @{ [qw/z x/] }, @{ [qw/z0 x0/] }; ok( $differential->is_identical( <<'HERE'), 'yet more basic TotalDifferential usage' ); partial_derivative(x0*y+z0,z0)*(z-z0) + partial_derivative(x0*y+z0,x0)*(x-x0) HERE my $foo; my $line = ; eval $line; die $@ if $@; my $dderiv = DirectionalDerivative 'x*y+z', @{ [ 'a', Math::Symbolic::Variable->new('b'), 'c' ] }; ok( $dderiv->is_identical($foo), 'basic DirectionalDerivative usage' ); $dderiv = DirectionalDerivative 'x*y+z', @{ [ 'b', Math::Symbolic::Variable->new('a') ] }, @{ [ 'z', 'x' ] }; ok( $dderiv->is_identical(<<'HERE'), 'basic DirectionalDerivative usage' ); ((partial_derivative((x * y) + z, z)) * (b / (((b ^ 2) + (a ^ 2)) ^ 0.5))) + ((partial_derivative((x * y) + z, x) ) * (a / (((b^ 2) + (a ^ 2)) ^ 0.5))) HERE my $taylor = TaylorPolyTwoDim 'x*y', 'x', 'y', 0; ok( $taylor->is_identical( <<'HERE'), 'basic TaylorPolyTwoDim usage (degree 0)' ); x_0 * y_0 HERE $taylor = TaylorPolyTwoDim 'x*y', 'x', 'y', 1; ok( $taylor->is_identical( <<'HERE'), 'basic TaylorPolyTwoDim usage (degree 1)' ); (x_0 * y_0) + ((((x - x_0) * (partial_derivative(x_0 * y_0, x_0))) + ((y - y_0) * (partial_derivative(x_0 * y_0, y_0)))) / 1) HERE my @functions = ( 'x*y', 'z' ); my @vars = ( 'x', 'z' ); my $wronsky = WronskyDet @functions, @vars; ok( $wronsky->is_identical(<<'HERE'), 'simple Wronsky Determinant' ); (x*y)*partial_derivative(z, z) - partial_derivative(x*y, x) * z HERE __DATA__ $foo=bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'x'},'Math::Symbolic::Variable'),bless({'signature'=>[],'value'=>undef,'name'=>'y'},'Math::Symbolic::Variable')],'type'=>2},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'z'},'Math::Symbolic::Variable')],'type'=>0},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'x'},'Math::Symbolic::Variable')],'type'=>5},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'a'},'Math::Symbolic::Variable'),bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'a'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'b'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'c'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'special'=>'','value'=>'0.5'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>3},'Math::Symbolic::Operator')],'type'=>2},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'x'},'Math::Symbolic::Variable'),bless({'signature'=>[],'value'=>undef,'name'=>'y'},'Math::Symbolic::Variable')],'type'=>2},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'z'},'Math::Symbolic::Variable')],'type'=>0},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'y'},'Math::Symbolic::Variable')],'type'=>5},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'b'},'Math::Symbolic::Variable'),bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'a'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'b'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'c'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'special'=>'','value'=>'0.5'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>3},'Math::Symbolic::Operator')],'type'=>2},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'x'},'Math::Symbolic::Variable'),bless({'signature'=>[],'value'=>undef,'name'=>'y'},'Math::Symbolic::Variable')],'type'=>2},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'z'},'Math::Symbolic::Variable')],'type'=>0},'Math::Symbolic::Operator'),bless({'signature'=>[],'value'=>undef,'name'=>'z'},'Math::Symbolic::Variable')],'type'=>5},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'c'},'Math::Symbolic::Variable'),bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'a'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'b'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'operands'=>[bless({'signature'=>[],'value'=>undef,'name'=>'c'},'Math::Symbolic::Variable'),bless({'special'=>'','value'=>'2'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'),bless({'special'=>'','value'=>'0.5'},'Math::Symbolic::Constant')],'type'=>7},'Math::Symbolic::Operator')],'type'=>3},'Math::Symbolic::Operator')],'type'=>2},'Math::Symbolic::Operator')],'type'=>0},'Math::Symbolic::Operator'); Math-Symbolic-0.612/t/22dumpers.t000444001750001750 151412157534055 15675 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Carp qw/croak/; use Test::More tests => 1+4*7; BEGIN { use_ok('Math::Symbolic'); } use Math::Symbolic qw/:all/; use Math::Symbolic::Derivative qw/partial_derivative/; if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } my @f = ( q{-a+b*x}, q{a+b*x+c*x^2}, q{b+2*c*x}, q{a+x+}.join('+', map {"x^$_"} 2..10), '1+'.join('+', map {"$_*x^".($_-1)} 2..10), q{sin(2*x)*cos(3*x)}, q{2*cos(2*x)*cos(3*x)-3*sin(3*x)*sin(2*x)}, ); foreach (@f) { my $f = parse_from_string($_); my ($code) = $f->to_code(); ok(defined $code); my ($sub) = $f->to_sub(); ok(defined $sub); ok(ref($sub) eq 'CODE'); ok($f->test_num_equiv($sub), "to_sub works"); } Math-Symbolic-0.612/t/12overload.t000444001750001750 1112112157534055 16043 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 34; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 10 ); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; print "Expression: x * 2 + 1, x / 2 - 1, x * (2+1)\n\n"; my ( $first, $second, $third ); $@ = undef; eval <<'HERE'; $first = $a * 2 + 1; # x*2 + 1 HERE ok( !$@, 'overloaded multiplication and addition' ); my $str = $first->to_string(); $str =~ s/\s+//g; ok( $str eq '(x*2)+1' || $str eq '1+(2*x)', 'Correct result of overloaded *,+', ); ok( $first->value() == 21, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $second = $a / 2 - 1; # x*2 + 1 HERE ok( !$@, 'overloaded division and subtraction' ); $str = $second->to_string(); $str =~ s/\s+//g; ok( $str eq '(x/2)-1', 'Correct result of overloaded /,-', ); ok( $second->value() == 4, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $third = $a * "2 + 1"; # x*3 HERE ok( !$@, 'overloaded multiplication involving auto-parsing' ); $str = $third->to_string(); $str =~ s/\s+//g; ok( $str eq 'x*(1+2)' || $str eq 'x*(2+1)' || $str eq '(2+1)*x' || $str eq '(1+2)*x', 'Correct result of overloaded * involving auto-parsing', ); ok( $third->value() == 30, 'Result evaluates to the correct number' ); my $fourth; $@ = undef; eval <<'HERE'; $fourth = 2 ** ($third/$a); HERE ok( !$@, 'overloaded ** w/ constant recognition and M::S::Operators' ); ok( $fourth->value() == 2**3, 'Result evaluates to the correct number' ); my $fifth; $@ = undef; eval <<'HERE'; $fifth = $fourth ** $fourth; HERE ok( !$@, 'overloaded ** w/ two M::S::Operators' ); ok( $fifth->value() == 8**8, 'Result evaluates to the correct number' ); my $sixth; $@ = undef; eval <<'HERE'; $sixth = sqrt($third*$third); HERE ok( !$@, 'overloaded sqrt, * w/ M::S::Operators' ); ok( $sixth->value() == 30, 'Result evaluates to the correct number' ); my $seventh; $@ = undef; eval <<'HERE'; $seventh = -exp(Math::Symbolic::Constant->zero()); HERE ok( !$@, 'overloaded unary minus, exp w/ M::S::Constant' ); ok( $seventh->value() == -1, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh = log(Math::Symbolic::Constant->one()); HERE ok( !$@, 'overloaded log w/ M::S::Constant' ); ok( $seventh->value() == 0, 'Result evaluates to the correct number' ); ok( ( $seventh ? 0 : 1 ), 'automatic boolean conversion (Test1)' ); ok( ( $second ? 1 : 0 ), 'automatic boolean conversion (Test2)' ); $@ = undef; eval <<'HERE'; $seventh = cos(sin(Math::Symbolic::Constant->zero())); HERE ok( !$@, 'overloaded sin, cos w/ M::S::Constant' ); ok( $seventh->value() == 1, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh += 2; HERE ok( !$@, 'overloaded += w/ M::S::Constant' ); ok( $seventh->value() == 3, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh -= 2; HERE ok( !$@, 'overloaded -= w/ M::S::Constant' ); ok( $seventh->value() == 1, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh *= 2; HERE ok( !$@, 'overloaded *= w/ M::S::Constant' ); ok( $seventh->value() == 2, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh /= 2; HERE ok( !$@, 'overloaded /= w/ M::S::Constant' ); ok( $seventh->value() == 1, 'Result evaluates to the correct number' ); $@ = undef; eval <<'HERE'; $seventh += 2; $seventh **= 2; HERE ok( !$@, 'overloaded **= w/ M::S::Constant' ); ok( $seventh->value() == 9, 'Result evaluates to the correct number' ); print "prefix notation and evaluation:\n"; print $first->to_string('prefix') . " = " . $first->value() . "\n\n"; print $second->to_string('prefix') . " = " . $second->value() . "\n\n"; print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $first, $a ], } ); my $n_tree2 = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $second, $a ], } ); my $n_tree3 = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $third, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print $n_tree2->to_string('prefix') . " = " . $n_tree2->value() . "\n\n"; print $n_tree3->to_string('prefix') . " = " . $n_tree3->value() . "\n\n"; Math-Symbolic-0.612/t/02basic.t000444001750001750 1032712157534055 15317 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 26; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); print "Vars: a=" . $a->value() . " (Value is optional)\n\n"; ok($a->value() == 2, 'value of a==2 is 2'); ok($a->value(3) == 3, 'value of a=3 is 3'); ok($a->value() == 3, 'value of a==3 is still 3'); ok($a->name('foo') eq 'foo', 'name=foo is foo'); ok($a->name() eq 'foo', 'name==foo is foo'); $a = $a->new('a', 2); my $const; local $@; eval {$const = Math::Symbolic::Constant->new();}; ok( defined($@) && $@ ne '', 'Constant with undefined value throws exception' ); $const = Math::Symbolic::Constant->new(2); ok( ref($const) eq 'Math::Symbolic::Constant', 'Constant prototype' ); my $ten = $const->new(10); ok( ref($ten) eq 'Math::Symbolic::Constant' && $ten->value() == 10 && $ten->special() eq '', 'constant creation, value(), and special()' ); my $euler = $const->euler(); ok( ref($euler) eq 'Math::Symbolic::Constant' && $euler->value() >= 2.7 && $euler->value() <= 2.8 && $euler->special() eq 'euler', 'euler constant creation, value(), and special()' ); my $pi = $const->pi(); ok( ref($pi) eq 'Math::Symbolic::Constant' && $pi->value() >= 3.1 && $pi->value() <= 3.2 && $pi->special() eq 'pi', 'pi constant creation, value(), and special()' ); my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $a, $a ); my $log1 = $op->new( 'log', $ten, $mul1 ); ok( ref($log1) eq 'Math::Symbolic::Operator' && $log1->type() == B_LOG, 'Creation of logarithm' ); print "Expression: log_10(a*a)\n\n"; print "prefix notation and evaluation:\n"; print $log1->to_string('prefix') . " = " . $log1->value() . "\n\n"; print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $log1, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; $@ = undef; my $derived; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'apply_derivatives() did not complain' ); print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $@ = undef; my $simplified; eval <<'HERE'; $simplified = $derived->simplify(); HERE ok( !$@, 'simplify() did not complain' ); print "$simplified = " . $derived->value() . "\n\n"; $@ = undef; eval <<'HERE'; $simplified->value(a=>2); HERE ok( !$@, 'value() with arguments did not complain' ); $@ = undef; eval <<'HERE'; $simplified->set_value(a=>3); HERE ok( !$@ && $a->value() == 2, 'set_value() with arguments did not complain' ); my $term = Math::Symbolic::Operator->new( '*', Math::Symbolic::Variable->new('a'), Math::Symbolic::Variable->new( 'b', 2 ) ); ok( !defined( $term->value() ), 'value() returns undef for undefined vars' ); ok( !defined( $term->apply() ), 'apply() returns undef for undefined vars' ); ok( defined( $term->value( a => 2 ) ), 'value() defined if vars defined' ); ok( $term->fill_in_vars()->is_identical('a*2') || $term->fill_in_vars()->is_identical('2*a'), 'fill_in_vars()' ); my $variable1 = Math::Symbolic::Variable->new( a => 5 ); $variable1->set_signature(qw/z y x/); my $term2 = $variable1 + Math::Symbolic::Variable->new( b => 6 ); is_deeply( [ $term2->signature() ], [qw/a b x y z/], 'signature' ); is_deeply( [ $term2->explicit_signature() ], [qw/a b/], 'explicit_signature' ); $variable1->set_value({a => 2}); ok( $variable1->value() == 2, 'new (as of 0.132) syntax for set_value()' ); ok( $variable1->value({ a => 3 }) == 3, 'new (as of 0.132) syntax for value()' ); # this shouldn't be before 06parser.t... my $result = Math::Symbolic->parse_from_string("x+x^2")->simplify(); ok( $result->is_identical("x+x^2"), "Simplification never adds a superfluous zero" ); # this shouldn't be before 17modifications.t... ok( Math::Symbolic->parse_from_string("((x+x^2)+3)-3") ->simplify()->is_identical("x+x^2"), "simplification: ((x+x^2)+3)-3 ==> x+x^2" ); Math-Symbolic-0.612/t/03exp.t000444001750001750 314712157534055 15015 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 4; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); print "Vars: a=" . $a->value() . " (Value is optional)\n\n"; my $const = Math::Symbolic::Constant->zero(); my $ten = $const->new(10); my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $a, $a ); my $exp = $op->new( '^', $ten, $mul1 ); ok( ref($exp) eq 'Math::Symbolic::Operator' && $exp->type() == B_EXP, 'Creation of exponentiation' ); print "Expression: 10^(a*a)\n\n"; print "prefix notation and evaluation:\n"; print $exp->to_string('prefix') . " = " . $exp->value() . "\n\n"; print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $exp, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; $@ = undef; my $derived; eval <<'HERE'; $derived = $n_tree->apply_derivatives(); HERE ok( !$@, 'apply_derivatives() did not complain' ); print "$derived\n"; print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $@ = undef; my $simplified; eval <<'HERE'; $simplified = $derived->simplify(); HERE ok( !$@, 'simplify() did not complain' ); print "$simplified = " . $derived->value() . "\n\n"; Math-Symbolic-0.612/t/11trigonometric.t000444001750001750 1153112157534055 17121 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 28; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); my $c = Math::Symbolic::Constant->zero(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin; undef $@; eval <<'HERE'; $sin = $op->new('sin', $op->new('*', $two, $a)); HERE ok( !$@, 'sine creation' ); my $cos; undef $@; eval <<'HERE'; $cos = $op->new('cos', $op->new('*', $two, $a)); HERE ok( !$@, 'cosine creation' ); my $tan; undef $@; eval <<'HERE'; $tan = $op->new('tan', $op->new('*', $two, $a)); HERE ok( !$@, 'tangent creation' ); my $cot; undef $@; eval <<'HERE'; $cot = $op->new('cot', $op->new('*', $two, $a)); HERE ok( !$@, 'cotangent creation' ); my $asin; undef $@; eval <<'HERE'; $asin = $op->new('asin', $op->new('*', $two, $a)); HERE ok( !$@, 'arc sine creation' ); my $acos; undef $@; eval <<'HERE'; $acos = $op->new('acos', $op->new('*', $two, $a)); HERE ok( !$@, 'arc cosine creation' ); my $atan; undef $@; eval <<'HERE'; $atan = $op->new('atan', $op->new('*', $two, $a)); HERE ok( !$@, 'arc tangent creation' ); my $atan2; undef $@; eval <<'HERE'; $atan2 = $op->new('atan2', $two, $a); HERE ok( !$@, 'atan2 creation' ); my $acot; undef $@; eval <<'HERE'; $acot = $op->new('acot', $op->new('*', $two, $a)); HERE ok( !$@, 'arc cotangent creation' ); print "prefix notation and evaluation:\n"; undef $@; eval <<'HERE'; print $sin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'sine to_string' ); undef $@; eval <<'HERE'; print $cos->to_string('prefix') . "\n\n"; HERE ok( !$@, 'cosine to_string' ); undef $@; eval <<'HERE'; print $tan->to_string('prefix') . "\n\n"; HERE ok( !$@, 'tangent to_string' ); undef $@; eval <<'HERE'; print $cot->to_string('prefix') . "\n\n"; HERE ok( !$@, 'cotangent to_string' ); undef $@; eval <<'HERE'; print $asin->to_string('prefix') . "\n\n"; HERE ok( !$@, 'arc sine to_string' ); undef $@; eval <<'HERE'; print $acos->to_string('prefix') . "\n\n"; HERE ok( !$@, 'arc cosine to_string' ); undef $@; eval <<'HERE'; print $atan->to_string('prefix') . "\n\n"; HERE ok( !$@, 'arc tangent to_string' ); undef $@; eval <<'HERE'; print $atan2->to_string('prefix') . "\n\n"; HERE ok( !$@, 'atan2 to_string' ); undef $@; eval <<'HERE'; print $acot->to_string('prefix') . "\n\n"; HERE ok( !$@, 'arc cotangent to_string' ); print "Now, we derive this partially to x: (prefix again)\n"; my ( $dsin, $dcos, $dtan, $dcot, $dasin, $dacos, $datan, $datan2, $dacot ); undef $@; eval <<'HERE'; $dsin = $op->new( 'partial_derivative', $sin, $a ); $dsin = $dsin->apply_derivatives(); $dsin = $dsin->simplify(); print $dsin->to_string('prefix'), "\n"; HERE ok( !$@, 'sine derivative, simplification' ); undef $@; eval <<'HERE'; $dcos = $op->new( 'partial_derivative', $cos, $a ); $dcos = $dcos->apply_derivatives(); $dcos = $dcos->simplify(); print $dcos->to_string('prefix'), "\n"; HERE ok( !$@, 'cosine derivative, simplification' ); undef $@; eval <<'HERE'; $dtan = $op->new( 'partial_derivative', $tan, $a ); $dtan = $dtan->apply_derivatives(); $dtan = $dtan->simplify(); print $dtan->to_string('prefix'), "\n"; HERE ok( !$@, 'tangent derivative, simplification' ); undef $@; eval <<'HERE'; $dcot = $op->new( 'partial_derivative', $cot, $a ); $dcot = $dcot->apply_derivatives(); $dcot = $dcot->simplify(); print $dcot->to_string('prefix'), "\n"; HERE ok( !$@, 'cotangent derivative, simplification' ); undef $@; eval <<'HERE'; $dasin = $op->new( 'partial_derivative', $asin, $a ); $dasin = $dasin->apply_derivatives(); $dasin = $dasin->simplify(); print $dasin->to_string('prefix'), "\n"; HERE ok( !$@, 'arc sine derivative, simplification' ); undef $@; eval <<'HERE'; $dacos = $op->new( 'partial_derivative', $acos, $a ); $dacos = $dacos->apply_derivatives(); $dacos = $dacos->simplify(); print $dacos->to_string('prefix'), "\n"; HERE ok( !$@, 'arc cosine derivative, simplification' ); undef $@; eval <<'HERE'; $datan = $op->new( 'partial_derivative', $atan, $a ); $datan = $datan->apply_derivatives(); $datan = $datan->simplify(); print $datan->to_string('prefix'), "\n"; HERE ok( !$@, 'arc tangent derivative, simplification' ); undef $@; eval <<'HERE'; $datan2 = $op->new( 'partial_derivative', $atan2, $a ); $datan2 = $datan2->apply_derivatives(); $datan2 = $datan2->simplify(); print $datan2->to_string('prefix'), "\n"; HERE ok( !$@, 'arc tangent derivative, simplification' ); undef $@; eval <<'HERE'; $dacot = $op->new( 'partial_derivative', $acot, $a ); $dacot = $dacot->apply_derivatives(); $dacot = $dacot->simplify(); print $dacot->to_string('prefix'), "\n"; HERE ok( !$@, 'arc tangent derivative, simplification' ); Math-Symbolic-0.612/t/13parse_more.t000444001750001750 744312157534055 16361 0ustar00tseetsee000000000000#!perl # BEGIN{$::RD_HINT = 1;} use strict; use warnings; use Test::More tests => 17; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $tree; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('a'); HERE ok( ( !$@ and ref($tree) eq 'Math::Symbolic::Variable' ), 'Parsing variables' ); my $str; eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('a*a'); HERE $str = $tree->to_string(); $str =~ s/\(|\)|\s+//g; ok( ( !$@ and $str eq 'a*a' ), 'Parsing multiplication of variables' ); eval <<'HERE'; $tree = $tree + '(b + a)'; HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq '(a*a)+(b+a)' ), 'Parsing parens and addition, precedence, overloaded ops' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('a-a+a-a-a'); HERE # As with the equivalent in 06parser.t which deals with constants, # you can't rely on the parser's reordering any more since version # 0.160. #$str = $tree->to_string(); #$str =~ s/\s+//g; #ok( # ( !$@ and $str eq '((a+a)-a)-a' ), # 'Parsing difference, chaining, reordering' #); ok( !$@, 'did not die' ); is($tree->value(a=>5), -5, 'Parsing difference, chaining'); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('-BLABLAIdent_1213_ad'); HERE $str = $tree->to_string(); $str =~ s/\s+//g; ok( ( !$@ and $str eq '-BLABLAIdent_1213_ad' ), 'Parsing unary minus and complex identifier' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('(1+t)^log(t*2,x^2)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'exponentiate(add(1,t),log(multiply(t,2),exponentiate(x,2)))' ), 'Parsing exp and log' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('a') * 3 + 'b' - ( Math::Symbolic->parse_from_string('2*c') ** sin(Math::Symbolic->parse_from_string('x'))); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'subtract(add(multiply(a,3),b),exponentiate(multiply(2,c),sin(x)))' ), 'Parsing complicated term' ); eval <<'HERE'; $tree = Math::Symbolic::Operator->new('*', 'a', 'b'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'multiply(a,b)' ), 'Autoparsing at operator creation' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('a(b, c, d)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'a' ), 'Parsing variable with signature' ); $str = join '|', $tree->signature(); ok( ( !$@ and $str eq 'a|b|c|d' ), 'Checking variable for correct signature' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('E_pot(r, t) + 1/2 * m(t) * v(t)^2'); HERE #$str = $tree->to_string('prefix'); #$str =~ s/\s+//g; #ok( # ( # !$@ # and $str eq # 'add(E_pot,divide(multiply(multiply(1,m),exponentiate(v,2)),2))' # ), # 'Parsing term involving variables with signatures' #); ok(!$@, 'did not die'); ok(abs($tree->value(E_pot => 5, m => 3, v => 7) - 78.5) < 1e-8, 'Parsing term involving variables with signatures.' ); $str = join '|', $tree->signature(); ok( ( !$@ and $str eq 'E_pot|m|r|t|v' ), 'Checking term for correct signature' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('--(a-b)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'negate(negate(subtract(a,b)))' ), 'Parsing term involving multiple unary minuses' ); eval <<'HERE'; $tree = Math::Symbolic->parse_from_string('---(a-b)'); HERE $str = $tree->to_string('prefix'); $str =~ s/\s+//g; ok( ( !$@ and $str eq 'negate(negate(negate(subtract(a,b))))' ), 'Parsing term involving multiple unary minuses' ); Math-Symbolic-0.612/t/15total_derivatives.t000444001750001750 333412157534055 17752 0ustar00tseetsee000000000000#!perl use Test::More tests => 8; use strict; use warnings; BEGIN { use_ok('Math::Symbolic'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic::ExportConstants qw/:all/; my $exp = Math::Symbolic->parse_from_string('10^(a(x)*a(x))'); ok( 1, 'Term creation from string did not complain.' ); print "Expression: 10^(a(x)*a(x))\n\n"; print "prefix notation and evaluation: (a=2)\n"; print $exp->to_string('prefix') . " = " . $exp->value( a => 2 ) . "\n\n"; print "Now, we derive this totally to a: (prefix again)\n"; my $n_tree = $exp->new( 'total_derivative', $exp, 'a' ); ok( 1, 'Total derivative did not complain.' ); print $n_tree->to_string('prefix') . " = " . $n_tree->value( a => 2 ) . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); ok( 1, 'Application of total derivative did not complain' ); print "$derived = " . $derived->value( a => 2 ) . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified = " . $derived->value( a => 2 ) . "\n\n"; ok( 1, 'Simplification of result did not complain' ); print "For a change, we derive the term to x.\n"; $n_tree = Math::Symbolic->parse_from_string('total_derivative(10^(a(x)*a(x)), x)'); ok( 1, 'Parsing total derivative (to sig var) from string did not complain' ); $derived = $n_tree->apply_derivatives(); ok( 1, 'Applying total derivative (to sig var) did not complain' ); print "The derived term becomes:\n"; print "$derived\n"; ok( 1, 'Printing result does not complain' ); print "Which simplifies as:\n"; print $derived->simplify(); Math-Symbolic-0.612/t/90regression.t000444001750001750 41212157534055 16357 0ustar00tseetsee000000000000use strict; use warnings; use Test::More tests => 1; use Math::Symbolic qw/parse_from_string/; my $f = parse_from_string('x + (-5)*y'); my $fs = $f->simplify; #diag("Before simplification: $f"); #diag("After simplification: $fs"); ok($f->test_num_equiv($fs)); Math-Symbolic-0.612/t/19misccalc.t000444001750001750 267412157534055 16012 0ustar00tseetsee000000000000#!perl use strict; use warnings; use Test::More tests => 11; BEGIN { use_ok('Math::Symbolic'); use_ok('Math::Symbolic::MiscCalculus'); } if ($ENV{TEST_YAPP_PARSER}) { require Math::Symbolic::Parser::Yapp; $Math::Symbolic::Parser = Math::Symbolic::Parser::Yapp->new(); } use Math::Symbolic qw/:all/; use Math::Symbolic::ExportConstants qw/:all/; use Math::Symbolic::MiscCalculus qw/:all/; my $func = 'sin(x)'; my $taylor = TaylorPolynomial $func, 0, 'x', 'x_0'; ok( $taylor->is_identical('sin(x_0)'), 'simple taylor poly of 0-th degree' ); $taylor = TaylorPolynomial $func, 1, 'x'; ok( $taylor->is_identical('(sin(x_0)) + (((cos(x_0)) / 1) * ((x - x_0) ^ 1))'), 'simple taylor poly of first degree' ); $taylor = TaylorPolynomial 'tan(a)', 3, 'a', 'b'; ok( defined $taylor, 'complex taylor poly of third degree' ); my $error = TaylorErrorLagrange 'sin(x)', 3, 'x'; ok( defined $error, 'simple lagrange error' ); $error = TaylorErrorLagrange 'tan(x)', 1, 'x', 'var'; ok( defined $error, 'more simple lagrange error' ); $error = TaylorErrorLagrange 'tan(x)', 0, 'x', 'var', 'that'; ok( defined $error, 'more simple lagrange error' ); $error = TaylorErrorCauchy 'cos(x)', 2, 'x'; ok( defined $error, 'simple cauchy error' ); $error = TaylorErrorCauchy 'sin(x)*cos(x)', 1, 'x', 'var'; ok( defined $error, 'more simple cauchy error' ); $error = TaylorErrorCauchy 'tan(x)*sin(x)', 1, 'x', 'var', 'that'; ok( defined $error, 'more simple cauchy error' ); Math-Symbolic-0.612/examples000755001750001750 012157534055 15102 5ustar00tseetsee000000000000Math-Symbolic-0.612/examples/run10.pl000555001750001750 376412157534055 16556 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 3.14159 ); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $first = $a * 2 + 1; # x*2 + 1 my $second = $a * "2 + 1"; # x*3 my $third = -$a; print "Expression: x * 2 + 1, x * (2+1), -x\n\n"; print "prefix notation and evaluation:\n"; print $first->to_string('prefix') . " = " . $first->value() . "\n\n"; print $second->to_string('prefix') . " = " . $second->value() . "\n\n"; print $third->to_string('prefix') . " = " . $third->value() . "\n\n"; print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $first, $a ], } ); my $n_tree2 = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $second, $a ], } ); my $n_tree3 = Math::Symbolic::Operator->new( { type => U_P_DERIVATIVE, operands => [ $third, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print $n_tree2->to_string('prefix') . " = " . $n_tree2->value() . "\n\n"; print $n_tree3->to_string('prefix') . " = " . $n_tree3->value() . "\n\n"; print "Now, we apply the derivative to the terms: (infix)\n"; my $derived = $n_tree->apply_derivatives(); my $derived2 = $n_tree2->apply_derivatives(); my $derived3 = $n_tree3->apply_derivatives(); print "$derived" . " = " . $derived->value() . "\n\n"; print "$derived2" . " = " . $derived2->value() . "\n\n"; print "$derived3" . " = " . $derived3->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); print "$derived = " . $derived->value() . "\n\n"; $derived2 = $derived2->simplify(); print "$derived2 = " . $derived2->value() . "\n\n"; $derived3 = $derived3->simplify(); print "$derived3 = " . $derived3->value() . "\n\n"; Math-Symbolic-0.612/examples/run13.pl000555001750001750 57412157534055 16535 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Data::Dumper; use Math::Symbolic qw/:all/; my $exp = Math::Symbolic->parse_from_string('partial_derivative(1+2+3+4+a,a)'); print $exp->to_string('prefix') . " = " . $exp->value( a => 2 ) . "\n\n"; print "Is constant.\n" if $exp->is_constant(); print "Can be written as a sum.\n" if $exp->is_sum(); Math-Symbolic-0.612/examples/run17.pl000555001750001750 42012157534055 16527 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Math::Symbolic qw/:all/; use Math::Symbolic::VectorCalculus qw/:all/; my $taylor = TaylorPolyTwoDim 'x*y', 'x', 'y', 8, 'x0', 'y0'; print $taylor, "\n\n"; print $taylor->apply_derivatives()->simplify(); Math-Symbolic-0.612/examples/run12.pl000555001750001750 231512157534055 16547 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Math::Symbolic qw/:all/; # A particle being thrown on the earth: my $energy = parse_from_string('E_pot(y) + E_kin(v)'); my $velocity = parse_from_string( '( total_derivative(x(t), t)^2 + total_derivative(y(t), t)^2 )^0.5'); my $x = parse_from_string('x_initial + v_x_initial * t'); my $y = parse_from_string('y_initial + v_y_initial * t - (g*t^2)/2'); $y->implement( g => parse_from_string('9.8') ); $velocity->implement( x => $x, y => $y ); $velocity = $velocity->apply_derivatives()->simplify(); $energy->implement( E_pot => parse_from_string('m * g * y(t)'), E_kin => parse_from_string('0.5 * m * v(t)^2') ); $energy->implement( g => parse_from_string('9.8'), v => $velocity, y => $y ); my $specific_velocity = $velocity->new(); $specific_velocity->implement( x_initial => Math::Symbolic::Constant->new(0), y_initial => Math::Symbolic::Constant->new(0), v_x_initial => Math::Symbolic::Constant->new(5), v_y_initial => Math::Symbolic::Constant->new(2), ); my ($sub) = Math::Symbolic::Compiler->compile_to_sub($specific_velocity); foreach my $time ( 1 .. 10 ) { print $sub->($time), "\n"; } Math-Symbolic-0.612/examples/run19.pl000555001750001750 204312157534055 16554 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Math::Symbolic qw/:all/; my $latex_str = "\\documentclass[12pt]{article}\n\\begin{document}\n"; # oscillation my $term = parse_from_string(<<'HERE'); Omega * e^(i*omega*t) HERE $latex_str .= $term->to_latex( replace_default_greek => 1 ) . "\n\n"; # Lagrange function of Euler angles $term = parse_from_string(<<'HERE'); (1/2)*omega*Theta*omega-U(phi, theta, psi, t) HERE $latex_str .= $term->to_latex( replace_default_greek => 1 ) . "\n\n"; # mapping Math::Symbolic::Variable names to plain LaTeX my $vars = { p_i => 'p_{i}', q_i => 'q_{i}', }; # i-th term of the Poisson parenthesis $term = parse_from_string(<<'HERE'); partial_derivative(g, p_i) * partial_derivative(f, q_i) - partial_derivative(g, q_i) * partial_derivative(f, p_i) HERE $latex_str .= $term->to_latex( replace_default_greek => 1, implicit_multiplication => 1, variable_mappings => $vars ) . "\n\n"; $latex_str .= "\\end{document}\n"; # This is a valid LaTeX document: print $latex_str; Math-Symbolic-0.612/examples/run04.pl000555001750001750 211512157534055 16546 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Math::Symbolic qw/:all/; use Benchmark; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); my $c = Math::Symbolic::Constant->new(); my $e = $c->euler(); my $two = $c->new(2); print "Vars: a=" . $a->value() . " (Values are optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $two, $a ); my $exp1 = $op->new( '^', $e, $mul1 ); print "prefix notation and evaluation:\n"; print $exp1->to_string('prefix') . " = " . $exp1->value() . "\n\n"; print "Now, we derive this partially to a (20 times): (infix)\n"; use Time::HiRes qw/time/; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $exp1, $a ], } ); foreach ( 1 .. 100 ) { print "$_\n"; $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $n_tree, $a ], } ); $n_tree = $n_tree->apply_derivatives(); $n_tree = $n_tree->simplify(); } print $n_tree->to_string('infix') . " = " . $n_tree->value() . "\n\n"; Math-Symbolic-0.612/examples/run03.pl000555001750001750 221312157534055 16544 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); print "Vars: a=" . $a->value() . " (Value is optional)\n\n"; my $const = Math::Symbolic::Constant->new(); my $ten = $const->new(10); my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $a, $a ); my $log1 = $op->new( 'log', $ten, $mul1 ); print "Expression: log_10(a*a)\n\n"; print "prefix notation and evaluation:\n"; print $log1->to_string('prefix') . " = " . $log1->value() . "\n\n"; print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $log1, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified = " . $derived->value() . "\n\n"; Math-Symbolic-0.612/examples/run18.pl000555001750001750 43012157534055 16531 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Math::Symbolic qw/:all/; use Math::Symbolic::MiscAlgebra qw/:all/; my @matrix = ( [ 'x*x', 'x*y', 'x*z' ], [ 'y*x', 'y*y', 'y*z' ], [ 'z*x', 'z*y', 'z*z' ], ); my $det = det @matrix; print $det->simplify(); Math-Symbolic-0.612/examples/run02.pl000555001750001750 234012157534055 16544 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); my $b = $var->new( 'b' => 3 ); my $c = $var->new( 'c' => 4 ); print "Vars: a=" . $a->value() . " b=" . $b->value() . " c=" . $c->value() . " (Values are optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $add1 = $op->new( '+', $a, $c ); my $mult1 = $op->new( '*', $a, $b ); my $div1 = $op->new( '/', $add1, $mult1 ); print "Expression: (a+c)/(a*b)\n\n"; print "prefix notation and evaluation:\n"; print $div1->to_string('prefix') . " = " . $div1->value() . "\n\n"; print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $div1, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified = " . $derived->value() . "\n\n"; Math-Symbolic-0.612/examples/run08.pl000555001750001750 260112157534055 16552 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 3.14159 ); my $c = Math::Symbolic::Constant->new(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin = $op->new( 'sinh', $op->new( '*', $two, $a ) ); print "Expression: sinh(2*x)\n\n"; print "prefix notation and evaluation:\n"; print $sin->to_string('prefix') . " = " . $sin->value() . "\n\n"; print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $sin, $a ], } ); print $n_tree->to_string('prefix') . " = " . $sin->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived" . " = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); print "$derived = " . $derived->value() . "\n\n"; print "Now, we do this three more times:\n"; for ( 1 .. 3 ) { $derived = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived, $a ], } )->apply_derivatives()->simplify(); } print "$derived = " . $derived->value() . "\n\n"; Math-Symbolic-0.612/examples/run14.pl000555001750001750 634112157534055 16554 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; # Perl solving a physics / electrodynamics problem involving # symbolic mathematics, derivatives and complex numbers: use lib '../lib'; use Math::Symbolic qw/:all/; use Math::Complex; # Given the following simple circuit: # # ----|||||-----/\/\/\---- (R = resistor, # | R L | L = solenoid, # | | U = alternating voltage) # ---------O ~ O---------- # U(t) # # Question: What's the current in this circuit? # # We'll need some physics before letting the computer do the # math: # Applying Kirchhoff's rules, one quickly ends up with the # following differential equation for the current: # (L * dI/dt) + (R * I) = U my $left = parse_from_string('L * total_derivative(I(t), t) + R * I(t)'); my $right = parse_from_string('U(t)'); # If we understand current and voltage to be complex functions, # we'll be able to derive. ("'" denoting complex here) # I'(t) = I'_max * e^(i*omega*t) # U'(t) = U_max * e^(i*omega*t) # (Please note that omega is the frequency of the alternating voltage. # For example, the voltage from German outlets has a frequency of 50Hz.) my $argument = parse_from_string('e^(i*omega*t)'); my $current = parse_from_string('I_max') * $argument; my $voltage = parse_from_string('U_max') * $argument; # Putting it into the equation: $left->implement( I => $current ); $right->implement( U => $voltage ); $left = $left->apply_derivatives()->simplify(); # Now, we can solve the equation to get a complex function for # the current: $left /= $argument; $right /= $argument; my $quotient = parse_from_string('R + i*omega*L'); $left /= $quotient; $right /= $quotient; # Now we have: # $left = $right # I_max(t) = U_max / (R + i*omega*L) # But I_max(t) is still complex and so is the right-hand-side of the # equation! # Making the symbolic i a "literal" Math::Complex i $right->implement( e => Math::Symbolic::Constant->euler(), i => Math::Symbolic::Constant->new(i), # Math::Complex magic ); print <<'HERE'; Sample of complex maximum current with the following values: U_max => 100 R => 10 L => 10 omega => 1 HERE print "Computed to: " . $right->value( U_max => 100, R => 10, L => 10, omega => 1, ), "\n\n"; # Now, we're dealing with alternating current and voltage. # So let's make a generator that generates nice current # functions of time! # I(t) = Re(I_max(t)) * cos(omega*t - phase); # Usage: generate_current(U_Max, R, L, omega, phase) sub generate_current { my $current = $right->new(); # cloning $current *= parse_from_string('cos(omega*t - phase)'); $current->implement( U_max => $_[0], R => $_[1], L => $_[2], omega => $_[3], phase => $_[4], ); $current = $current->simplify(); return sub { Re( $current->value( t => $_[0] ) ) }; } print "Sample current function with: 230V, 2Ohms, 0.1H, 50Hz, PI/4\n"; my $current_of_time = generate_current( 230, 2, 0.1, 50, PI / 4 ); print "The current at 0 seconds: " . $current_of_time->(0) . "\n"; print "The current at 0.1 seconds: " . $current_of_time->(0.1) . "\n"; print "The current at 1 second: " . $current_of_time->(1) . "\n"; Math-Symbolic-0.612/examples/run20.pl000555001750001750 211712157534055 16546 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Math::Symbolic qw/:all/; BEGIN { warn "foo"; my $in = ; }; my $latex_str = "\\documentclass[12pt]{article}\n\\begin{document}\n"; # oscillation my $term = parse_from_string(<<'HERE'); Omega * e^(i*omega*t) HERE $latex_str .= $term->to_latex( replace_default_greek => 1 ) . "\n\n"; # Lagrange function of Euler angles $term = parse_from_string(<<'HERE'); (1/2)*omega*Theta*omega-U(phi, theta, psi, t) HERE $latex_str .= $term->to_latex( replace_default_greek => 1 ) . "\n\n"; # mapping Math::Symbolic::Variable names to plain LaTeX my $vars = { p_i => 'p_{i}', q_i => 'q_{i}', }; # i-th term of the Poisson parenthesis $term = parse_from_string(<<'HERE'); partial_derivative(g, p_i) * partial_derivative(f, q_i) - partial_derivative(g, q_i) * partial_derivative(f, p_i) HERE $latex_str .= $term->to_latex( replace_default_greek => 1, implicit_multiplication => 1, variable_mappings => $vars ) . "\n\n"; $latex_str .= "\\end{document}\n"; # This is a valid LaTeX document: print $latex_str; Math-Symbolic-0.612/examples/run01.pl000555001750001750 220412157534055 16542 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'a' => 2 ); print "Vars: a=" . $a->value() . " (Value is optional)\n\n"; my $const = Math::Symbolic::Constant->new(); my $ten = $const->new(10); my $op = Math::Symbolic::Operator->new(); my $mul1 = $op->new( '*', $a, $a ); my $exp = $op->new( '^', $ten, $mul1 ); print "Expression: 10^(a*a)\n\n"; print "prefix notation and evaluation:\n"; print $exp->to_string('prefix') . " = " . $exp->value() . "\n\n"; print "Now, we derive this partially to a: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $exp, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified = " . $derived->value() . "\n\n"; Math-Symbolic-0.612/examples/run11.pl000555001750001750 306212157534055 16546 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $exp = Math::Symbolic->parse_from_string('10^(a(x)*a(x))'); print "Expression: 10^(a(x)*a(x))\n\n"; print "prefix notation and evaluation: (a=2)\n"; print $exp->to_string('prefix') . " = " . $exp->value( a => 2 ) . "\n\n"; print "Now, we derive this totally to a: (prefix again)\n"; my $n_tree = $exp->new( 'total_derivative', $exp, 'a' ); print $n_tree->to_string('prefix') . " = " . $n_tree->value( a => 2 ) . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived = " . $derived->value( a => 2 ) . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified = " . $derived->value( a => 2 ) . "\n\n"; print "For a change, we derive the term to x.\n"; $n_tree = $exp->new( 'total_derivative', $exp, 'x' ); print "$n_tree\n"; $derived = $n_tree->apply_derivatives(); print "The derived term becomes:\n"; print "$derived\n"; print "Which simplifies as:\n"; $derived = $derived->simplify(); print $derived, "\n\n"; print "But we're not satisfied. The total derivative cannot be applied to\n" . "'a' because a depends on 'x', but we don't know how. Let's implement 'a'\n" . "as 'x^2' and try again.\n"; $derived = $derived->implement( a => 'x^2' ); print "$derived\n\n"; print "Which ultimately becomes:\n"; $derived = $derived->apply_derivatives(); $derived = $derived->simplify(); print $derived, "\n"; Math-Symbolic-0.612/examples/run09.pl000555001750001750 253512157534055 16561 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 3.14159 ); my $c = Math::Symbolic::Constant->new(); my $two = $c->new(2); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $sin = $op->new( 'tan', $op->new( '*', $two, $a ) ); print "Expression: tan(x)\n\n"; print "prefix notation and evaluation:\n"; print $sin->to_string('prefix') . " = " . $sin->value() . "\n\n"; print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $sin, $a ], } ); print $n_tree->to_string('prefix') . " = " . $n_tree->value() . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived" . " = " . $derived->value() . "\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; $derived = $derived->simplify(); print "$derived = " . $derived->value() . "\n\n"; print "Two more derivatives:\n\n"; for ( 1 .. 2 ) { $derived = $op->new( { type => U_P_DERIVATIVE, operands => [ $derived, $a ], } )->apply_derivatives()->simplify(); print "$derived\n\n"; } Math-Symbolic-0.612/examples/run05.pl000555001750001750 163512157534055 16555 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $exp = $op->new( '^', $a, $a ); print "Expression: x^x\n\n"; print "prefix notation and evaluation:\n"; print $exp->to_string('prefix') . "\n\n"; print "Now, we derive this partially to x: (prefix again)\n"; my $n_tree = $op->new( { type => U_P_DERIVATIVE, operands => [ $exp, $a ], } ); print $n_tree->to_string('prefix') . "\n\n"; print "Now, we apply the derivative to the term: (infix)\n"; my $derived = $n_tree->apply_derivatives(); print "$derived\n\n"; print "Finally, we simplify the derived term as much as possible:\n"; my $simplified = $derived->simplify(); print "$simplified\n\n"; Math-Symbolic-0.612/examples/run15.pl000555001750001750 142712157534055 16555 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Math::Symbolic qw/:all/; use Math::Symbolic::VectorCalculus qw/:all/; my @gradient = grad 'x*y + 2*z*x - y^2'; @gradient = map { $_->apply_derivatives()->simplify() } @gradient; print "$_\n" foreach @gradient; print "\n\n"; my @funcs = ( 'x*y+2*z*x-y^2', 'y+x+z', 'x*y*z' ); my $div = div @funcs; print $div->apply_derivatives()->simplify(); print "\n\n"; my @rot = rot @funcs; @rot = map { $_->apply_derivatives()->simplify() } @rot; print "$_\n" foreach @rot; print "\n\n"; my @matrix = Jacobi @funcs; print "[\n"; foreach my $func (@matrix) { print " [\n"; foreach my $var (@$func) { $var = $var->apply_derivatives()->simplify(); print " $var\n"; } print " ]\n"; } print "]\n"; Math-Symbolic-0.612/examples/run16.pl000555001750001750 531512157534055 16556 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib/'; use Carp; use Math::Symbolic qw/:all/; use Math::Symbolic::MiscCalculus qw/:all/; my $taylor = TaylorPolynomial 'sin(x)', 10, 'x', 'x_0'; $taylor->implement( e => Math::Symbolic::Constant->euler() ); print $taylor, "\n\n"; my $t = $taylor->implement( x_0 => 0 ); print +( $_ * PI / 4 ), ":\nTaylor: " . $taylor->value( x => $_ * PI / 4 ), "\nExact: ", sin( $_ * PI / 4 ), "\n" for 0 .. 10; my $error = TaylorErrorLagrange 'sin(x)', 100, 'x', 'x_0', 'theta'; $error = $error->simplify(); print "\nErrors:"; print "For " . ( $_ * PI / 4 ) . ": ", $error->value( theta => 1, x_0 => 0, x => $_ * PI / 4 ), "\n" for 0 .. 100; print "Would you like to plot the results using Imager? (y/n)\n"; print ": "; my $answer = ; exit unless $answer =~ /^\s*y/i; require Imager; my $img = Imager->new( xsize => 800, ysize => 600 ); my $white = Imager::Color->new( 255, 255, 255 ); my $green = Imager::Color->new( 0, 255, 0 ); my $red = Imager::Color->new( 255, 0, 0 ); my $blue = Imager::Color->new( 0, 0, 255 ); my $yellow = Imager::Color->new( 255, 255, 0 ); $img->line( color => $blue, x1 => 0, x2 => 800, y1 => 300, y2 => 300 ); $img->line( color => $blue, x1 => 400, x2 => 400, y1 => 0, y2 => 600 ); print "\nThe white plot is the original sine. The green plot is the third\n" . "order Taylor polynomial and the red plot is the tenth order Taylor\n" . "polynomial. Finally, the yellow plot is the twentieth order Taylor\n" . "polynomial. All polynomials approximate around 0.\n"; my $third = TaylorPolynomial 'sin(x)', 3, 'x', 'x_0'; $third->implement( e => Math::Symbolic::Constant->euler(), x_0 => 0 ); my $twenty = TaylorPolynomial 'sin(x)', 20, 'x', 'x_0'; $twenty->implement( e => Math::Symbolic::Constant->euler(), x_0 => 0 ); my $sine = parse_from_string('sin(x)'); use Math::Symbolic::Compiler qw/compile_to_sub/; foreach my $ary ( [ $third, $green ], [ $taylor, $red ], [ $twenty, $yellow ], [ $sine, $white ] ) { my ( $tree, $color ) = @$ary; my ($sub) = compile_to_sub($tree); die unless defined $sub and ref $sub eq 'CODE'; my $prev; foreach ( -150 .. 150 ) { my $x = $_ * PI / 50; my $y = $sub->($x); if ( not defined $prev ) { $prev = [ $x, $y ]; next; } $img->line( color => $color, x1 => ( $prev->[0] * 40 ) + 400, x2 => ( $x * 40 ) + 400, y1 => -( $prev->[1] * 40 ) + 300, y2 => -( $y * 40 ) + 300, ); $prev = [ $x, $y ]; } } print "The image will be written to the file 'image.png'.\n"; $img->write( file => 'image.png' ) or die $img->errstr; Math-Symbolic-0.612/examples/run06.pl000555001750001750 174312157534055 16556 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $div = $op->new( '/', $a, $a ); my $mul = $op->new( '*', $a, $a ); my $sum = $op->new( '+', $a, $a ); my $dif = $op->new( '-', $a, $a ); print "Expressions: x/x, x*x, x+x, x-x\n\n"; print "prefix notation and evaluation:\n"; print $div->to_string('prefix') . "\n\n"; print $mul->to_string('prefix') . "\n\n"; print $sum->to_string('prefix') . "\n\n"; print $dif->to_string('prefix') . "\n\n"; print "Finally, we simplify the derived terms as much as possible:\n"; my $simplified = $div->simplify(); print "$simplified\n\n"; $simplified = $mul->simplify(); print "$simplified\n\n"; $simplified = $sum->simplify(); print "$simplified\n\n"; $simplified = $dif->simplify(); print "$simplified\n\n"; Math-Symbolic-0.612/examples/run07.pl000555001750001750 101312157534055 16545 0ustar00tseetsee000000000000#!/usr/bin/perl use strict; use warnings; use lib '../lib'; use Data::Dumper; use Math::Symbolic qw/:all/; my $var = Math::Symbolic::Variable->new(); my $a = $var->new( 'x' => 2 ); print "Vars: x=" . $a->value() . " (Value is optional)\n\n"; my $op = Math::Symbolic::Operator->new(); my $umi = $op->new( { type => U_MINUS, operands => [$a] } ); print "Expression: -x\n\n"; print "prefix notation:\n"; print $umi->to_string('prefix') . "\n\n"; print "infix notation:\n"; print $umi->to_string('infix') . "\n\n";