[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 523066680 于 2019-4-16 12:42 编辑
  1. [5, "+", [[3, "-", 9], "/", 7]]
  2. (29/7)
  3. [[[2, "/", 7], "+", 3], "-", [9, "/", 21]]
  4. (20/7)
复制代码
其中分数/有理数 有现成的模块 Math::BigRat 和 Number::Fraction。
自己实现部分功能可以熟悉一下重载。
  1. =info
  2.     表达式抽象语法树 转 有理数运算
  3.     523066680/vicyang
  4.     2019-04
  5. =cut
  6. use feature 'say';
  7. use Data::Dump qw/dd/;
  8. STDOUT->autoflush(1);
  9. my $exp1 = [ 5, '+', [[ 3, '-', 9 ], '/', 7 ]];
  10. my $exp2 = [[[2,'/',7], '+', 3], '-', [9, '/', 21]];
  11. dd $exp1;
  12. say extract( $exp1, 0 );
  13. dd $exp2;
  14. say extract( $exp2, 0 );
  15. sub extract
  16. {
  17.     my ($exp, $lv) = @_;
  18.     my $ret;
  19.     for my $e ( @{$exp}[0,2] ) {
  20.         $e = ref $e ? extract( $e, $lv+1 ) : fract->new($e, 1);
  21.     }
  22.     eval( "\$ret = \$exp->[0] $exp->[1] \$exp->[2]" );
  23.     return $ret;
  24. }
  25. {
  26.     package fract;
  27.     use overload '+' => \&add, '-' => \&sub,
  28.                  '*' => \&mul, '/' => \&div,
  29.                  q("") => \&as_string; #sub { return $_[0] };
  30.     sub new {
  31.         my ($class, $n, $m) = @_;
  32.         bless [$n, $m], $class;
  33.     }
  34.     sub add {
  35.         my ($a, $b) = @_;
  36.         my $n = $a->[0]*$b->[1] + $b->[0]*$a->[1];
  37.         my $m = $a->[1]*$b->[1];
  38.         return bless [$n, $m], ref($a);
  39.     }
  40.     sub sub {
  41.         my ($a, $b) = @_;
  42.         my $n = $a->[0]*$b->[1] - $b->[0]*$a->[1];
  43.         my $m = $a->[1]*$b->[1];
  44.         return bless [$n, $m], ref($a);
  45.     }
  46.     sub mul {
  47.         my ($a, $b) = @_;
  48.         my $n = $a->[0]*$b->[0];
  49.         my $m = $a->[1]*$b->[1];
  50.         return bless [$n, $m], ref($a);
  51.     }
  52.     sub div {
  53.         my ($a, $b) = @_;
  54.         my $n = $a->[0]*$b->[1];
  55.         my $m = $a->[1]*$b->[0];
  56.         return bless [$n, $m], ref($a);
  57.     }
  58.     sub as_string {
  59.         my ($f) = @_;
  60.         reduce($f);
  61.         return sprintf "(%d/%d)", $f->[0], $f->[1];
  62.     }
  63.     sub reduce {
  64.         my ($f) = @_;
  65.         my ($a, $b) = @$f;
  66.         while ( $b != 0 ) {
  67.             my $t = $b;
  68.             $b = $a % $b;
  69.             $a = $t;
  70.         }
  71.         $f->[0] /= $a;
  72.         $f->[1] /= $a;
  73.     }
  74.     1;
  75. }
复制代码
1

评分人数

返回列表