May 2021 Archives

Perl Weekly Challenge 114: Next Palindrome Number and Higher Integer Set Bits

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

Spoiler Alert: This weekly challenge deadline is due in a few days (May 30, 2021). 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: Next Palindrome Number

You are given a positive integer $N.

Write a script to find out the next Palindrome Number higher than the given integer $N.

Example:

Input: $N = 1234
Output: 1331

Input: $N = 999
Output: 1001

Next Palindrome Number in Raku

In theory, we could build directly the next palindrome number from the current one. But there are different situations to cover, depending for example on whether the input number has an odd or even number of digits. Also, there are various edge cases. It is not so easy to be sure you’ve covered all possible cases. The alternative is to check each number in ascending order until you get a match. This brute force approach is much easier and in fact quite efficient for small and moderately large input numbers, as it is in most cases quite fast to find a palindrome larger than a given input number. We’ll use this second approach. We assume here that the input is a correct integer.

use v6;

my $input = @*ARGS[0] // 1234;
for $input .. Inf -> $candidate {
    next unless $candidate eq $candidate.flip;
    say $candidate;
    last;
}

This program displays the following output:

$ raku ./palin.raku
1331
$ raku ./palin.raku 3445
3553

Next Palindrome Number in Perl

We use the same algorithm, except that we use a while loop instead of a for because it is not possible to define an infinite range in Perl.

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

my $num = shift // 1234;
$num =~ s/^0+//; # remove leading 0s just in case
while (++ $num) {
    say $num and last if $num eq reverse $num;
}

This program displays the following output:

$ perl palin.pl
1331

$ perl palin.pl 3554
3663

$ perl palin.pl 075
77

Next Palindrome in Scala

Scala doesn’t have a last or break statement (there is a break method, but it is not very practical). So we will use a while loop with an explicit value incrementation.

object palindrome extends App {
  var num = 1234
  var found = 0
  while (found == 0) {
    if (num.toString == num.toString.reverse) {
      println(num)
      found = 1
    }
    num += 1
  }
}

This program duly prints 1331.

Next Palindrome in Python

import sys

num = int(sys.argv[1])
while (1):
    if str(num) == str(num)[::-1]:
        print(num)
        break
    num += 1

Output:

$ python3 palin.py 1234
1331

Task 2: Higher Integer Set Bits

You are given a positive integer $N.

Write a script to find the next higher integer having the same number of 1 bits in binary representation as $N.

Example:

Input: $N = 3
Output: 5

Binary representation of $N is 011. There are two 1 bits. So the next higher integer is 5 having the same the number of 1 bits i.e. 101.

Input: $N = 12
Output: 17

Binary representation of $N is 1100. There are two 1 bits. 
So the next higher integer is 17 having the same number of 1 bits i.e. 10001.

It is easy to show that we can always find one such number with the same number of bits set to 1 for any strictly positive integer (you can just add a 1 at the front of the binary representation of the number and set any other 1 bit to 0, but that of course does not necessarily yields the next higher integer).

Higher Integer Set Bits in Raku

To count the number of 1 bits, we just add all digits of the binary representation of the input number (in the number_of_1 subroutine). Then we just test all successive numbers larger than the input number until we find one that has the same number of bits set to 1.

use v6;

sub number_of_1 (Int $in) {
    my $count = [+] $in.base(2).comb;
}

my $input = @*ARGS[0] // 3;
my $target = number_of_1 $input.Int;
for $input ^.. Inf -> $candidate {
    next unless $candidate.Int.&number_of_1 == $target;
    say $candidate;
    last;
}

This program displays the following output for a few input values:

$ raku ./nextbin.raku 5

$ raku ./nextbin.raku 12 17

$ raku ./nextbin.raku 123 125

Higher Integer Set Bits in Perl

This is essentially a port to Perl of the above Raku program with just a couple of changes: we use a loop to count the bits set to 1 and we use a while loop instead of a for loop

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

sub number_of_1 {
    my $in = shift;
    my $count = 0;
    $count += $_ for split //, sprintf "%b", $in;
    return $count;
}

my $num = shift // 3;
my $target = number_of_1 $num;
while (++ $num) {
    say $num and last if $target == number_of_1 $num;
}

This program displays the following output for a few input values:

$ perl nextbin.pl
5

$ perl nextbin.pl 111
119

$ perl nextbin.pl 256
512

Higher Integer Set Bits in Scala

object nextbin extends App {

  def number_of_1(in: Int): Int = {
    val binlist = in.toBinaryString.toList
    var count = 0
    for (char <- binlist) {
      if (char == '1') count += 1
    }
    return count
  }
  var num = 111
  val target = number_of_1(num)
  var found = 0
  while (found == 0) {
    num += 1
    if (number_of_1(num) == target) {
      println(num)
      found = 1
    }
  }
}

This program duly prints 119.

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 Sunday, June 6, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 113: Represent Integer and Recreate Binary Tree

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

Task 1: Represent Integer

You are given a positive integer $N and a digit $D.

Write a script to check if $N can be represented as a sum of positive integers having $D at least once. If check passes print 1 otherwise 0.

Example:

Input: $N = 25, $D = 7
Output: 0 as there are 2 numbers between 1 and 25 having the digit 7 i.e. 7 and 17. If we add up both we don't get 25.

