### Comment on

 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

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!
• Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
• Read Where should I post X? if you're not absolutely sure you're posting in the right place.
• 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
• You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
 For: Use: & & < < > > [ [ ] ]
• Link using PerlMonks shortcuts! What shortcuts can I use for linking?

Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2018-04-21 07:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (81 votes). Check out past polls.

Notices?