more useful options 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

^
^
^
?

Create A New User
Node Status?
node history
Node Type: note [id://1055717]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2018-04-23 20:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (85 votes). Check out past polls.

Notices?