Input: $N = 24, $D = 7
Output: 1

I’m very late and have very little time this week, so I’ll implement this task only in Raku.

Represent Integer in Raku

This script first populates the @candidates array with numbers between 1 and the input positive integer where the target digit is present. It then uses the combinations built-in routine to generate all combinations of the numbers in @candidates and checks whether the sum of the number in the combination is equal to the input positive integer.

use v6;

sub sum-int (Int $num, Int $digit where 1 <= $digit <= 9) {
    my @candidates = grep { /$digit/ }, 1..$num;
    for @candidates.combinations -> $comb {
        if $num == [+] $comb {
            # say $comb;
            return 1;
        }
    }
    return 0;
}
for 1..30 -> $test {
    say "$test: ", sum-int $test, 7;
}

The script performs the test for all numbers between 1 and 30 with a targhet digit of 7:

$ raku sum-int.raku
1: 0
2: 0
3: 0
4: 0
5: 0
6: 0
7: 1
8: 0
9: 0
10: 0
11: 0
12: 0
13: 0
14: 0
15: 0
16: 0
17: 1
18: 0
19: 0
20: 0
21: 0
22: 0
23: 0
24: 1
25: 0
26: 0
27: 1
28: 0
29: 0
30: 0

Task 2: Recreate Binary Tree

You are given a Binary Tree.

Write a script to replace each node of the tree with the sum of all the remaining nodes.

Example:

Input Binary Tree

        1
       / \
      2   3
     /   / \
    4   5   6
     \
      7

Output Binary Tree

        27
       /  \
      26  25
     /   /  \
    24  23  22
     \
     21

Binary trees can be stored in breadth-first order as an array with an implicit data structure. This is similar to what is commonly done for binary heaps (i.e. a binary tree that keeps a partial order). Here, we’re not interested with partial order, but the idea is to use an array with the following properties. The item with subscript 0 is the value of the root node. The index of an element is used to compute the index of its parent and the indices of its children. The basic idea is that, for any node, the index of its parent is about half the index of the current node, and, conversely, the indices of the children are about twice the index of the current node. More precisely, for a tree starting at index 0, the exact formulas for a node with index $n are commonly as follows:

  • parent: int( ($n-1)/2 )
  • left child: 2*$n + 1
  • right child: 2*$n + 2

The root node is at index 0, and its children are at positions 1 and 2. The children of item with index 1 are at positions 3 and 4 and the children of 2 are at positions 5 and 6.

These rules may seem a bit complicated (and it is a bit tedious to compute these things manually), but they’re in fact quite easy to implement in a program. For example, in Perl:

sub children { my $i = shift; 2*$i + 1, 2*$i + 2 }
sub parent { my $i = shift; ($i-1) / 2; }

These children and parent subroutines are provided here for the purpose of completeness, they are not needed in our program.

Note that it is very easy to populate the binary-heap-like array from a graphical representation: you just need to perform a breadth-first traversal (and provide empty slots for missing nodes if any, but we will only be dealing with full binary trees for the sake of simplification). For example, this binary tree:

    1
   /  \
  2    3
 / \  / \
4   5 6  7

can be encoded as:

my $tree = [1 , 2, 3, 4, 5, 6, 7];

or even:

my $tree = [1 .. 7];

Now, the required task becomes very simple, as we can just manipulate the flat array.

We also provide a bft and a display subroutines for the purpose of displaying a graphical ASCII representation of the data in a tree format.

Recreate Binary Tree in Raku

We’re using a flat array to store the binary tree data structure, as described above:

use v6;

sub children (Int $i) { 2*$i+1, 2*$i+2 }  # not needed here
sub parent (Int $i) { ($i-1)/2; }         # not needed here

sub display ($tree) {
    my @bft_tree = bft($tree);
    my $start = (@bft_tree[*-1]).elems;
    my $sep_val = (2 * $start) - 1;
    for @bft_tree -> @line {
        my $sep = " " x $sep_val;
        say " " x $start, join $sep, @line;
        $start /= 2;
        $sep_val = ($sep_val - 1) / 2;
    }
}
sub bft ($tree) {               # Breadth First Traversal
    my ($index, $level) = (0, 0);
    my @bft_tree;
    while ($index <= $tree.end) {
        my $new_index = $index + 2 ** $level - 1;
        (@bft_tree[$level++]).append($tree[$index .. $new_index]);
        $index = $new_index + 1;
    }
    return @bft_tree;
}

my @tree = 1..7;
say "Tree before change:";
display @tree;
my $sum = [+] @tree;
my @new-tree = map { $sum - $_ }, @tree;
say "\nTree after change:";
display @new-tree;

Note that the performing the task requires only two lines of code:

my $sum = [+] @tree;
my @new-tree = map { $sum - $_ }, @tree;

It is the code to display the data in a tree format that takes most of the code.

This program displays the following output:

$ raku bin-tree.raku
Tree before change:
    1
  2   3
 4 5 6 7

Tree after change:
    27
  26   25
 24 23 22 21

Recreate Binary Tree in Perl

We’re again using a flat array to store the binary tree data structure, as described above:

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

sub children { my $i = shift; 2*$i+1, 2*$i+2 }
sub parent { my $i = shift; ($i-1)/2; }  # not needed here

