 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;
