Perl Weekly Challenge 143.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 143.
Task 1: Calculator
Submitted by: Mohammad S Anwar
You are given a string, $s, containing mathematical
expression.
Write a script to print the result of the mathematical
expression. To keep it simple, please only accept + - * ().
Example 1:
Input: $s = "10 + 20 - 5"
Output: 25
Example 2:
Input: $s = "(10 + 20 - 5) * 2"
Output: 50
The minimal calculator would let Perl do all the work.
perl -E 'say "$_=", eval $_ foreach(@ARGV)' \
"10+20-5" "(10+20-5)*2" "1+2" "2*3" "1+2*3" "(1+2)*3"
Results:
10+20-5=25
(10+20-5)*2=50
1+2=3
2*3=6
1+2*3=7
(1+2)*3=9
Though it feels like cheating.
I guess the simplest solution is to parse a simple grammar: as
e->t|e+t|e-t, t->s|t*s|t/s, s->n|-s|+s|(e) with e=expression,
t=term, s=simple term, n=number and | separating alternatives. The problem with
subtraction and division
is that its meaning changes if you associate left to right or
right to left. The parser is simpler if the latter case, but
the usual interpretation is the former. Thus, I loop over +-
and over */ operators instead of recursing. I did add the
division ‘/’ and the unary ‘+-‘ operators. I read-ahead one
token and save it in the variable $token, a two element array;
it’s first element is the kind of token and the second the
value. This is useful for numbers, of type ‘N’. Other
tokens have type=value. I keep the yet unparsed string in
$current, and the previous unparsed string in $previous,
for issuing error messages. I use try{}/catch{} to abort
the current evaluation in case of errors, but continue with
the remaining ones.
1 # Perl weekly challenge 143
2 # Task 1: calculator
3 #
4 # See https://wlmb.github.io/2021/12/13/PWC143/#task-1-calculator
5 use v5.12;
6 use warnings;
7 use Scalar::Util qw(looks_like_number);
8 use Try::Tiny;
9 my $original_string;
10 my $previous;
11 my $current;
12 my $token;
13 foreach (@ARGV){
14 try {
15 $original_string=$previous=$current=$_;
16 token();
17 my $result=expression();
18 die "Extra characters: $previous\n" if defined $token->[0];
19 say "$original_string=$result";
20 }
21 catch {
22 warn $_;
23 };
24 }
25
26 sub token {
27 $previous=$current;
28 $token=[$1,$1], return if $current=~s{^\s*([()*/+-])}{}; # symbol
29 $token=['N',$1], return
30 if $current=~s{^\s*([^()*/+\-\t\n ]*)}{}
31 and looks_like_number($1); # number?
32 $token=[undef,undef], return if $current=~/^\s*$/; # nothing
33 die "Unrecognizable input: $previous\n";
34 }
35
36 sub expression {
37 my $result=term();
38 while(1){
39 my $op=$token->[0];
40 last unless defined $op && $op=~m{[+-]};
41 token();
42 $result+=term(),next if $op eq '+';
43 $result-=term(),next if $op eq '-';
44 }
45 return $result;
46 }
47
48 sub term {
49 my $result=simple();
50 while(1){
51 my $op=$token->[0];
52 last unless defined $op && $op=~m{[*/]};
53 token();
54 $result*=simple(),next if $op eq '*';
55 $result/=simple(),next if $op eq '/';
56 }
57 return $result;
58 }
59 sub simple {
60 my $op=$token->[0];
61 my $val=$token->[1];
62 die "Unrecognized expression: $previous\n" unless defined $op && $op=~/[-+(N]/;
63 token();
64 return -simple() if $op eq '-'; # unary -
65 return simple() if $op eq '+'; # unary +
66 return $val if $op eq 'N'; # number
67 my $result=expression(); # parenthesized expression
68 $op=$token->[0]; # closing parenthesis should follow
69 die "Unbalanced parenthesis: $previous\n" unless defined $op and $op eq ')';
70 token();
71 return $result;
72 }
73
Examples:
./ch-1.pl "10 + 20 - 5" "(10 + 20 - 5) * 2"
Results:
10 + 20 - 5=25
(10 + 20 - 5) * 2=50
Other examples:
./ch-1.pl "-2*-3" "8/2/2/2"
Results:
-2*-3=6
8/2/2/2=1
Task 2: Stealthy Number
Submitted by: Mohammad S Anwar
You are given a positive number, $n.
Write a script to find out if the given number is Stealthy
Number.
A positive integer N is stealthy, if there exist positive
integers a, b, c, d such that a * b = c * d = N and a + b =
c + d + 1.
Example 1
Input: $n = 36
Output: 1
Since 36 = 4 (a) * 9 (b) = 6 (c) * 6 (d) and 4 (a) + 9 (b) = 6
(c) + 6 (d) + 1.
Example 2
Input: $n = 12
Output: 1
Since 2 * 6 = 3 * 4 and 2 + 6 = 3 + 4 + 1
Example 3
Input: $n = 6
Output: 0
Since 2 * 3 = 1 * 6 but 2 + 3 != 1 + 6 + 1
A short solution to problem may be obtained using PDL.
perl -MPDL -MPDL::NiceSlice -E 'foreach(@ARGV){$Q=sqrt($_);
$d=(sequence($Q)+1); $d=$d->where($_%$d==0);$d2=$d->cat($d(*));
say "In: $_ Out: ", any($d+$_/$d==($d+$_/$d+1)->(*));}' 36 12 6
Results:
In: 36 Out: 1
In: 12 Out: 1
In: 6 Out: 0
It’ll be easier to explain the code after the unrolled version.
1 # Perl weekly challenge 143
2 # Task 1: Stealthy number
3 #
4 # See https://wlmb.github.io/2021/12/13/PWC143/#task-2-stealthy-number
5 use v5.12;
6 use warnings;
7 use PDL;
8 use PDL::NiceSlice;
9 foreach my $N(@ARGV){
10 my $Q=sqrt($N); # largest possible small divisor
11 my $s=(sequence($Q)+1);
12 my $d=$s->where($N % $s == 0); # list of divisors<=$Q
13 my $c=$d->cat($d(*)); # cartesian product of divisors
14 my $mask=$d+$N/$d==($d+$N/$d+1)->(*);
15 # Get pairs of divisors that obey the stealthy condition
16 my $d2=$c->whereND(($d+$N/$d)==($d+$N/$d+1)->(*));
17 my $out=$d2->nelem?1:0;
18 say "\nInput: $N Output: ", $out;
19 say "since ", $_((0)),"+",$N/$_((0)),
20 "==",$_((1)),"+",$N/$_((1)),"+1"
21 foreach $d2->transpose->dog;
22 }
23
./ch-2.pl 36 12 6
Results:
Input: 36 Output: 1
since 4+9==6+6+1
Input: 12 Output: 1
since 2+6==3+4+1
Input: 6 Output: 0
Taking for example the case $N=36, line 11 produces the sequence
[1,2,3,4,5,6], while line 12 selects those numbers that divide
36, [1,2,3,4,6]. Line 13 takes the cartesian product of this
set with itself, adding a dummy first dimension to the
second replica, yielding the 3D array $c,
[
[
[1 2 3 4 6]
[1 2 3 4 6]
[1 2 3 4 6]
[1 2 3 4 6]
[1 2 3 4 6]
]
[
[1 1 1 1 1]
[2 2 2 2 2]
[3 3 3 3 3]
[4 4 4 4 4]
[6 6 6 6 6]
]
]
i.e., two data planes, so that if I fix a row and a column I
get a 2-element vector (a,c) containing two divisors. For
example $c(3,4) is the pair [4,6].
If $d≤$Q is a list of divisors, then $N/$d≥$Q is
the list of complementary divisors. Therefore, line 14
produces a mask like
[
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 1 0]
]
which has a 1 corresponding to
those pair positions in $c whose divisors and complementary
divisors obey the stealthy number condition a+b=c+d+1. In
our example, a=4 (b=9) and c=6 (d=6). Thus, in line 16 we select
from all the pairs of divisors, those that obey the condition.
In our example there is only one pair
[
[4]
[6]
]
Finally, the output is 0 if no pair was found, and 1 if one or
more pairs were found. If the number is stealthy, in line 21 I
get a list of divisor pairs (dog is the opposite of cat)
with which to explains the result.