sub display {
    my $bft_tree = bft(shift);
    my $start = scalar @{$bft_tree->[-1]};
    my $sep_val = (2 * $start) - 1;
    for my $line (@$bft_tree) {
        my $sep = " " x $sep_val;
        say " " x $start, join $sep, @$line;
        $start /= 2;
        $sep_val = ($sep_val - 1) / 2;
    }
}
sub bft {               # Breadth First Traversal
    my $tree = shift;
    my ($index, $level) = (0, 0);
    my @bft_tree;
    while ($index < scalar @$tree) {
        my $new_index = $index + 2 ** $level - 1;
        push @{$bft_tree[$level++]}, @{$tree}[$index .. $new_index];
        $index = $new_index + 1;
    }
    return \@bft_tree;
}

my $tree = [ 1..7 ];
say "\nTree before change:";
display $tree;
my $sum = 0;
$sum += $_ for @$tree;
my $new_tree = [ map $sum - $_, @$tree ];
say "\nNew tree";
display $new_tree;

This program displays the following output:

$ perl bin-tree.pl

Tree before change:
    1
  2   3
 4 5 6 7

New tree
    27
  26   25
 24 23 22 21

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 Sunday, May 30, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 112: Canonical Path and Climb Stairs

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

Spoiler Alert: This weekly challenge deadline is due in a few days (May 16, 2021). 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: Canonical Path

You are given a string path, starting with a slash ‘/’.

Write a script to convert the given absolute path to the simplified canonical path.

In a Unix-style file system:

- A period ‘.’ refers to the current directory

- A double period ‘..’ refers to the directory up a level

