File Coverage

blib/lib/Math/Notation/PostfixInfix.pm
Criterion Covered Total %
statement 103 153 67.3
branch 32 74 43.2
condition 11 44 25.0
subroutine 11 13 84.6
pod 3 4 75.0
total 160 288 55.5


line stmt bran cond sub pod time code
1             # ABSTRACT Math Notation for Postfix and Infix Expressions
2             #
3             ## Copyright (C) Carlos Celso
4             #
5             ## This program is free software: you can redistribute it and/or modify
6             ## it under the terms of the GNU General Public License as published by
7             ## the Free Software Foundation, either version 3 of the License, or
8             ## (at your option) any later version.
9             #
10             package Math::Notation::PostfixInfix;
11              
12 1     1   70802 use strict;
  1         4  
  1         28  
13 1     1   7 use warnings;
  1         1  
  1         22  
14 1     1   4 use Exporter;
  1         2  
  1         46  
15              
16 1     1   7 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION );
  1         2  
  1         2395  
17              
18             our @ISA = qw( Exporter );
19              
20             our @EXPORT = qw( new Infix_to_Postfix Postfix_to_Infix Postfix_Test );
21            
22             our @EXPORT_OK = qw( new Infix_to_Postfix Postfix_to_Infix Postfix_Test );
23              
24             our %EXPORT_TAGS = ( all => [@EXPORT_OK] );
25              
26             our $VERSION = "2023.111.1";
27              
28             1;
29              
30             ###############################################################################
31             # create object
32              
33             sub new()
34             {
35 0   0 0 0 0 my $class = shift; $class = ref($class) || $class || 'Math::Notation::PostfixInfix';
  0         0  
36              
37             ## save options
38             #
39 0         0 my $self = {@_};
40             #
41             ## new object
42             #
43 0         0 my $bless = bless($self,$class);
44 0 0       0 return 0 if (!defined($bless));
45              
46 0         0 $bless;
47             }
48              
49             ###############################################################################
50             # polish test
51              
52             sub Postfix_Test()
53             {
54 0     0 1 0 my $self = shift;
55 0         0 my $array = shift;
56 0         0 my $call = shift;
57 0         0 my @opts = @_;
58 0         0 my @rc;
59 0         0 my $is_code = (ref($call) eq "CODE");
60              
61             ## scan and test the rules
62             #
63 0         0 for (my $ix=0; $ix < @{$array}; $ix++)
  0         0  
64             {
65 0         0 my $rule = $array->[$ix];
66              
67             ## make 'or' operator
68             #
69 0 0 0     0 if ($rule eq "|")
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
70             {
71 0         0 my $rc1 = pop(@rc);
72 0         0 my $rc2 = pop(@rc);
73 0         0 push(@rc,($rc1 | $rc2)+0);
74             }
75              
76             ## make 'and' operator
77             #
78             elsif ($rule eq "&")
79             {
80 0         0 my $rc1 = pop(@rc);
81 0         0 my $rc2 = pop(@rc);
82 0         0 push(@rc,($rc1 & $rc2)+0);
83             }
84              
85             ## parsing format val1 [operand] val2
86             #
87             elsif (($rule =~ /^(.*)\s+=\s+(.*)$/) || ($rule =~ /^(.*)\s+==\s+(.*)$/) || ($rule =~ /^(.*)\s+eq\s+(.*)$/i))
88             {
89 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"eq",$1,$2,@opts)+0) : push(@rc,($1 == $2)+0);
  0         0  
90             }
91             elsif (($rule =~ /^(.*)\s+!=\s+(.*)$/) || ($rule =~ /^(.*)\s+<>\s+(.*)$/) ||( $rule =~ /^(.*)\s+ne\s+(.*)$/i))
92             {
93 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"ne",$1,$2,@opts)+0) : push(@rc,($1 != $2)+0);
  0         0  
94             }
95             elsif (($rule =~ /^(.*)\s+>\s+(.*)$/) || ($rule =~ /^(.*)\s+gt\s+(.*)$/))
96             {
97 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"gt",$1,$2,@opts)+0) : push(@rc,($1 > $2)+0);
  0         0  
98             }
99             elsif (($rule =~ /^(.*)\s+<\s+(.*)$/) || ($rule =~ /^(.*)\s+lt\s+(.*)$/))
100             {
101 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"lt",$1,$2,@opts)+0) : push(@rc,($1 < $2)+0);
  0         0  
