All geek questions in one place

An attempt to develop PostFix notation in a tree using Perl

I use Perl to run through the tree, and then compute the leaf nodes of the tree using internal nodes as operators. I want to be able to print this in a postfix manner, and I managed it quite easily with the main operands (just call the left and right nodes respectively before calling the parent), but I am having trouble creating the desired result for the middle function. I have no problem printing the actual result of the calculation, but I want to be able to print operators and operands in postfix notation.

For example, 1 + average (3, 4, 5) will be displayed as 1; 3 4 5 medium +.

Here is my code:

use strict;
use warnings;

use Data::Dumper;

$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;

my $debug = 0;

# an arithmetic expression tree is a reference to a list, which can
# be of two kinds as follows:
#    [ 'leaf', value ]
#    [ 'internal', operation, leftarg, rightarg ]

# Evaluate($ex) takes an arithmetic expression tree and returns its 
# evaluated value.

sub Evaluate {
    my ($ex) = @_;

    $debug and
        print "evaluating: ", Dumper($ex), "\n";

    # the kind of node is given in the first element of the array
    my $node_type = $ex->[0];

    # if a leaf, then the value is a number
    if ( $node_type eq 'leaf' ) {
        # base case
        my $value = $ex->[1];
        $debug and
            print "returning leaf: $value\n";
        return $value;            
        }

    # if not a leaf, then is internal,

    if ( $node_type ne 'internal' ) {
        die "Eval: Strange node type '$node_type' when evaluating tree";
    }

    # should now have an operation and two arguments
    my $operation = $ex->[1];
    my $left_ex = $ex->[2];
    my $right_ex = $ex->[3];

    # evaluate the left and right arguments;
    my $left_value = Evaluate($left_ex);
    my $right_value = Evaluate($right_ex);

    # if any arguments are undefined, our value is undefined.
    return undef unless 
        defined($left_value) and defined($right_value);

    my $result;

    # or do it explicitly for the required operators ...
    if ($operation eq 'average') {
        $result = ($left_value + $right_value) / 2;
    }
    if ($operation eq '+') {
        $result = $left_value + $right_value;
    } elsif ($operation eq '-') {
        $result = $left_value - $right_value;
    } elsif ($operation eq '*') {
        $result = $left_value * $right_value;
    } elsif ($operation eq 'div') {
        if ($right_value != 0 ) {
        $result = int ($left_value / $right_value);
        } else {
            $result = undef;
        }
    } elsif ($operation eq 'mod') {
        $result = $left_value % $right_value;
    } elsif ($operation eq '/') {
        if ( $right_value != 0 ) {
            $result = $left_value / $right_value;
            }
        else {
            $result = undef;
            }
    }

    $debug and
        print "returning '$operation' on $left_value and $right_value result: $result\n";

    return $result;
    }


# Display($ex, $style) takes an arithmetic expression tree and a style 
# parameter ('infix' or 'postfix') and returns a string that represents 
# printable form of the expression in the given style.

sub Display {
    my ($ex, $style) = @_;

    # the kind of node is given in the first element of the array
    my $node_type = $ex->[0];

    # if a leaf, then the value is a number
    if ( $node_type eq 'leaf' ) {
        # base case
        my $value = $ex->[1];
        return $value;            
        }

    # if not a leaf, then is internal,

    if ( $node_type ne 'internal' ) {
        die "Display: Strange node type '$node_type' when evaluating tree";
    }

    # should now have an operation and two arguments
    my $operation = $ex->[1];
    my $left_ex = $ex->[2];
    my $right_ex = $ex->[3];

    # evaluate the left and right arguments;
    my $left_value = Display($left_ex, $style);
    my $right_value = Display($right_ex, $style);

    my $result;
    if ($operation ne 'average') {
    $result = "($left_value $operation $right_value) \n $left_value $right_value $operation";
    } else {
    $result = "($left_value $operation $right_value) \n $left_value $right_value $operation";
    }
    return $result;
    }

# module end;
1;

And here is the test:

use strict;
use warnings;

use Display;

use arith;