- Multiple consecutive slashes (‘//’) are treated as a single slash ‘/’

The canonical path format:

- The path starts with a single slash ‘/’.

- Any two directories are separated by a single slash ‘/’.

- The path does not end with a trailing ‘/’.

- The path only contains the directories on the path from the root directory to the target file or directory

Example:

Input: "/a/"
Output: "/a"

Input: "/a/b//c/"
Output: "/a/b/c"

Input: "/a/b/c/../.."
Output: "/a"

Although it can surely be done differently, this is obviously a job for regular expressions or regexes.

Canonical Path in Raku

It would certainly make sense to write a grammar for performing the necessary transformations, but this is simple enough for a few regexes to do the job. It is in fact probably possible to do everything with a single regex, but I usually find it more legible to transform the input string step by step.

Note that I’m not trying to validate the input paths, with just one exception: if there are too many /../ compared to the previous path items, the script dies, rather than printing something incorrect.

use v6

my @tests = </a/ /a/b//c/ /a/b/c/../.. /a/../../b/>;
for @tests <-> $path {
    my $p = $path;
    $path ~~ s:g|'//'+|/|;
    $path ~~ s:g!^'/' | '/'$!!;
    my @path-items;
    for split /'/'+/, $path -> $item {
        next if $item eq '.';
        if $item eq '..' {
            die "Invalid path $p" unless @path-items;
            pop @path-items;
        } else {
            push @path-items, $item;
        }
    };
    say "$p => /", @path-items.join('/');
}

The script displays the following output:

$ raku ./paths.raku
/a/ => /a
/a/b//c/ => /a/b/c
/a/b/c/../.. => /a
Invalid path /a/../../b/
  in block  at ./main.raku line 12
  in block <unit> at ./main.raku line 4

Canonical Path in Perl

This a port to Perl of the Raku program above, except that when there are too many /../ compared to the previous path items, the script issues a warning instead of dying, does not print any canonical path and proceeds with the next items.

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

my @tests = ('/a/', '/a/b//c/', '/a/b/c/../..', '/a/../../b/', '/a/././b/');
TEST: for my $path (@tests) {
    my $p = $path;
    $path =~ s|\/\/+|/|g;
    $path =~ s!^\/|\/$!!g;
    my @path_items;
    for my $item (split /\/+/, $path) {
        next if $item eq '.';
        if ($item eq '..') {
            warn "Invalid path $p" and next TEST unless @path_items;
            pop @path_items;
        } else {
            push @path_items, $item;
        }
    };
    say "$p => /", join '/', @path_items;
}

The script displays the following output:

$ perl paths.pl
/a/ => /a
/a/b//c/ => /a/b/c
/a/b/c/../.. => /a
Invalid path /a/../../b/ at paths.pl line 14.
/a/././b/ => /a/b

Task 2: Climb Stairs

You are given $n steps to climb.

Write a script to find out the distinct ways to climb to the top. You are allowed to climb either 1 or 2 steps at a time.

Example:

Input: $n = 3
Output: 3

    Option 1: 1 step + 1 step + 1 step
    Option 2: 1 step + 2 steps
    Option 3: 2 steps + 1 step

Input: $n = 4
Output: 5

    Option 1: 1 step + 1 step + 1 step + 1 step
    Option 2: 1 step + 1 step + 2 steps
    Option 3: 2 steps + 1 step + 1 step
    Option 4: 1 step + 2 steps + 1 step
    Option 5: 2 steps + 2 steps

It is not clear to me whether the output should contain all the information above, or just the number of possibilities, but since the assignment asks us “to find out the distinct ways to climb to the top”, I have decided to output the result in the format given above, although this leads to quite a bit of uninteresting boiler plate code.

Climb Stairs in Raku

I’ve decided to use a try-steps recursive subroutine to explore all possibilities. The script uses a @*result dynamic variable to store the various winning combinations of steps and to print them at the end.

use v6;

sub print-result {
    my $count = 0;  
    for  @*result -> @solution {
        print "\tOption ", ++$count, ": ";
        my @step_list;
        push @step_list, "$_ " ~ ($_ ~~ /1/ ?? "step " !! "steps") for @solution;
        say join " + ", @step_list;
    }
    say "";
}

sub try-steps ($nb-steps, @curr) {
    for 1, 2 -> $new-step {
        my @new-cur = (|@curr, $new-step);
        my $sum = [+] @new-cur;
        next if $sum > $nb-steps;
        if $sum == $nb-steps {
            push @*result, @new-cur;
            last;
        } else {
            try-steps $nb-steps, @new-cur;
        }
    }
}

for 3, 4, 5 -> $target {
    my @*result;
    try-steps $target, [];
    say 'Input: $n = ', $target;
    say "Output: ", @*result.elems;
    # say @*result;
    print-result;
}

The script displays the following output:

$ raku ./steps.raku
Input: $n = 3
Output: 3
    Option 1: 1 step  + 1 step  + 1 step 
    Option 2: 1 step  + 2 steps
    Option 3: 2 steps + 1 step 

Input: $n = 4
Output: 5
    Option 1: 1 step  + 1 step  + 1 step  + 1 step 
    Option 2: 1 step  + 1 step  + 2 steps
    Option 3: 1 step  + 2 steps + 1 step 
    Option 4: 2 steps + 1 step  + 1 step 
    Option 5: 2 steps + 2 steps

Input: $n = 5
Output: 8
    Option 1: 1 step  + 1 step  + 1 step  + 1 step  + 1 step 
    Option 2: 1 step  + 1 step  + 1 step  + 2 steps
    Option 3: 1 step  + 1 step  + 2 steps + 1 step 
    Option 4: 1 step  + 2 steps + 1 step  + 1 step 
    Option 5: 1 step  + 2 steps + 2 steps
    Option 6: 2 steps + 1 step  + 1 step  + 1 step 
    Option 7: 2 steps + 1 step  + 2 steps
    Option 8: 2 steps + 2 steps + 1 step

Note that, if you don’t want this verbose output, you can just remove the print-result subroutine definition, comment out the last line (with the print-result subroutine call), and uncomment the previous code line:

    say @*result;
    # print-result;

and obtain the following output:

$ raku ./steps.raku
Input: $n = 3
Output: 3
[[1 1 1] [1 2] [2 1]]
Input: $n = 4
Output: 5
[[1 1 1 1] [1 1 2] [1 2 1] [2 1 1] [2 2]]
Input: $n = 5
Output: 8
[[1 1 1 1 1] [1 1 1 2] [1 1 2 1] [1 2 1 1] [1 2 2] [2 1 1 1] [2 1 2] [2 2 1]]

Climb Stairs in Perl

This is a port to Perl of the above Raku program, with a try_steps recursive subroutine:

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

my @result;

sub print_result {
    my $count = 0;
    for  my $solution (@result) {
        print "\tOption ", ++$count, ": ";
        my @step_list;
        push @step_list, "$_ " . ($_ =~ /1/ ? "step " : "steps") for @$solution;
        say join " + ", @step_list;
    }
    say "";
}

sub try_steps  {
    my ($nb_steps, $sum, @curr) = @_;
    for my $new_step (1, 2) {
        my $new_sum =  $sum + $new_step;
        next if $new_sum > $nb_steps;
        my @new_cur = (@curr, $new_step);
        if ($new_sum == $nb_steps) {
            push @result, \@new_cur;
            last;
        } else {
            try_steps($nb_steps, $new_sum, @new_cur);
        }
    }
}

for my $target (3, 4, 5) {
    @result = ();
    try_steps $target, 0, ();
    say 'Input: $n = ', $target;
    say "Output: ", scalar @result;
    print_result;
}

This script displays the following output:

$ perl  ./steps.pl
Input: $n = 3
Output: 3
        Option 1: 1 step  + 1 step  + 1 step
        Option 2: 1 step  + 2 steps
        Option 3: 2 steps + 1 step

Input: $n = 4
Output: 5
        Option 1: 1 step  + 1 step  + 1 step  + 1 step
        Option 2: 1 step  + 1 step  + 2 steps
        Option 3: 1 step  + 2 steps + 1 step
        Option 4: 2 steps + 1 step  + 1 step
        Option 5: 2 steps + 2 steps

Input: $n = 5
Output: 8
        Option 1: 1 step  + 1 step  + 1 step  + 1 step  + 1 step
        Option 2: 1 step  + 1 step  + 1 step  + 2 steps
        Option 3: 1 step  + 1 step  + 2 steps + 1 step
        Option 4: 1 step  + 2 steps + 1 step  + 1 step
        Option 5: 1 step  + 2 steps + 2 steps
        Option 6: 2 steps + 1 step  + 1 step  + 1 step
        Option 7: 2 steps + 1 step  + 2 steps
        Option 8: 2 steps + 2 steps + 1 step

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 Sunday, May 23, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 111: Search Matrix and Ordered Letters

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

Spoiler Alert: This weekly challenge deadline is due in a few days (May 9, 2021). 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: Search Matrix

You are given 5x5 matrix filled with integers such that each row is sorted from left to right and the first integer of each row is greater than the last integer of the previous row.

Write a script to find a given integer in the matrix using an efficient search algorithm.

Example:

Matrix: [  1,  2,  3,  5,  7 ]
        [  9, 11, 15, 19, 20 ]
        [ 23, 24, 25, 29, 31 ]
        [ 32, 33, 39, 40, 42 ]
        [ 45, 47, 48, 49, 50 ]

Input: 35
Output: 0 since it is missing in the matrix

Input: 39
Output: 1 as it exists in the matrix

We’re only trying to know whether an integer exists in the matrix. What I would normally do in such case is transform the data structure, i.e. store all the matrix items into a hash and then simply look whether an item exists in the hash. And I’ll also present such a solution.

However, looking carefully at the working of the task, we can see that the task insists on the fact that the integers are in ascending order from left to right and from top to bottom. The task further tells us that we should use an efficient algorithm. Although this is not explicitly specified, it is quite clear that we’re expected to implement a binary search algorithm, which is an efficient algorithm with sorted data.

The first idea might be to flatten the matrix into a one-dimension array, making the dataset much easier to use with a canonical binary search algorithm. But, obviously, that’s also not really what we’re expected to do. The task author wants us to implement a binary search algorithm on a 2-D matrix. We could come up with an “approximate” binary search, i.e. an heuristic looking for the approximate mid-point between two values. For example, we could start by testing any item on the third row and then goto the 2nd or 4th row depending on the result of the test. But that’s not satisfactory: that would not scale easily to other dimensions.

So I decided to perform the binary search on a list of consecutive integers between 0 and 24, and to provide a subroutine to convert these integers into 2-D indices. For example, the sixth item in that range corresponds to indices [1][0].

Search Matrix in Raku

Using Binary Search

The A2AoA subroutine converts a flat rank into 2-D indices. We simply run a binary search on the 0..24 range and use the A2AoA subroutine to find out the correspond values in the matrix. Our test cases will be quite exhaustive, since we’ll be searching the matrix for every integer between 0 and 54.

use v6;

my @matrix = (  1,  2,  3,  5,  7 ),
             (  9, 11, 15, 19, 20 ),
             ( 23, 24, 25, 29, 31 ),
             ( 32, 33, 39, 40, 42 ),
             ( 45, 47, 48, 49, 50 );

sub A2AoA ($index) {
    my ($i, $j) = $index.polymod(5).reverse;
}
sub binary ($in) {
    my ($min, $max) = 0, 24;
    while $max > $min {
        my $pivot = (($max + $min) /2).Int;
        my ($i, $j) = A2AoA $pivot;
        my $val = @matrix[$i][$j];
        # say "val = $val, $i, $j";
        return 1 if $val == $in;
        if $in > $val {
            $min = $pivot + 1;
        } else {
            $max = $pivot;
        }
    }
    return 0;
}
say "$_ => ", binary $_ for 0..54;

This program displays the following output:

$ raku ./search_item.raku
0 => 0
1 => 1
2 => 1
3 => 1
4 => 0
5 => 1
6 => 0
7 => 1
8 => 0
9 => 1
10 => 0
11 => 1
12 => 0
13 => 0
14 => 0
15 => 1
16 => 0
17 => 0
18 => 0
19 => 1
20 => 1
21 => 0
22 => 0
23 => 1
24 => 1
25 => 1
26 => 0
27 => 0
28 => 0
29 => 1
30 => 0
31 => 1
32 => 1
33 => 1
34 => 0
35 => 0
36 => 0
37 => 0
38 => 0
39 => 1
40 => 1
41 => 0
42 => 1
43 => 0
44 => 0
45 => 1
46 => 0
47 => 1
48 => 1
49 => 1
50 => 0
51 => 0
52 => 0
53 => 0
54 => 0

Note that I’m happy that I used such exhaustive test cases, since my original implementation had a relatively rare bug that I had not seen with the six or seven values I initially tested.

Using a Hash

As I said in the introduction, in the real life, I would transform the input data into a hash and simply perform hash lookup.

use v6;

my @matrix = (  1,  2,  3,  5,  7 ),
             (  9, 11, 15, 19, 20 ),
             ( 23, 24, 25, 29, 31 ),
             ( 32, 33, 39, 40, 42 ),
             ( 45, 47, 48, 49, 50 );

my %hash;
for @matrix -> @row {
    %hash{$_} = 1 for @row;
}
say "$_ => ", %hash{$_} ?? 1 !! 0 for 0..54;

As it can be seen, the code is much shorter, much simpler and much less prone to errors. It produces the same output:

$ raku ./search_item2.raku
0 => 0
1 => 1
2 => 1
3 => 1
4 => 0
5 => 1
6 => 0
7 => 1
8 => 0
9 => 1
... Lines omitted for brevity...
45 => 1
46 => 0
47 => 1
48 => 1
49 => 1
50 => 1
51 => 0
52 => 0
53 => 0
54 => 0

Search Matrix in Perl

Using Binary Search

This is a port to Perl of the binary search algorithm explained in the introduction above. The A2AoA subroutine converts a flat rank into 2-D indices. We simply run a binary search on the 0..24 range and use the A2AoA subroutine to find out the correspond values in the matrix. Our test cases will be quite exhaustive, since we’ll be searching the matrix for every integer between 0 and 54.

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

my @matrix = ( [  1,  2,  3,  5,  7 ],
               [  9, 11, 15, 19, 20 ],
               [ 23, 24, 25, 29, 31 ],
               [ 32, 33, 39, 40, 42 ],
               [ 45, 47, 48, 49, 50 ]
             );

sub A2AoA {
    my $index = shift;
    my ($i, $j) = (int $index / 5, $index % 5);
}
sub bin_search {
    my $in = shift;
    my ($min, $max) = (0, 24);
    while ($max > $min) {
        my $pivot =  int (($max + $min) /2);
        my ($i, $j) = A2AoA $pivot;
        my $val = $matrix[$i][$j];
        # say "val = $val, $i, $j";
        return 1 if $val == $in;
        if ($in > $val) {
            $min = $pivot + 1;
        } else {
            $max = $pivot;
        }
    }
    return 0;
}
say "$_ => ", bin_search $_ for 0..54;

This program displays the following output:

perl  ./search_item.pl
0 => 0
1 => 1
2 => 1
3 => 1
4 => 0
5 => 1
6 => 0
7 => 1
... lines omitted for brevity ...
45 => 1
46 => 0
47 => 1
48 => 1
49 => 1
50 => 0
51 => 0
52 => 0
53 => 0
54 => 0

Using a Hash

As mentioned above, in the real life, I would transform the input data into a hash and simply perform hash lookup. In Raku, I had to use nested for loops to populate the hash because my attempts using chained maps did not work as expected. There is certainly a way to do it with chained maps, but it is not easy to find the right syntax. No such problem with Perl where my chained maps worked perfectly on my first attempt (see below). There has to be something for which Perl is better or (more convenient) than Raku.

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

my @matrix = ( [  1,  2,  3,  5,  7 ],
               [  9, 11, 15, 19, 20 ],
               [ 23, 24, 25, 29, 31 ],
               [ 32, 33, 39, 40, 42 ],
               [ 45, 47, 48, 49, 50 ]
             );

my %hash = map { $_ => 1 } map { @$_ } @matrix;
say "$_ => ", exists $hash{$_} ? 1 : 0 for 0..54;

This displays the same output as before:

$ perl search_item2.pl
0 => 0
1 => 1
2 => 1
3 => 1
4 => 0
... Lines omitted for brevity ...
45 => 1
46 => 0
47 => 1
48 => 1
49 => 1
50 => 1
51 => 0
52 => 0
53 => 0
54 => 0

Search Matrix in Other Languages

In Scala and Python, I’ll implement only the hash lookup strategy.

Search Matrix in Scala

In Scala, hashes are called “maps” but they behave essentuially the same way.

object SearchItem extends App {
  val matrix = Array(
    Array(1, 2, 3, 5, 7),
    Array(9, 11, 15, 19, 20),
    Array(23, 24, 25, 29, 31),
    Array(32, 33, 39, 40, 42),
    Array(45, 47, 48, 49, 50)
  )

  var hash = scala.collection.mutable.Map[Int, Int]()
  for (row <- matrix) {
    for (item <- row) {
      hash(item) = 1
    }
  }

  for (i <- 0 to 54) {
    if (hash.contains(i)) {
      println(s"$i => 1")
    } else {
      println(s"$i => 0")
    }
  }
}

Output:

0 => 0 1 => 1 2 => 1 3 => 1 4 => 0 … Lines omitted for brevity … 46 => 0 47 => 1 48 => 1 49 => 1 50 => 1 51 => 0 52 => 0 53 => 0 54 => 0

Search Matrix in Python

In Python, hashes are called dictionaries, and can be used the same way.

matrix = ( [  1,  2,  3,  5,  7 ],
           [  9, 11, 15, 19, 20 ],
           [ 23, 24, 25, 29, 31 ],
           [ 32, 33, 39, 40, 42 ],
           [ 45, 47, 48, 49, 50 ]
         );

hash = {}
for row in matrix:
    for item in row:
        hash[item] = 1

for i in range(55):
    if i in hash:
        print(i, " => 1")
    else:
        print(i, " => 0")

Output:

$ python3 ./search_item.py
0  => 0
1  => 1
2  => 1
3  => 1
4  => 0
5  => 1
... Lines omitted for brevity ...
45  => 1
46  => 0
47  => 1
48  => 1
49  => 1
50  => 1
51  => 0
52  => 0
53  => 0
54  => 0

Task 2: Ordered Letters

Given a word, you can sort its letters alphabetically (case insensitive). For example, “beekeeper” becomes “beeeeekpr” and “dictionary” becomes “acdiinorty”.

Write a script to find the longest English words that don’t change when their letters are sorted.

For this, I’ll use an English word list contributed to the public domain by Grady Ward as part of the Moby Lexicon project. It is a list of 113,809 crosswords, that is words that are considered valid in crossword puzzles and other word games. The list can be found on my github repository.

Ordered Letters in Raku

We don’t really need to sort the letters: we only need to know whether they are already in the alphabetical order. In Raku, we can use the [...] reduce metaoperator together with the le less than or equal to operator on the letters of the word. Checking whether a list is sorted has a smaller computational complexity than sorting the list, so this should presumably be faster (although it is so fast with my 113-k word list that it doesn’t really matter).

use v6;

my @long-words;
my $max-length = 0;

for './words.txt'.IO.lines -> $word {
    next unless [le] $word.comb;
    my $length = $word.chars;
    if  $length > $max-length {
        @long-words = $word,;
        $max-length = $length;
    } elsif $length == $max-length {
        push @long-words, $word;
    }
}
say @long-words.join(", ");

This program finds two 7-letter words satisfying the task’s criteria and displays the following output:

$ raku ./ordered-letters.raku
beefily, billowy

I do not know what these two words mean, but they are in the input list and they satisfy the criteria.

Ordered Letters in Perl

It is slightly less convenient in Perl than in Raku to check that the letters are already in the proper order, so I’ll simply sort the letters and compare the output with the input word.

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

my @long_words;
my $max_length = 0;

my $word_list = "./words.txt";
open my $IN, "<", $word_list or die "Cannot open $word_list $!";
while (my $word = <$IN>) {
    chomp $word;
    next unless $word eq join '', sort split //, $word;
    my $length = length $word;
    if  ($length > $max_length) {
        @long_words = ($word);
        $max_length = $length;
    } elsif ($length == $max_length) {
        push @long_words, $word;
    }
}
say "@long_words";

This program produces the same two words:

$ perl ordered-letters.pl
beefily billowy

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 Sunday, May 16, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 110: Valid Phone Numbers and Transposed File

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days (May 2, 2021). 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: Valid Phone Numbers

You are given a text file.

Write a script to display all valid phone numbers in the given text file.

Acceptable Phone Number Formats:

+nn  nnnnnnnnnn
(nn) nnnnnnnnnn
nnnn nnnnnnnnnn

Input File:

0044 1148820341
 +44 1148820341
  44-11-4882-0341
(44) 1148820341
  00 1148820341

Output

0044 1148820341
 +44 1148820341
(44) 1148820341

This is obviously typically a job for regular expressions (or regexes). I will not even try to consider a language or solution not using regular expressions. I will not use a separate text file but simulate it with an array of strings or some other means.

Valid Phone Numbers in Raku

Please remember that Raku’s regexes are trying to renew the subject and have some differences with the traditional Perl or Perl-compatible regexes. Among other things, spaces are usually not relevant in a regex pattern (unless you use an option to force it).

use v6;

my @tests = " 0044 1148820341 42 ", "  +44 1148820342 abc", 
            " 44-11-4882-0343 ", " (44) 1148820344  ", " 00 1148820345";

my $ten-dgts = rx/\d ** 10/;
for @tests -> $str {
    say ~$0 if $str ~~ / ( [ \d ** 4 || '+' \d\d || \( \d\d \) ] \s+ <$ten-dgts> ) /;
}

To make things clearer, the regex above could be rewritten more clearly as:

(                 # Capture content within  poarens
  [               # group items within the [] alternative
    \d ** 4 ||    # Four digits or...
    '+' \d\d ||   # + sign and 2 digits, or ..
    \( \d\d \) ]  # two digits within parentheses
  ]               # end of the alternative
  \s+             # spaces
  <$ten-dgts>     # Ten-digits regex
)                 # end of capture

