Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: List all different equations for a given one

by hdb (Monsignor)
on Sep 25, 2013 at 17:38 UTC ( #1055717=note: print w/replies, xml ) Need Help??


in reply to List all different equations for a given one

As I had some fun with drawing binary trees recently, I thought, parsing equations into such a tree would be interesting as well. I was also able to simplify the tree for operations on numbers (in contrast to variables) and expand based on distributivity. But now I am stuck. I was thinking that some re-ordering would lead to a definite form for each equation but I have no idea how to go about it. In any case, the code produces the following output which might be of interest (or at least entertaining). (Numbers are written vertically, and I have used ^ instead of **.)

Equation: 1+x^2*((1+y)*3)+5*(4+(4+3)) + / \__________________ 1 + __________/ \ * 5 __/ \__ 5 ^ + / \ / \__ x 2 3 * / \ y 3 Equation: ((4+c)*y)^(4+2)/5-s^200 - __/ \__ / ^ __/ \ / \ ^ 5 s 2 ______/ \ 0 + 6 0 __/ \__ * * / \ / \ 4 y c y Equation: 2+2 4
use strict; use warnings; use Data::Dumper; my %ops = ( '+' => sub { $_[0] + $_[1] }, '-' => sub { $_[0] - $_[1] }, '*' => sub { $_[0] * $_[1] }, '/' => sub { $_[1] or die "Division by zero.\n"; $_[0] / $_[1] +}, '^' => sub { $_[0] ** $_[1] }, ); my @ops = ( '^', '*', '/', '+', '-' ); my @parens = ( '(', ')' ); my @operands = ( '\d+', '\w+' ); my $tokre = join "|", @operands, map { "\Q$_\E" } @ops, @parens ; sub reduce_parens { my $tokens = shift; my @temp; while( @$tokens ) { my $tok = shift @$tokens; if( $tok eq '(' ) { push @temp, [ reduce_parens( $tokens ) ]; next; } return @temp if $tok eq ')'; push @temp, $tok; } return @temp; } sub reduce_ops { my( $tokens, $op ) = @_; my @temp; while( @$tokens ) { my $tok = shift @$tokens; if( ref( $tok ) ) { push @temp, [ reduce_ops( $tok, $op ) ]; next; } if ( $tok eq $op ) { my $left = [ @temp ]; my $right = [ reduce_ops( $tokens, $op) ]; return ( 1==@$left?$$left[0]:$left, $op, 1==@$right?$$right[0]:$ +right ); } push @temp, $tok; } return @temp; } sub distributivity { my $tokens = shift; if( ref($tokens) && $$tokens[1] =~ /^(\*|\/)$/ ) { if( ref( $$tokens[0] ) && $$tokens[0]->[1] =~ /^(\-|\+)$/ ) { my $mult = $$tokens[1]; $$tokens[1] = $$tokens[0]->[1]; my $left = $$tokens[0]->[0]; my $right = $$tokens[0]->[2]; $$tokens[0] = [ $left, $mult, $$tokens[2] ]; $$tokens[2] = [ $right, $mult, $$tokens[2] ]; } elsif( ref( $$tokens[2] ) && $$tokens[2]->[1] =~ /^(\-|\+)$/ ) { + my $mult = $$tokens[1]; $$tokens[1] = $$tokens[2]->[1]; my $left = $$tokens[2]->[0]; my $right = $$tokens[2]->[2]; $$tokens[2] = [ $$tokens[0], $mult, $right ]; $$tokens[0] = [ $$tokens[0], $mult, $left ]; } } ref( $$tokens[$_] ) and distributivity( $$tokens[$_] ) for 0,2; } sub reduce_literals { my $tokens = shift; ref $$tokens[$_] and $$tokens[$_] = reduce_literals( $$tokens[$_] ) +for 0, 2; if( !ref($$tokens[0]) && !ref($$tokens[1]) && ($$tokens[0] !~ /\D/) && ($$tokens[2] !~ /\D/) ) { return $ops{$$tokens[1]}->( $$tokens[0], $$tokens[2] ); } return $tokens; } sub parse_equation { my $eq = shift; my $tokens = [ $eq =~ /($tokre)/g ]; @$tokens = reduce_parens $tokens; @$tokens = reduce_ops $tokens, $_ for reverse @ops; distributivity $tokens; $tokens = reduce_literals $tokens; # print Dumper \@tokens; return $tokens; } sub prepare { my( $subtree, $level, $col, $graph ) = @_; my $lcol = 0; if( ref($subtree) ) { $lcol = prepare( $subtree->[0], $level+2, $col, $graph ); # par +se left side of tree, keep top position $lcol and $graph->[$level]->[$_] = '_' for $lcol..$$col-1; # dra +w horizontal line $graph->[$level]->[$$col++] = '/'; $graph->[$level-1]->[$$col++] = $subtree->[1]; $lcol = $$col; # new + root of the tree $graph->[$level]->[$$col++] = '\\'; my $rcol = prepare( $subtree->[2], $level+2, $col, $graph ); # par +se right side of the tree, keep its top position $rcol and $graph->[$level]->[$_] = '_' for $lcol+1..$rcol-2; # dra +w horizontal line } else { $graph->[$level++ -1]->[$$col] = $_ for split //, $subtree; + # leaf $$col++; } return $lcol; # ret +urn column of root } sub printTree { my $root = shift; my @graph; my $col = 1; prepare( $root, 1, \$col, \@graph ); for my $row ( @graph ) { print $_ // ' ' for @$row; print "\n"; } } for( <DATA> ){ print "\nEquation: $_\n"; printTree parse_equation( $_ ); } __DATA__ 1+x^2*((1+y)*3)+5*(4+(4+3)) ((4+c)*y)^(4+2)/5-s^200 2+2

Replies are listed 'Best First'.
Re^2: List all different equations for a given one
by zork42 (Monk) on Sep 27, 2013 at 18:04 UTC
    Very nice!

    One minor point, the "/" in the 2nd equation "((4+c)*y)^(4+2)  /  5-s^200" gets a bit confused with the tree structure as you also use "/" to print the tree:
    - __/ \__ / ^ __/ \ / \ ^ 5 s 2 ^ ^ ^
    Maybe you could use "'/'" (that's a bit hard to read, here it is again with 4 spaces added: " ' / ' ") or similar to make it stand out a bit more:
    - __/ \__ '/' ^ __/ \ / \ ^ 5 s 2 ^ ^ ^
    ?

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1055717]
help
Chatterbox?
[james28909]: cant seem to make it look in linux module path for md5.pm
[james28909]: no matter how i prepare the paths. oh well. looks like ill just have to start wsl perl from scratch
[Corion]: james28909: You can get a list of all modules on your Windows Perl via the autobundle command in the cpan shell. But that likely lists many more modules than you actually want. I recommend a clear separation and installing modules on ...
[Corion]: ... both Perls separately. I use cpanfiles or Makefile.PL for that - listing all modules for an application there allows me to install them via cpanm . or cpan . automatically without any further interaction

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (7)
As of 2018-05-23 17:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?