planet.donarmstrong.com

These are some answers to the Week 143 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 19, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Calculator

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

Calculator in Raku

This is a perfect case where we could showcase the use of grammars in Raku. However, we have a much simpler solution: the EVAL routine will evaluate (i.e. compile and execute) an input string as a piece of Raku code and return the result. So we will use here this simpler solution (but will provide below an example of implementation with a grammar). There is, however, a big caveat: the EVAL routine is dangerous because its input string may contain malicious code. For that reason, you need to use the MONKEY-SEE-NO-EVAL pragma. If we try to use EVAL without turning on first the MONKEY-SEE-NO-EVAL (or MONKEY) pragma, we get the following error message:

EVAL is a very dangerous function!!! (use the MONKEY-SEE-NO-EVAL pragma to override this error but only if you’re VERY sure your data contains no injection attacks).

The EVAL routine is particularly dangerous if its input string comes from outside the program (for example as an input parameter, user input, or input file). A typical example would be a malicious user entering a string calling the operating system to execute a shell command such as rm -rf /* (don’t try this command), which may wipe out the entire file system (at least if you have root privileges). In our case, the strings to be EVALed come from within our program, so, assuming we know what we’re doing, we can be reasonably confident that nothing bad should happen. However, to make our calc subroutine completely innocuous, we use a regular expression to detect and reject any input string which doesn’t consist only of digits, spaces, arithmetic operators + - *, and parentheses.

use v6;
use MONKEY-SEE-NO-EVAL;

sub calc (Str $expr) {
    return "Not a valid arithmetic expression" unless 
        $expr ~~ /^<[-\d \s +*()]>+$/;
    return EVAL $expr;
}
for "10 + 20 - 5", "(10 + 20 - 5) * 2", "7 + a", "6 * 7" -> $test {
    say calc $test;
}

This program displays the following output:

$ raku ./calculator.raku
25
50
Not a valid arithmetic expression
42

Calculator in Perl

In Perl, we will use the eval built-in subroutine, in a way that is similar to the use of EVAL in the Raku solution above. The Perl eval has similar risks: it is dangerous because its input string may contain malicious code. This is particularly risky if the input string comes from outside the program (input parameter, user input, input file, etc.). In our case, the string to be evaled are hard-coded in our program so that the risk is reasonably small if we know what we’re doing. However, to make our calc subroutine completely innocuous, we use a regular expression to detect and reject any input string which doesn’t consist only of digits, spaces, arithmetic operators (+ - *), and parentheses.

use strict;
use warnings;
use feature "say";

sub calc {
    my $expr = shift;
    return "Not a valid arithmetic expression" unless 
        $expr =~ /^[-\d\s+*()]+$/;
    return eval $expr;
}
for my $test ("10 + 20 - 5", "(10 + 20 - 5) * 2", "7 + a", "6 * 7") {
    say calc $test;
}

This program displays the following output:

$ perl ./calculator.pl
25
50
Not a valid arithmetic expression
42

Task 2: Stealthy Number

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

I had never heard before about stealthy numbers, but the description provided is pretty clear.

Stealthy Number in Raku

We basically need to find all divisors of the input number and look at every combination of them to see if it matches the specified criteria.

After having generated all divisors of the input number (in the @divisors array), I thought about using the combinations method to generate all pairs of divisors. But that doesn’t work properly for perfect squares because the square root of the input number appears only once in the divisors list, and therefore cannot be used twice in the same pair of divisor. For example, if the input integer is 36, we would need to have (6, 6) in the list of divisor pairs. The combinations method cannot do that (unless we manually add a second instance of 6 in the divisor list. Rather than adding code for handling such edge case, I found it easier to use the X cross product operator between the @divisors array and itself and to filter out all those pairs of divisors whose product is not equal to the input integer. The result of this operation goes into the @div-pairs array.

Then, we can use the combinations method to generate pairs of pairs and check wheter they satisfy the second condition (a + b = c + d + 1). Since (a, b) and (c, d) are interchangeable, we actually check whether a + b - c - d is equal to either 1 or -1 (we do it here with a junction because it’s fun, but we could also compare the absolute value of that expression with 1, as we do below in our Perl implementation).

use v6;

sub stealthy-nums (UInt $n) {
    my @divisors = grep {$n %% $_}, 1..$n;
    my @div-pairs = grep { $_[0] * $_[1] == $n }, (@divisors X @divisors);
    # say @div-pairs;
    for @div-pairs.combinations: 2 -> $c {
        return $c if $c[0][0] + $c[0][1] - $c[1][0] - $c[1][1] == any(1, -1)
    }
    return False
}

for <36 12 6> -> $test {
    my $result = stealthy-nums $test;
    say "$test \t", 
    $result ?? "1 -> $result" !! 0;
}

This script display the following output:

$ raku ./stealthy-numbers.raku
36  1 -> 4 9 6 6
12  1 -> 2 6 3 4
6   0

I thought it would interesting to find more stealthy numbers. So I changed the final for block to this:

for (1..100) -> $test {
    my $result = stealthy-nums $test;
    say "$test \t $result" if $result;
}

and found 8 stealthy numbers below 100:

raku ./main.raku
4    1 4 2 2
12   2 6 3 4
24   3 8 4 6
36   4 9 6 6
40   4 10 5 8
60   5 12 6 10
72   6 12 8 9
84   6 14 7 12

Increasing the range to 1..1000, we find that there are 39 stealthy numbers below 1000, and that they are all even. And, by the way, there are 2851 stealthy integers below 1,000,000.

Stealthy Number in Perl

The Perl solution is essentially a port of the Raku solution, except that I had to write my own simple cross subroutine, since the cross product operator doesn’t exist in Perl.

use strict;
use warnings;
use feature "say";

sub cross {
    my @nums = @_;
    my @num_pairs;
    for my $i (@nums) {
        for my $j (@nums) {
            next if $j > $i; # filter out duplicates such as [12, 3] and [3, 12]
            push @num_pairs, [$i, $j];
        }
    }
    return @num_pairs;
}

sub stealthy_nums  {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..$n;
    my @div_pairs = grep { $_->[0] * $_->[1] == $n } cross @divisors;
    for my $c (@div_pairs) {
        for my $d (@div_pairs) {
            return "@$c and @$d" if abs($c->[0] + $c->[1] - $d->[0] - $d->[1]) == 1;
        }
    }
    return 0;
}

for my $test (qw <36 12 6>) {
    my $result = stealthy_nums $test;
    say "$test \t", 
    $result ? "1 -> $result" : 0;
}

This program displays the following output:

$ perl stealthy-numbers.pl
36      1 -> 6 6 and 9 4
12      1 -> 4 3 and 6 2
6       0

A Raku Grammar for a Calculator

For implementing a calculator in Raku, we used the built-in EVAL routine, as this a a very simple solution. I can’t resist, however, to the desire and fun of presenting a full-fledged Raku grammar. This is derived in large part from a solution to the exercises that I provided in my Raku book.

The Calculator Grammar

Here’s one way to write the grammar itself:

my grammar Calculator {
    rule TOP            { <expr> }
    rule expr           { <term> + % <plus-minus-op> }
    token plus-minus-op { [< + - >] }
    rule term           { <atom> + % <mult-div-op> }
    token mult-div-op   { [< * / >] }
    rule atom {
        | <num> { make +$<num> }
        | <paren-expr> { make $<paren-expr>.made}
    }
    rule num            { <sign> ? [\d+ | \d+\.\d+ | \.\d+ ] }
    rule paren-expr     { '(' <expr> ')' }
    token sign          { [< + - >] }
}

This solution is quite simple.

An expression (expr) is made of one or several terms separated by + or - operators. A term is made of one or several atoms separated by * or / operators. An atom may be a bare number or a parenthesized expression.

This guarantees that precedence rules are satisfied. Multiplications and divisions will be evaluated before additions and subtractions, since, when parsing an expression, you need to evaluate the individual terms before you can complete the expression evaluation. Similarly, since a parenthesized expression is an atom, it will have to be evaluated before the term in which it appears can be fully evaluated. Note that, in the case of a parenthesized expression, the expr rule is called recursively.

The Actions Class

Notice that we have included two actions in the grammar (in the atom rule). One reason was for convenience: since the atom rule covers two very different named sub-rules, it is a bit easier to include the action just in the context of the sub-rules. If an action had been attached to the atom rule, it would have required finding out which sub-rule had been matched to know which action to perform. Nothing difficult, but doing so would have made the code slightly more complex. The other reason was for pedagogical purposes: although it often makes sense to create an actions class, it is useful to know that actions may be inserted in the grammar part. For a very simple grammar, it might be over-engineering to create an actions class with just one or two actions.

The actions class might look like this:

class CalcActions {
    method TOP ($/) {
        make $<expr>.made
    }
    method expr ($/) {
        $.calculate($/, $<term>, $<plus-minus-op>)
    }
    method term ($/) {
        $.calculate($/, $<atom>, $<mult-div-op>)
    }
    method paren-expr ($/) {
         make $<expr>.made;
    }
    method calculate ($/, $operands, $operators) {
        my $result = (shift $operands).made;
        while my $op = shift $operators {
            my $num = (shift $operands).made;
            given $op {
                when '+' { $result += $num; }
                when '-' { $result -= $num; }
                when '*' { $result *= $num; }
                when '/' { $result /= $num; }
                default  { die "unknown operator "}
            }
        }
        make $result;
    }
}

The calculate method computes expressions (terms separated by addition or subtraction operators) and terms atoms separated by multiplication or division operators) from left to right, since these operators are left associative.

Testing the Grammar and Actions Class

This grammar for a calculator and its associated actions class may be unit tested with the following code:

for |< 3*4 5/6 3+5 74-32 5+7/3 5*3*2 (4*5) (3*2)+5 4+3-1/5 4+(3-1)/4 >,
    "12 + 6 * 5", " 7 + 12 + 23", " 2 + (10 * 4) ", "3 * (7 + 7)" { 
    my $result = Calculator.parse($_, :actions(CalcActions));
    # say $result;
    printf "%-15s %.3f\n", $/,  $result.made if $result;
}

which will display the following results:

3*4             12.000
5/6             0.833
3+5             8.000
74-32           42.000
5+7/3           7.333
5*3*2           30.000
(4*5)           20.000
(3*2)+5         11.000
4+3-1/5         6.800
4+(3-1)/4       4.500
12 + 6 * 5      42.000
 7 + 12 + 23    42.000
 2 + (10 * 4)   42.000
3 * (7 + 7)     42.000

So, these limited tests yield the desired results.

You might wonder whether this code works correctly with nested parenthesized expressions. I originally thought, when I wrote this code, that it might malfunction and that I might have to change or add something to get nested parenthesized expressions right and properly balanced. It turns out that it works fine out of the box. For example, consider the following test code with relatively deeply nested parenthesized expressions:

for "(((2+3)*(5-2))-1)*3", "2 * ((4-1)*((3*7) - (5+2)))"  { 
    my $result = Calculator.parse($_, :actions(CalcActions));
    printf "%-30s %.3f\n", $/,  $result.made if $result;
}

The result is correct:

(((2+3)*(5-2))-1)*3            42.000
2 * ((4-1)*((3*7) - (5+2)))    84.000

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 26, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.