The above program displays the following output

$ perl phone.pl
0044 1148820341
+44 1148820342
(44) 1148820344
(39) 1148820344

Valid Phone Numbers in Perl

This is a port to Perl of the above Raku program. Note that we have included a test case in which thee are two phone numbers in the same input line.

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

# simulate a text file with an array of strings
my @tests = (" 0044 1148820341 42 ", "  +44 1148820342 abc", 
            " 44-11-4882-0343 ", " (44) 1148820344 foo (39) 1148820345", " 00 1148820346");

for my $str (@tests) {
    say $1 while $str =~ / ( (?: \d {4} | \+ \d\d | \( \d\d \)  ) \s+ \d{10} ) /gx;
}

This script displays the following output:

$ perl phone.pl
0044 1148820341
+44 1148820342
(44) 1148820344
(39) 1148820345

Valid Phone Numbers in Other Languages

Phone Numbers in Scala

We need to import the cala.util.matching.Regex core Scala package. Note that every backslash appears twice in the pattern of the program below. This is because in Java and Scala, a single backslash is an escape character in a string literal, not a regular character that shows up in the string. So instead of ‘\’, you need to write ‘\’ to get a single backslash in the string.

import scala.util.matching.Regex

object phoneNumber extends App {
  val pattern = "((?:\\d{4}|\\+\\d\\d|\\(\\d\\d\\))\\s+\\d{10})".r
  val tests = Array(
    " 0044 1148820341 42 ",
    "  +44 1148820342 abc",
    " 44-11-4882-0343 ",
    " (44) 1148820344  (33) 1148820345",
    " 00 1148820346"
  );
  for (str <- tests) {
    if (pattern.unanchored.matches(str)) {
      println((pattern findAllIn str).mkString(", "))
    }
  }
}