my $ex1 = [ 'leaf', 42];

my $ex2 = [ 'internal', '+', [ 'leaf', 42], [ 'leaf', 10 ] ];

my $ex3 = [ 'internal', 'average', $ex2, [ 'leaf', 1 ] ];



print "ex1 is ", Evaluate($ex1), "\n";
print "ex1: ", Display($ex1), "\n";
print "\n";

print "ex2 is ", Evaluate($ex2), "\n";
print "ex2: ", Display($ex2), "\n";
print "\n";

print "ex3 is ", Evaluate($ex3), "\n";
print "ex3: ", Display($ex3), "\n";
print "\n";
Display::Render(\$ex3);

, , "", , output → value; #, , # ..

?

+3
2

100%, , / :

my %ops = ( # dispatch table for operations
    average  => sub {my $acc; $acc += $_ for @_; $acc / @_},
    '+'      => sub {$_[0] + $_[1]},
    '-'      => sub {$_[0] - $_[1]},
    '*'      => sub {$_[0] * $_[1]},
    'mod'    => sub {$_[0] % $_[1]},
    (map {$_ => sub {$_[1] ? $_[0] / $_[1] : undef}} qw (/ div)),
);
sub Evaluate {
    my $ex = shift;
    print "evaluating: ", Dumper($ex), "\n" if $debug;

    my $node_type = $ex->[0];
    if ( $node_type eq 'leaf' ) {
        print "returning leaf: $$ex[1]\n" if $debug;
        return $$ex[1];
    }
    elsif ( $node_type ne 'internal' ) {
        die "Eval: Strange node type '$node_type' when evaluating tree";
    }

    my $operation = $ex->[1];
    my @values    = map {Evaluate($_)} @$ex[2 .. $#$ex];

    defined or return for @values;

    if (my $op = $ops{$operation}) {
        return $op->(@values);
    } else {
        print "operation $operation not found\n";
        return undef;
    }
}

if/elsif . . $left_value $right_value @values, n-arity (, average).

Display ​​ n-arity:

my %is_infix = map {$_ => 1} qw( * + / - );
sub Display {
    my ($ex, $style) = @_;

    my $node_type = $ex->[0];

    # if a leaf, then the value is a number
    if ( $node_type eq 'leaf' ) {
        return $$ex[1];
    }

    # if not a leaf, then is internal,
    if ( $node_type ne 'internal' ) {
        die "Display: Strange node type '$node_type' when evaluating tree";
    }

    # should now have an operation and n arguments
    my $operation = $ex->[1];

    if ($style and $style eq 'infix') {
        my @values = map {Display($_, $style)} @$ex[2 .. $#$ex];
        if ($is_infix{$operation}) {
            return "$values[0] $operation $values[1]"
        } else {
            local $" = ', ';                 # "
            return "$operation( @values )"
        }
    } else { # postfix by default
        my @out;
        for (@$ex[2 .. $#$ex]) {
            if (@out and $_->[0] eq 'internal') {
                push @out, ';'
            }
            push @out, Display($_, $style)
        }
        return join ' ' => @out, $operation;
    }
}

Display Display($tree) Display($tree, 'postfix') . Display($tree, 'infix') infix.

ex1 is 42
ex1: 42
ex1: 42

ex2 is 52
ex2: 42 10 +
ex2: 42 + 10

ex3 is 26.5
ex3: 42 10 + 1 average
ex3: average( 42 + 10, 1 )

, , .

, 1 + average(3, 4, 5):

my $avg = ['internal', 'average', [leaf => 3], [leaf => 4], [leaf => 5] ];
my $ex4 = ['internal', '+', [leaf => 1], $avg ];

print "ex4 is ", Evaluate($ex4), "\n";
print "ex4: ", Display($ex4), "\n";
print "ex4: ", Display($ex4, 'infix'), "\n";
print "\n";

:

ex4 is 5
ex4: 1 ; 3 4 5 average +
ex4: 1 + average( 3, 4, 5 )
+2

, AlgebraicToRPN?

0

Source: https://habr.com/ru/post/1791314/

More articles:


All Articles