# 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
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.

Written on December 13, 2021