Output:

0044 1148820341
+44 1148820342
(44) 1148820344, (33) 1148820345

Phone Numbers in Python

This program uses the re core Python package:

import re 

tests = ("foo 0044 1148820341 42", "xyz +44 1148820342 abc", "44-11-4882-0343", " (44) 1148820344  ", "00 1148820345")

for str in tests:
    match = re.search("(\d{4}|\+\d\d|\(\d\d\))\s+\d{10}", str)
    if (match):
        print (match.group())

Output:

$ python3 phone.py
0044 1148820341
+44 1148820342
(44) 1148820344

Phone Numbers in Awk

Awk was the first programming language to include regular expressions, even before Perl, so it was an obvious guest language candidate for this task. I had a bit of trouble to get it to work properly because, for some reason, the \d and [:digit:] character classes did not work properly on the platform where I tested it (although they’re supposed to be part of the awk language). I used [0-9] instead, which is a quite simple solution, but I wasted quite a bit of time before I figured why it did not work as I expected. Here, we’re using a shell pipe with an awk one-liner:

$ echo '
0044 1148820341
+44 1148820342
44-11-4882-0343
(44) 1148820344
00 1148820346
' | awk '/([0-9]{4}|\+[0-9]{2}|\([0-9]{2}\))\s+[0-9]{10}/ { print $0 }'
0044 1148820341
+44 1148820342
(44) 1148820344

