File Coverage

blib/lib/Math/Notation/PostfixInfix.pm
Criterion Covered Total %
statement 100 150 66.6
branch 32 74 43.2
condition 11 44 25.0
subroutine 10 12 83.3
pod 3 4 75.0
total 156 284 54.9


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