Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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

In reply to Re: List all different equations for a given one by hdb
in thread List all different equations for a given one by jess195

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (9)
    As of 2014-08-28 06:22 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (257 votes), past polls