Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: List all different equations for a given one

by hdb (Parson)
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


Comment on Re: List all different equations for a given one
Select or Download Code
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?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2014-04-20 01:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (485 votes), past polls