Phone Numbers in Julia

No need to import a dedicated library in Julia, since regexes are built into the language.

tests = ["foo 0044 1148820341 42", "xyz +44 1148820342 abc", 
         "44-11-4882-0343", " (44) 1148820344  ", "00 1148820345"]
pattern = r"(\d{4}|\+\d\d|\(\d\d\))\s+\d{10}"

for str in tests 
    m = match(pattern, str)
    if (! (m === nothing)) 
        println(m.match)
    end
end

Output:

    $julia phone.jl
    0044 1148820341
    +44 1148820342
    (44) 1148820344

Phone Numbers in Ruby

For some reason the \d character class and the \+ literal plus sign don’t seem to work on my Ruby installation, although they should if I understand the documentation correctly. So, I used the [0-9] and [+] character classes instead.

tests = ["foo 0044 1148820341 42", "xyz +44 1148820342 abc", 
         "44-11-4882-0343", " (44) 1148820344  ", "00 1148820345"]
pattern = %r{((\d{4}|\+\d{2}|\(\d{2}\))\s+\d{10})}
for str in tests
    match = str.match(pattern)
    if match then
        print(match[0], "\n")
    end
end

Output:

0044 1148820341                                                                                                                               
+44 1148820342                                                                                                                                
(44) 1148820344