102             }
103             elsif (($rule =~ /^(.*)\s+>=\s+(.*)$/) || ($rule =~ /^(.*)\s+ge\s+(.*)$/))
104             {
105 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"ge",$1,$2,@opts)+0) : push(@rc,($1 >= $2)+0);
  0         0  
106             }
107             elsif (($rule =~ /^(.*)\s+<=\s+(.*)$/) || ($rule =~ /^(.*)\s+le\s+(.*)$/))
108             {
109 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"le",$1,$2,@opts)+0) : push(@rc,($1 <= $2)+0);
  0         0  
110             }
111              
112             ## use nom parsed format
113             #
114             else
115             {
116 0 0       0 ($is_code) ? push(@rc,&{$call}($rule,"*",0,0,@opts)+0) : push(@rc,1);
  0         0  
117             }
118             }
119 0         0 foreach my $rc(@rc)
120             {
121 0 0       0 next if ($rc);
122 0         0 return 0;
123             }
124 0         0 return 1;
125             }
126              
127             ###############################################################################
128             # convert polish to text format
129              
130             sub Postfix_to_Infix()
131             {
132 10     10 1 39 my $self = shift;
133 10         15 my $array = shift;
134 10         17 my @temp;
135            
136 10         14 for (my $ix=0; $ix < @{$array}; $ix++)
  52         100  
137             {
138 42         63 my $rule = $array->[$ix];
139 42 100       85 if ($rule eq "|")
    100          
140             {
141 7         11 my $st2 = pop(@temp);
142 7         13 my $st1 = pop(@temp);
143 7 100       13 ($ix+1 >= @{$array}) ? push(@temp,$st1." or ".$st2) : push(@temp,"(".$st1." or ".$st2.")");
  7         25  
144             }
145             elsif ($rule eq "&")
146             {
147 9         16 my $st2 = pop(@temp);
148 9         15 my $st1 = pop(@temp);
149 9         24 push(@temp,$st1." and ".$st2);
150             }
151             else
152             {
153 26         51 push(@temp,$rule);
154             }
155             }
156 10         38 for (my $ix=1; $ix<@temp; $ix++)
157             {
158 0         0 my $st2 = pop(@temp);
159 0         0 my $st1 = pop(@temp);
160 0         0 push(@temp,$st1." and ".$st2);
161             }
162 10         38 return $Math::Notation::PostfixInfix{unpolish} = join(" ",@temp);
163             }
164              
165             ##############################################################################
166             # convert text to polish format
167              
168             sub Infix_to_Postfix
169             {
170 10     10 1 5746 my $self = shift;
171 10         21 my $txt = shift;
172            
173 10         15 @{$Math::Notation::PostfixInfix{polish}} = ();
  10         28  
174 10         16 @{$Math::Notation::PostfixInfix{operand}{0}} = ();
  10         19  
175 10         21 $Math::Notation::PostfixInfix{square} = 0;
176              
177 10 50 33     129 if (($txt =~ /^(and|or|\&\&|\|\|)/) || ($txt =~ /^\s+(and|or|\&\&|\|\|)/) || ($txt =~ /(and|or|\&\&|\|\|)$/) || ($txt =~ /(and|or|\&\&|\|\|)\s+$/))
      33        
      33        
178             {
179 0         0 $! = "and/or at begin/end detected";
180             }
181 10         27 else {Math::Notation::PostfixInfix->_Parse($txt);}
182 10         15 return @{$Math::Notation::PostfixInfix{polish}};
  10         38  
183             }
184              
185             ##############################################################################
186             #
187              
188             sub _Parse()
189             {
190 10     10   17 my $self = shift;
191 10         18 my $txt = shift; $txt =~ s/^\s+|\s+$//g;
  10         52  
192              
193 10         26 $Math::Notation::PostfixInfix{text} = \$txt;
194              
195 10         15 my $tmp;
196 10         22 while ($txt)
197             {
198 48 100       119 if ($txt =~ /^\((.*)/) {Math::Notation::PostfixInfix->_ParseSquareNew(); $txt=$1;}
  1 100       4  
  1         3  
199 1         5 elsif ($txt =~ /^\)(.*)/) {Math::Notation::PostfixInfix->_ParseSquareEnd(); $txt=$1;}
  1         4  
200             else
201             {
202 46         170 my ($a1,$b1) = ($txt =~ /^(.*?)\s+(.*)$/);
203 46         98 my ($a2,$b2,$c2) = ($txt =~ /^(.*?)(\(\))(.*)$/);
204              
205 46 0 66     148 if ($a1 && $a2) { ($tmp,$txt) = (length($a1) < length($a2)) ? ($a1,$b1) : ($a2,"(".$b2.")".$c2); }
  0 50       0  
    50          
    100          
206 0         0 elsif ($b2) { ($tmp,$txt) = ($a2,"(".$b2.")".$c2); }
207 36         71 elsif ($b1) { ($tmp,$txt) = ($a1,$b1); }
208 10         31 else { ($tmp,$txt) = ($txt,""); }
209              
210 46 100       97 ($tmp,$txt) = ($1,")".$txt) if ($tmp =~ /(.*)\)$/);
211 46 100       121 if ($tmp =~ /(^and|^or|^\&\&|^\|\|)/)
212             {
213 16         34 Math::Notation::PostfixInfix->_ParseOperator($tmp);
214             }
215             else
216             {
217 30         62 Math::Notation::PostfixInfix->_ParseOperand($tmp);
218             }
219             }
220             }
221 10 50       32 if ($Math::Notation::PostfixInfix{square} > 0)
222             {
223 0         0 print STDERR "Square mismatch, too many open ($Math::Notation::PostfixInfix{square})\n";
224 0         0 exit(-1);
225             }
226 10         27 while ($Math::Notation::PostfixInfix{square} > -1)
227             {
228 10         16 while (@{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}})
  22         49  
