[5, "+", [[3, "-", 9], "/", 7]]
(29/7)
[[[2, "/", 7], "+", 3], "-", [9, "/", 21]]
(20/7)
复制代码

=info
    表达式抽象语法树 转 有理数运算
    523066680/vicyang
    2019-04
=cut

use feature 'say';
use Data::Dump qw/dd/;
STDOUT->autoflush(1);

my $exp1 = [ 5, '+', [[ 3, '-', 9 ], '/', 7 ]];
my $exp2 = [[[2,'/',7], '+', 3], '-', [9, '/', 21]];
dd $exp1;
say extract( $exp1, 0 );

dd $exp2;
say extract( $exp2, 0 );

sub extract
{
    my ($exp, $lv) = @_;
    my $ret;
    for my $e ( @{$exp}[0,2] ) {
        $e = ref $e ? extract( $e, $lv+1 ) : fract->new($e, 1);
    }
    eval( "\$ret = \$exp->[0] $exp->[1] \$exp->[2]" );
    return $ret;
}

{
    package fract;
    use overload '+' => \&add, '-' => \&sub, 
                 '*' => \&mul, '/' => \&div, 
                 q("") => \&as_string; #sub { return $_[0] };

    sub new {
        my ($class, $n, $m) = @_;
        bless [$n, $m], $class;
    }

    sub add {
        my ($a, $b) = @_;
        my $n = $a->[0]*$b->[1] + $b->[0]*$a->[1];
        my $m = $a->[1]*$b->[1];
        return bless [$n, $m], ref($a);
    }

    sub sub {
        my ($a, $b) = @_;
        my $n = $a->[0]*$b->[1] - $b->[0]*$a->[1];
        my $m = $a->[1]*$b->[1];
        return bless [$n, $m], ref($a);
    }

    sub mul {
        my ($a, $b) = @_;
        my $n = $a->[0]*$b->[0];
        my $m = $a->[1]*$b->[1];
        return bless [$n, $m], ref($a);
    }

    sub div {
        my ($a, $b) = @_;
        my $n = $a->[0]*$b->[1];
        my $m = $a->[1]*$b->[0];
        return bless [$n, $m], ref($a);
    }

    sub as_string {
        my ($f) = @_;
        reduce($f);
        return sprintf "(%d/%d)", $f->[0], $f->[1];
    }

    sub reduce {
        my ($f) = @_;
        my ($a, $b) = @$f;
        while ( $b != 0 ) {
            my $t = $b;
            $b = $a % $b;
            $a = $t;
        }
        $f->[0] /= $a;
        $f->[1] /= $a;
    }

    1;
}
复制代码