中置記法から抽象構文木(AST)変換し後置記法（逆ポーランド記法）の計算

 吉祥寺.pm #20 へ行ってきた

東京に出張に来ていたので2019/11/22吉祥寺.pm #20へ行ってきた。色々と刺激を受けた。発表のなかで、めもりー（@m3m0r7）さんの『PHP で AST 解析して Java の中間コードを生成する』に刺激を受けて、中置記法から抽象構文木(AST)変換し後置記法（逆ポーランド記法）の計算を作ってみた。以前に中置記法から後置記法（逆ポーランド記法）への変換と計算でスタックを使った逆ポーランド記法のプログラムを作ったが、今回はASTで計算してみた。（当然paerlで）

https://kabukawa.hatenablog.jp/entry/2019/11/25/012334 <-良くまとっ待っている

 Source

 実行

$ perl ast.pl 10+1
10 + 1
11
$

mojoliciousで動くように修正した。

• デモ画面

• code

 ast.pl

use lib 'lib';
use Ast;
use Data::Dumper;

my $c = Ast->new;
#my $t = $c->adjust('(100+2**3-((1+2)/(4+-2))*(-10))');
my $t = $c->adjust(join '',@ARGV);
$c->item_split($t);
my $root = $c->makeTree(@{$c->{item}});

print "$t\n";
print $c->readTree($root),"\n";;

 Ast.pm

package Ast;
use strict;
use warnings;
use Data::Dumper;

my $op = +{ '-' => [sub {$_[0] - $_[1]},1],         # オペレータ定義
           '+' => [sub {$_[0] + $_[1]},1],
           '*' => [sub {$_[0] * $_[1]},2],
           '/' => [sub {$_[0] / $_[1]},2],
           '%' => [sub {$_[0] % $_[1]},2],
           '**' => [sub {$_[0] ** $_[1]},3],
           #'x' => [sub {$_[0] * $_[1]},8], # 多項式対応？
           '(' => [sub { },9],
           ')' => [sub { },10],
        };
sub ast{
    Ast->new('formula'=>shift())->{anser};
}
sub _ast{
    my $s = shift;
    $s->{anser} = $s->readTree($s->makeTree(@{$s->item_split($s->adjust(shift))->{item}}));
}
sub new {                                           # コンストラクター
    my $class = shift;
    my $self = {@_};
    bless $self,$class;
    $self->setReOps();
    $self->_ast($self->{formula}) if (exists $self->{formula});
    return $self;
}
sub setReOps{                                       # 演算子の正規表現作成
    my $s = shift;
    $s->{ops} = join ('|',map {s/(.)/\\$1/g;$_;} sort {length $b <=> length $a} keys %$op);
    $s->{ops} = "(".$s->{ops}.")";
    return $s;
}
sub newNode{
    my $s = shift;
    return {data => shift(),left =>shift(),right=>shift()};
}
sub readTree{                                       # AST計算
    my ($s,$node) = @_;
    do{$node->{$_} = $s->readTree($node->{$_}) if(ref($node->{$_}) eq "HASH")} for ('left','right');
    exists $op->{$node->{data}} ? $op->{$node->{data}}->[0]($node->{left},$node->{right})
                                : $node->{data};
}
sub makeTree{                                       # ATS組み立て
    my $s = shift;
    while($_[0] eq '(' and $_[-1] eq ')'){
        my ($r,$sw) = (0,0);
        for(@_){                                    # '('の深さを計算
            $r++ if($_ eq '(');                     
            $r-- if($_ eq ')');
            $sw++ if($r == 1 and $_ eq '(');
        }
        if($sw == 1){                               #  一番外側の括弧を外す
            shift;
            pop;
        }else{
            last;
        }
    }
    return shift() if(@_ <= 1);                     # 要素が一つの時は要素を返す
    my ($prio,$i,$m,$r) = (99,-1,0,0);
    for(@_){                                        # 一番右側の一番プライオリティの低いオペレータを検索
        $i++;
        if(/^$s->{ops}$/){
            $r++ if($_ eq '(');
            $r-- if($_ eq ')');
            next if($r or $_ eq ')');              #  括弧の間は読み飛ばす
            if($op->{$_}->[1]+$r <= $prio){
                $prio = $op->{$_}->[1];
                $m = $i;
            }
        }
    }
    return $s->newNode($_[$m],                      # オペレータとオペランド（右と左）を返す
                            $s->makeTree(@_[0 .. $m-1]),
                            $s->makeTree(@_[$m+1 .. $#_])
                );
}
sub item_split{                                     # 計算式を要素に分解
    my $s = shift;
    my $text = shift || $s->{_text};
    $s->{item} = [split ' ',$text];
    return $s;
}
sub adjust{                                         # 計算式の要素をスペースで分割
    my ($s,$text) = @_;
    $text =~ s/$s->{ops}/ $1 /g;
    $text =~ s{([\d\)])\s*\(}{$1 \* \(}g;           #   開き括弧の前が演算子じゃない時に*を補完 ex). (1+2)(2-1) -> (1+2)*(2-1)
    $s->{_text} = $text =~ s/($s->{ops}\s*-)\s*/$1/g;
    return $text;
}
1;

--