229             {
230 12         21 $Math::Notation::PostfixInfix{last} = 1;
231 12         16 Math::Notation::PostfixInfix->_ParseOperand(pop(@{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}}));
  12         29  
232             }
233 10         31 $Math::Notation::PostfixInfix{square}--;
234             }
235             }
236              
237             ##############################################################################
238             #
239              
240             sub _ParseOperator()
241             {
242 16     16   25 my $self = shift;
243 16         24 my $oper = shift;
244              
245 16 100       68 if ($oper =~ /^and$/i) { $oper = "&"; }
  8 100       12  
    100          
    50          
246 1         12 elsif ($oper =~ /^\&\&$/i) { $oper = "&"; }
247 6         11 elsif ($oper =~ /^or$/i) { $oper = "|"; }
248 1         3 elsif ($oper =~ /^\|\|$/i) { $oper = "|"; }
249              
250 16         24 my $no = @{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}};
  16         36  
251 16 100 100     60 if ($no && $Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}->[$no-1] eq "&")
252             {
253 3         6 $Math::Notation::PostfixInfix{last} = 1;
254 3         5 Math::Notation::PostfixInfix->_ParseOperand(pop(@{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}}));
  3         7  
255             }
256 16         23 push(@{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}},$oper);
  16         31  
257 16         44 $Math::Notation::PostfixInfix{last} = 1;
258             }
259              
260             ##############################################################################
261             #
262              
263             sub _ParseOperand()
264             {
265 46     46   67 my $self = shift;
266 46         71 my $info = shift;
267              
268 46 100 100     97 if ($Math::Notation::PostfixInfix{last} || @{$Math::Notation::PostfixInfix{polish}} == 0)
  14         39  
269             {
270 42         59 push(@{$Math::Notation::PostfixInfix{polish}},$info);
  42         123  
271 42         100 $Math::Notation::PostfixInfix{last} = 0;
272             }
273 4         8 else { $Math::Notation::PostfixInfix{polish}->[@{$Math::Notation::PostfixInfix{polish}}-1] .= " ".$info; }
  4         15  
274              
275             }
276              
277             ##############################################################################
278             #
279              
280             sub _ParseSquareNew()
281             {
282 1     1   3 my $self = shift;
283              
284 1         3 $Math::Notation::PostfixInfix{square}++;
285 1         3 @{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}} = ();
  1         4  
286             }
287              
288             ##############################################################################
289             #
290              
291             sub _ParseSquareEnd()
292             {
293 1     1   3 my $self = shift;
294              
295 1         2 $Math::Notation::PostfixInfix{last} = 1;
296 1         2 Math::Notation::PostfixInfix->_ParseOperand(pop(@{$Math::Notation::PostfixInfix{operand}{$Math::Notation::PostfixInfix{square}}}));
  1         16  
297 1         2 $Math::Notation::PostfixInfix{square}--;
298 1 50       4 if ($Math::Notation::PostfixInfix{square} < 0)
299             {
300 0           print STDERR "Square mismatch, too many close\n";
301 0           exit(-1);
302             }
303             }
304              
305             __END__