Phone Numbers in Rust

Here, I have chosen to use a single string containing several phone numbers as input and check that we can extract several valid phone numbers from that input string.

use regex::Regex;

fn main() {
    let pattern = Regex::new(r"((\d{4}|\+\d{2}|\(\d{2}\))\s+\d{10})").unwrap();
    let test = "foo 0044 1148820341 42 xyz +44 1148820342 abc 
        44-11-4882-0343 (44) 1148820344 00 1148820345";
    for matches in pattern.captures_iter(test) {
        println!("{:?}", &matches[0]);
    }
}

Output:

"0044 1148820341"
"+44 1148820342"
"(44) 1148820344"

Task 2: Transpose File

You are given a text file.

Write a script to transpose the contents of the given file.

Input File

name,age,sex
Mohammad,45,m
Joe,20,m
Julie,35,f
Cristina,10,f

Output:

name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

For practical reasons, I will not use an external file but simulate it in various ways.

Transpose File in Raku

We simulate the input file with an array of strings. The program takes the @input array of strings, reads each line in turn (as we would do with an actual file), split each line and on commas, and store the individual items in a @transposed array of arrays. At the end, we just need to output the rows of the @transposed array.

use v6;

my @input = <name,age,sex Mohammad,45,m 
             Joe,20,m Julie,35,f Cristina,10,f>;

my @transposed;
for @input -> $in {
    my $i = 0;
    for $in.split(',') -> $str {
        push @transposed[$i], $str;
        $i++;
    }
}
for @transposed -> @line {
    say @line.join(',');
}

This program displays the following output:

$ raku ./transpose.raku
name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

Transpose File in Perl

We simulate the input file with space-separated string. The construction of the @transposed array of arrays is following the same idea as in Raku.

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

# Note: input array simulated with a string
my $in_string = "name,age,sex  Mohammad,45,m 
         Joe,20,m Julie,35,f  Cristina,10,f";
my @input = split /\s+/, $in_string;
my @transposed;
for my $in (@input) {
    my $i = 0;
    for my $str (split /,/, $in) {
        push @{$transposed[$i]}, $str;
        $i++;
    }
}
for my $line (@transposed) {
    say join ',', @$line;
}

This program displays the following output:

$ perl  transpose.pl
name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

Transpose File in Awk

We pipe the input to the awk program standard input.

BEGIN{ 
    FS = "," 
}
{ table[0,NR] = $1 }
{ table[1,NR] = $2 }
{ table[2,NR] = $3 }
{ max = NR }
END {
    for (i = 0; i < 3; i++) {
        for (j = 1; j < max - 1; j++) printf "%s,", table[i,j]
        printf "%s\n", table[i,max-1]
    }
}

This is an example run:

$  echo 'name,age,sex
> Mohammad,45,m
> Joe,20,m
> Julie,35,f
> Cristina,10,f
> ' | awk -f transpose.awk
name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

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 Sunday, May 9, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.