laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days (January 12, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Challenge # 1: Octal Number System

Write a script to print decimal number 0 to 50 in Octal Number System.

For example:

Decimal 0 = Octal 0
Decimal 1 = Octal 1
Decimal 2 = Octal 2
[ ... ]

For this task, I’ll start with Raku, because it is so easy in Raku.

Octal Number System in Raku

Raku has a base method to convert a number into a string representation in any base between 2 and 36.

With this, it is so easy that we can use a one-liner:

$ perl6 -e 'say "Decimal: $_ \t=  Octal ", .base(8) for 0..50;'
Decimal: 0      =  Octal 0
Decimal: 1      =  Octal 1
Decimal: 2      =  Octal 2
Decimal: 3      =  Octal 3
Decimal: 4      =  Octal 4
Decimal: 5      =  Octal 5
Decimal: 6      =  Octal 6
Decimal: 7      =  Octal 7
Decimal: 8      =  Octal 10
Decimal: 9      =  Octal 11
[ ... Lines omitted for brevity ... ]
Decimal: 45     =  Octal 55
Decimal: 46     =  Octal 56
Decimal: 47     =  Octal 57
Decimal: 48     =  Octal 60
Decimal: 49     =  Octal 61
Decimal: 50     =  Octal 62

Octal Number System in Perl 5

Perl 5’s sprintf and printf functions actually offers the same possibility for octal and hexadecimal representations (bases 8 and 16), so that we can also do it with a one-liner:

$ perl -e 'printf "Decimal: %2d  =  Octal %2o \n", $_, $_ for 0..50;'
Decimal:  0  =  Octal  0
Decimal:  1  =  Octal  1
Decimal:  2  =  Octal  2
Decimal:  3  =  Octal  3
Decimal:  4  =  Octal  4
Decimal:  5  =  Octal  5
Decimal:  6  =  Octal  6
Decimal:  7  =  Octal  7
Decimal:  8  =  Octal 10
Decimal:  9  =  Octal 11
Decimal: 10  =  Octal 12
[ ... Lines omitted for brevity ... ]
Decimal: 45  =  Octal 55
Decimal: 46  =  Octal 56
Decimal: 47  =  Octal 57
Decimal: 48  =  Octal 60
Decimal: 49  =  Octal 61
Decimal: 50  =  Octal 62

Challenge # 2: Balanced Brackets

Write a script to generate a string with random number of ( and ) brackets. Then make the script validate the string if it has balanced brackets.

For example:

() - OK
(()) - OK
)( - NOT OK
())() - NOT OK

Well, I have a slight problem with this task requirement. A script generating a random number of random brackets will almost never generate balanced brackets, except when the maximal number of brackets is really small (say 2 or 4). So, I changed the task to writing a script that checks that strings passed to it have properly balanced parentheses.

Balanced Parentheses in Raku

Balanced Parentheses Using a Grammar

I admit that this may be slight technological overkill, but seeing such a task leads me immediately to use grammars, which are naturally capable to manage such tasks, since their rules can easily be called recursively to parse any number of nested parentheses. So, this is my first solution:

use v6;

grammar Parens {
    token TOP { \s* <paren-expr>+ \s* }
    token paren-expr { | \s* <paren-pair> \s*
                       | '(' \s* <paren-expr>+ \s* ')' }
    token paren-pair { [ '(' \s* ')' ]+ }
}

for "()", "(  )", "(())", "( ( ))", ")(", "())()", 
    "((( ( ()))))",  "()()()()", "(())(())" -> $expr {
    say "$expr - ", Parens.parse($expr) ?? "OK" !! "NOT OK";
}

The TOP token is any strictly positive number of paren-expr. A paren-expr is either a paren-pair or an opening parenthesis, followed by, recursively, another paren-expr, followed by a closing parenthesis. Note that this could most probably have been made simpler (only two tokens instead of three) if we had decided to remove all spaces of the string before parsing.

