[Perl]运算符重载、表达式抽象语法树转有理数求值

523066680

1. 
   
2. [5, "+", [[3, "-", 9], "/", 7]]
   
3. (29/7)
   
4. [[[2, "/", 7], "+", 3], "-", [9, "/", 21]]
   
5. (20/7)
   

复制代码

其中分数/有理数 有现成的模块 Math::BigRat 和 Number::Fraction。
自己实现部分功能可以熟悉一下重载。

1. =info
   
2.     表达式抽象语法树 转 有理数运算
   
3.     523066680/vicyang
   
4.     2019-04
   
5. =cut
   
6. 
   
7. use feature 'say';
   
8. use Data::Dump qw/dd/;
   
9. STDOUT->autoflush(1);
   
10. 
    
11. my $exp1 = [ 5, '+', [[ 3, '-', 9 ], '/', 7 ]];
    
12. my $exp2 = [[[2,'/',7], '+', 3], '-', [9, '/', 21]];
    
13. dd $exp1;
    
14. say extract( $exp1, 0 );
    
15. 
    
16. dd $exp2;
    
17. say extract( $exp2, 0 );
    
18. 
    
19. sub extract
    
20. {
    
21.     my ($exp, $lv) = @_;
    
22.     my $ret;
    
23.     for my $e ( @{$exp}[0,2] ) {
    
24.         $e = ref $e ? extract( $e, $lv+1 ) : fract->new($e, 1);
    
25.     }
    
26.     eval( "\$ret = \$exp->[0] $exp->[1] \$exp->[2]" );
    
27.     return $ret;
    
28. }
    
29. 
    
30. {
    
31.     package fract;
    
32.     use overload '+' => \&add, '-' => \&sub,
    
33.                  '*' => \&mul, '/' => \&div,
    
34.                  q("") => \&as_string; #sub { return $_[0] };
    
35. 
    
36.     sub new {
    
37.         my ($class, $n, $m) = @_;
    
38.         bless [$n, $m], $class;
    
39.     }
    
40. 
    
41.     sub add {
    
42.         my ($a, $b) = @_;
    
43.         my $n = $a->[0]*$b->[1] + $b->[0]*$a->[1];
    
44.         my $m = $a->[1]*$b->[1];
    
45.         return bless [$n, $m], ref($a);
    
46.     }
    
47. 
    
48.     sub sub {
    
49.         my ($a, $b) = @_;
    
50.         my $n = $a->[0]*$b->[1] - $b->[0]*$a->[1];
    
51.         my $m = $a->[1]*$b->[1];
    
52.         return bless [$n, $m], ref($a);
    
53.     }
    
54. 
    
55.     sub mul {
    
56.         my ($a, $b) = @_;
    
57.         my $n = $a->[0]*$b->[0];
    
58.         my $m = $a->[1]*$b->[1];
    
59.         return bless [$n, $m], ref($a);
    
60.     }
    
61. 
    
62.     sub div {
    
63.         my ($a, $b) = @_;
    
64.         my $n = $a->[0]*$b->[1];
    
65.         my $m = $a->[1]*$b->[0];
    
66.         return bless [$n, $m], ref($a);
    
67.     }
    
68. 
    
69.     sub as_string {
    
70.         my ($f) = @_;
    
71.         reduce($f);
    
72.         return sprintf "(%d/%d)", $f->[0], $f->[1];
    
73.     }
    
74. 
    
75.     sub reduce {
    
76.         my ($f) = @_;
    
77.         my ($a, $b) = @$f;
    
78.         while ( $b != 0 ) {
    
79.             my $t = $b;
    
80.             $b = $a % $b;
    
81.             $a = $t;
    
82.         }
    
83.         $f->[0] /= $a;
    
84.         $f->[1] /= $a;
    
85.     }
    
86. 
    
87.     1;
    
88. }
    

复制代码