This script displays the following output:

$ perl6 parens.p6
() - OK
(  ) - OK
(()) - OK
( ( )) - OK
)( - NOT OK
())() - NOT OK
((( ( ())))) - OK
()()()() - OK
(())(()) - OK

Balanced Parentheses Using a Stack

As I said, using grammars for such a simple task might be considered over-engineering. We had recently a challenge about reverse Polish notation that led us to use a stack. Recursion and stacks are intimately related. We could use a stack to perform the same task: push to the stack if we get a (, and pop from the stack if we get a ), unless the stack is empty; and, at the end, check that the stack is empty. Some people might think that this approach is conceptually simpler than a grammar. But I tend to think this is wrong. Except for a small typo, my grammar approach worked the first time I tested it. Not only is the stack code below significantly longer, but I had to debug the stack approach below for about 15 minutes before it got right:

use v6;

sub check-parens (Str $expr) {
    my @stack;
    my $s = $expr;
    $s ~~ s:g/\s+//; # remove spaces;
    for $s.comb {
        when '(' { push @stack, $_; }
        when ')' {
            say "$expr: NOT OK" and return unless @stack;
            pop @stack;
        }
        default { say $s }
    }
    say "$expr: ", @stack.elems ?? "NOT OK" !! "OK";
}
for "()", "(  )", "(())", "( ( ))", ")(", "())()", 
    "((( ( ()))))",  "()()()()", "(())(())" {
        check-parens($_)
}

This is the output:

$ perl6 parens.p6
(): OK
(  ): OK
(()): OK
( ( )): OK
)(: NOT OK
())(): NOT OK
((( ( ())))): OK
()()()(): OK
(())(()): OK

In fact, we don’t really need a stack, as we will see in the Perl 5 implementation below.

Balanced Parentheses in Perl 5

We could in principle use one of the code parser available in Perl 5 modules. But while grammars are fully integrated into Raku, they are less easy to use in Perl 5. You usually have to generate an intermediate file and then use it for parsing the input. It can be done, but that looks a bit complicated for our case.

Stack Solution in Perl 5

We can port our stack solution to Perl 5:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

sub check_parens {
    my $expr = shift;
    my @stack;
    $expr =~ s/\s+//g; # remove spaces
    for (split //, $expr) {
        push @stack, $_ if $_ eq '(';
        if ($_ eq ')') {
            return 0 if @stack == 0;
            pop @stack;
        }
    }
    return scalar @stack == 0 ? 1 : 0;
}

for ("()", "(  )", "(())", "( ( ))", ")(", "())()", 
    "((( ( ()))))",  "()()()()", "(())(())") {
        say "$_: ", check_parens($_) ? "OK" : "Not OK";
}

This program displays the following output:

$ perl  parens.pl
(): OK
(  ): OK
(()): OK
( ( )): OK
)(: Not OK
())(): Not OK
((( ( ())))): OK
()()()(): OK
(())(()): OK

Using a Counter

Actually, we don’t really need a stack. We can use a simple counter starting at 0, which we increment when we get an opening parenthesis, and decrement when we get a closing parenthesis. If we get a closing parenthesis when the counter is 0, or if the counter is not 0 at the end of the parsing, then the parentheses are not properly balanced.

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

sub check_parens {
    my $expr = shift;
    $expr =~ s/\s+//g; # remove spaces
    my $count = 0;
    for (split //, $expr) {
        $count++ if $_ eq '(';
        if ($_ eq ')') {
            return 0 if $count == 0;
            $count--;
        }
    }
    return $count == 0 ? 1 : 0;
}

for ("()", "(  )", "(())", "( ( ))", ")(", "())()", 
    "((( ( ()))))",  "()()()()", "(())(())") {
        say "$_: ", check_parens($_) ? "OK" : "Not OK";
}

This produces the same output as before.

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before the deadline for the week. And, please, also spread the word about the Perl Weekly Challenge if you can.