December 2020 Archives

Perl Weekly Challenge 92: Isomorphic Strings and Insert Intervals

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

Spoiler Alert: This weekly challenge deadline is due in a few hours. 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: Isomorphic Strings

You are given two strings $A and $B.

Write a script to check if the given strings are Isomorphic. Print 1 if they are, otherwise 0.

Example 1:

Input: $A = "abc"; $B = "xyz"
Output: 1

Example 2:

Input: $A = "abb"; $B = "xyy"
Output: 1

Example 3:

Input: $A = "sum"; $B = "add"
Output: 0

Isomorphic Strings in Raku

For this task, we’re using 5 test cases. For each string pair, the program calls the is-isomorphic subroutine, which does the bulk of the work.

The first thing that the is-isomorphic subroutine does is to compare the string lengths and return 0 if they are not equal. This may appear to be a performance enhancement (and, it is indeed), but, more importantly, this simplifies the rest of the procedure since, from there on, we know that the strings we are processing have the same character count. Then, we use the %transcode hash to record the translation table from the first string to the second one. We return 0 if any character in the first string would need to be translated into two different characters in the second one. This is not sufficient, though: for example, the last example in the task description (“sum” and “add”) would pass this test, although the words are not isomorphic. So we also use the %seen SetHash to record the letters of the second string that we have already seen and return 0 if any pair of characters required a new entry in the %transcode hash whereas the target letter has already been seen.

use v6;
my @tests = (< abc xyz >), (< abb xyy >), (< sum add >),
    (< ACAB XCXY >), (< abc uvwxy >);

    for @tests -> @strings {
        say "@strings[]: ", is-isomorphic @strings;
    }

sub is-isomorphic (@strings) {
    my ($str1, $str2) = @strings;
    return 0 if $str1.chars != $str2.chars;
    my %transcode;
    my SetHash $seen;
    for 0..$str1.chars - 1 -> $i {
        my $char1 = $str1.substr($i, 1);
        my $char2 = $str2.substr($i, 1);
        if %transcode{$char1}:exists {
            return 0 if %transcode{$char1} ne $char2;
        } else {
            return 0 if $seen{$char2};
            %transcode{$char1} = $char2;
            $seen{$char2}++;;
        }
    }
    return 1
}

This script displays the following output:

$ raku isomorphic.raku
abc xyz: 1
abb xyy: 1
sum add: 0
ACAB XCXY: 1
abc uvwxy: 0

Isomorphic Strings in Perl

This is essentially the same code as before in Perl. Please refer to the explanations above if needed. The only significant difference is that, since there is no SetHash in Perl, we use the plain hash %seen.

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

my @tests = ( [qw< abc xyz >], [qw< abb xyy >], [qw< sum add >],
    [qw< ACAB XCXY >], [qw< abc uvwxy >] );

    for my $strings_ref (@tests) {
        say "@$strings_ref: ", is_isomorphic(@$strings_ref);
    }

sub is_isomorphic {
    my ($str1, $str2) = @_;
    return 0 if length $str1 != length $str2;
    my (%transcode, %seen);
    for my $i (0..length($str1) - 1) {
        my $char1 = substr $str1, $i, 1;
        my $char2 = substr $str2, $i, 1;;
        if (exists $transcode{$char1}) {
            return 0 if $transcode{$char1} ne $char2;
        } else {
            return 0 if exists $seen{$char2};
            $transcode{$char1} = $char2;
            $seen{$char2} = 1;
        }
    }
    return 1
}

Output:

$ perl isomorphic.pl
abc xyz: 1
abb xyy: 1
sum add: 0
ACAB XCXY: 1
abc uvwxy: 0

Isomorphic Strings in Scala

This is essentially a port to Scala of the above two programs in Raku and Perl. See the explanations above if needed. Perl’s and Raku’s hashes are called Maps in Scala. Also, Sets are usually not mutable, so we need to import scala.collection.mutable.Set.

import scala.collection.mutable.Set

object Main {
  def main(args: Array[String]): Unit = {
    val (str1, str2) =
      if (args.size == 2) (args(0), args(1)) else ("abc", "xyz")
    println(s"args = $str1 and $str2")
    println(isIsomorphic(str1, str2))
  }
  def isIsomorphic(str1: String, str2: String): Int = {
    if (str1.length != str2.length) return 0
    var transcode: Map[Char, Char] = Map()
    var seen: Set[Char] = Set()
    for (i <- 0 to str1.length - 1) {
      if (transcode.contains(str1(i))) {
        if (str1(i) != str2(i)) { return 0 }
      } else {
        if (seen.contains(str2(i))) return 0
        transcode += (str1(i) -> str2(i))
        seen += str2(i)
      }
    }
    return 1
  }
}

Sample output:

args = abc and xyz
1

Task 2: Insert Intervals

You are given a set of sorted non-overlapping intervals and a new interval.

Write a script to merge the new interval to the given set of intervals.

Example 1:

Input $S = (1,4), (8,10); $N = (2,6)
Output: (1,6), (8,10)

Example 2:

Input $S = (1,2), (3,7), (8,10); $N = (5,8)
Output: (1,2), (3,10)

Example 3:

Input $S = (1,5), (7,9); $N = (10,11)
Output: (1,5), (7,9), (10,11)

On Non-Overlapping and Adjacent Intervals

When you create or use such intervals, in probably more than 90% of the use cases, you generally also want to avoid adjacent intervals, because the aim is usually to summarize an integer (or alphabetic or other) sequence as much as possible. From that standpoint, the input set of the second example would not be (1,2), (3,7), (8,10), but (1,10).

My first Raku attempt merged adjacent intervals. It simply expanded all intervals, sorted the data and recreated intervals:

use v6;

my @tests = [(2, 6), (1, 4), (8, 10)], [(5, 8), (1, 2), (3,7 ), (8, 10)], [(10, 11), (1, 5), (7, 9)];

# Caution: not complying with the task rules, as this
# script also merges adjacent intervals
for @tests -> @test {
    say @test;
    my @full-data = (map { |( $_[0]..$_[1]) }, @test).Set.keys.sort;
    my $first = shift @full-data;
    my @result;
    my $last = $first;
    for @full-data -> $item {
        if $item != $last + 1 {
           push @result, "($first, $last), ";
           $first = $item;
        }
        $last = $item;
    }
    push @result, "($first, $last), ";
    say ~@result.subst(/','\s+$/, "\n");
}

This produces the following output:

$ raku interval_1.raku
[(2 6) (1 4) (8 10)]
(1, 6),  (8, 10)

[(5 8) (1 2) (3 7) (8 10)]
(1, 10)

[(10 11) (1 5) (7 9)]
(1, 5),  (7, 11)

As noted before, to me, this is more in line with what you usually want to do with such intervals. But, the task specification says “non-overlapping”, it doesn’t mention “non-adjacent” intervals and the examples are quite clear, so fair enough, my solution above is wrong. It’s a pity, since this is really simpler. A correct solution will be given below.

On the Size of the Input Data

The examples provided are very small, with only two or three intervals. This led me to an algorithm that sorts again the input (together with the additional interval) and then loops over the contents to merge overlapping intervals.

This, of course, wouldn’t be very efficient with large input data. A friend of mine once asked my help to deal with a somewhat similar problem, but involving very large data sets in the field of genetics. His program stored millions of non-overlapping ranges in a hash and was then trying to figure out whether any of several hundreds of thousands regions (effectively, also ranges) from another file overlapped with the ranges in his hash. This program essentially scanned sequentially the full hash for each region in the input file, and it would take days to complete. I suggested that, rather than using a hash for the input ranges, it would be better to use a sorted array and to implement a binary search. With dummy data (one million ranges), I showed that the search part of the program would run more than 20,000 times faster with binary search. Of course, his program was doing a number of other things, so, overall, that performance enhancement on a sample of real data was diluted to a factor of 35 (run time from 28 hours down to 50 minutes). For details, see the second part of the slides for a talk I gave on the subject at the 2018 German Perl Workshop in Cologne on this subject.

With input data of three or four ranges, it would be technological overkill to implement a binary search.

Insert Intervals in Raku

In my test range sets, the first interval is the one to be added and the rest is the input set of ranges. Thus, it would be easy to shift the first range and to place it in the proper position in the rest of the set. That’s not what I did, however, since, as noted above, the program is simply sorting the ranges (in accordance with the start of the range) and then proceeds to fix the overlapping ranges.

my @tests = [(2, 6), (1, 4), (8, 10)], [(5, 8), (1, 2), (3,7 ), (8, 10)], [(10, 11), (1, 5), (7, 9)];

for @tests <-> @test {
    say @test;
    my @sorted = sort { $_[0] }, @test;
    say @sorted;
    my @result;
    my $first = shift @sorted;
    my ($start, $end) = $first[0, 1];
    for @sorted -> $item {
        # say "[$item] $start $end ", @result;
        if $item[0] > $end {
            push @result, [$start, $end];
            # say "Temp res = ", @result;
            ($start, $end) = $item;
        } else {
            $end = $item[1];
        }
    }
    push @result, [$start, $end] unless $start == @result[*-1][0];
    say "result = ", @result, "\n";
}

This displays the following output:

$ raku interval_2.raku
[(2 6) (1 4) (8 10)]
[(1 4) (2 6) (8 10)]
result = [[1 6] [8 10]]

[(5 8) (1 2) (3 7) (8 10)]
[(1 2) (3 7) (5 8) (8 10)]
result = [[1 2] [3 10]]

[(10 11) (1 5) (7 9)]
[(1 5) (7 9) (10 11)]
result = [[1 5] [7 9] [10 11]]

Insert Intervals in Perl

This is essentially a port of the above (second) Raku program to Perl:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @tests = ([[2, 6], [1, 4], [8, 10]], [[5, 8], [1, 2], [3,7 ], [8, 10]], [[10, 11], [1, 5], [7, 9]]);

for my $test (@tests) {
    say join " ", map { "[ @$_ ]" } @$test;
    my @sorted = sort { $a->[0] <=> $b->[0] } @$test;
    say join " ", map { "[ @$_ ]" } @sorted;
    my @result;
    my $first = shift @sorted;
    my ($start, $end) = @$first;
    for my $item (@sorted) {
        # say "[$item] $start $end ", @result;
        if ($item->[0] > $end) {
            push @result, [$start, $end];
            # say "Temp res = ", @result;
            ($start, $end) = @$item;
        } else {
            $end = $item->[1];
        }
    }
    push @result, [$start, $end] unless $start == $result[-1][0];
    say "result = ", join (" ", map { "[ @$_ ]" } @result), "\n";
}

This displays essentially the same output as the Raku program:

$ perl interval.pl
[ 2 6 ] [ 1 4 ] [ 8 10 ]
[ 1 4 ] [ 2 6 ] [ 8 10 ]
result = [ 1 6 ] [ 8 10 ]

[ 5 8 ] [ 1 2 ] [ 3 7 ] [ 8 10 ]
[ 1 2 ] [ 3 7 ] [ 5 8 ] [ 8 10 ]
result = [ 1 2 ] [ 3 10 ]

[ 10 11 ] [ 1 5 ] [ 7 9 ]
[ 1 5 ] [ 7 9 ] [ 10 11 ]
result = [ 1 5 ] [ 7 9 ] [ 10 11 ]

Insert Intervals in Scala

This a port of the above Raku and Perl programs to Scala:

import Array._
object insertIntervals extends App {
  val tests =
    Array(
      Array(Array(2, 6), Array(1, 4), Array(8, 10)),
      Array(Array(5, 8), Array(1, 2), Array(3, 7)),
      Array(Array(10, 11), Array(1, 5), Array(7, 9))
    )

  for (test <- tests) {
    printArray(test)
    val sorted = test.sortWith(_(0) < _(0))
    printArray(sorted)
    var result = Array.empty[Array[Int]]
    val first = sorted(0)
    var start = first(0)
    var end = first(1)
    for (item <- sorted) {
      if (item(0) > end) {
        result = result :+ Array(start, end)
        start = item(0)
      }
      end = item(1)
    }
    result = result :+ Array(start, end)
    print("Result: ")
    printArray(result)
    println(" ")
  }
  def printArray(input: Array[Array[Int]]): Unit = {
    for (item <- input) {
      print(s"( ${item(0)} ${item(1)} ) ") 
    }
    println()
  }
}

Output:

( 2 6 ) ( 1 4 ) ( 8 10 ) 
( 1 4 ) ( 2 6 ) ( 8 10 ) 
Result: ( 1 6 ) ( 8 10 ) 

( 5 8 ) ( 1 2 ) ( 3 7 ) 
( 1 2 ) ( 3 7 ) ( 5 8 ) 
Result: ( 1 2 ) ( 3 8 ) 

( 10 11 ) ( 1 5 ) ( 7 9 ) 
( 1 5 ) ( 7 9 ) ( 10 11 ) 
Result: ( 1 5 ) ( 7 9 ) ( 10 11 )

Wrapping up

The next week Perl Weekly Challenge will start soon and will end next year, a year that we all hope will be better than this year. 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, January 3, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 91: Count Numbers and Jump Games

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

Spoiler Alert: This weekly challenge deadline is due in a few days (December 20, 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.

Task 1: Count Numbers

You are given a positive number $N.

Write a script to count number and display as you read it.

Example 1:

Input: $N = 1122234
Output: 21321314

as we read "two 1 three 2 one 3 one 4"

Example 2:

Input: $N = 2333445
Output: 12332415

as we read "one 2 three 3 two 4 one 5"

Example 3:

Input: $N = 12345
Output: 1112131415

as we read "one 1 one 2 one 3 one 4 one 5"

Count Numbers in Raku

For this task, we’re going to use the three examples provided in the task description. I first tried to look whether it could be done with a simple regex, but that quickly turned out to be a bit more complicated than I originally thought. Of course, this is quite a simple task for a Raku grammar, but I decided to avoid it because I wanted to be able to use a similar solution in Perl and in Scala. So I decided to do it the good old procedural way and to simply loop over the digits of the integer and to count the sequences.

use v6;

my @tests = <1122234 2333445 12345>;
say $_.fmt("%-10d -> "), count-numbers $_ for @tests;

sub count-numbers (Int $n) {
    my $result = "";
    my @digits = $n.comb;
    my $start = shift @digits;
    my $count = 1;
    for @digits -> $digit {
        if $digit eq $start {
            $count++;
        } else {
            $result ~= $count ~ $start;
            $count = 1;
            $start = $digit;
        }
    }
    $result ~= $count ~ $start;
}

This program displays the following output:

$ raku ./count-numbers.pl
1122234    -> 21321314
2333445    -> 12332415
12345      -> 1112131415

Count Numbers in Perl

Just as in Raku, we loop over the digits of the integer and count the sequences:

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

my @tests = qw<1122234 2333445 12345>;
say  sprintf( "%-10d -> ", $_), count_numbers($_) for @tests;

sub count_numbers {
    my $n = shift;
    my $result = "";
    my @digits = split //, $n;
    my $start = shift @digits;
    my $count = 1;
    for my $digit (@digits) {
        if ($digit eq $start) {
            $count++;
        } else {
            $result .= $count . $start;
            $count = 1;
            $start = $digit;
        }
    }
    $result .= $count . $start;
    return $result;
}

Output:

$ perl count-numbers.pl
1122234    -> 21321314
2333445    -> 12332415
12345      -> 1112131415

Count Numbers in Scala

We also loop over the digits of the integer and count the sequences. Caveat: I am a beginner in Scala (and use the Perl Weekly Challenge tasks to learn Scala), my Scala programs are certainly quite clumsy at this point. They do the job, but please don’t consider them to be good practice or idiomatic. I certainly intend to evolve towards more OO and functional programming paradigms, but at this point, I first need to get acquainted to the basic syntax. For the time being, please be kind enough to let me know if you see any errors, problems or inefficiencies in my Scala programs.

import Array._
object numCount extends App {
  val tests = List("1122234", "2333445", "12345")
  for (test <- tests) {
    println(f"$test%-10s -> ${countNumbers(test)}%s")
  }

  def countNumbers(n: String): String = {
    var result = ""
    val digits = n.split("")
    var start = digits(0)
    var count = 1
    for (i <- 1 to digits.size - 1) {
      if (digits(i).equals(start)) {
        count += 1
      } else {
        result += s"$count" + start
        count = 1;
        start = digits(i)
      }
    }
    result += s"$count" + start
    return result
  }
}

Output generated:

1122234    -> 21321314
2333445    -> 12332415
12345      -> 1112131415

Task 2: Jump Game

You are given an array of positive numbers @N, where value at each index determines how far you are allowed to jump further.

Write a script to decide if you can jump to the last index. Print 1 if you are able to reach the last index otherwise 0.

Example 1:

Input: @N = (1, 2, 1, 2)
Output: 1

as we jump one place from index 0 and then two places 
from index 1 to reach the last index.

Example 2:

Input: @N = (2,1,1,0,2)
Output: 0

it is impossible to reach the last index. as we jump 
two places from index 0 to reach index 2, followed by 
one place jump from index 2 to reach the index 3. once 
you reached the index 3, you can't go any further 
because you can only jump 0 position further.

Note that any time you reach a 0 in the process, you’re just stuck there (possibly in an infinite loop) and can’t go any further (and should print 0). I thought for a few seconds that it might be a good idea to reject any array in which any value (except the last one) is 0, but that’s wrong because we may actually jump over the 0 and eventually succeed to get to the last item of the input array. So we need to stop when we actually land on a zero value or when we get past the end of the array.

Jump Game in Raku

We first define three test cases. The jump subroutine just follows the jump game algorithm, return 0 if it landed on a zero item or if it got past the array end. And it return 1 if it landed on the array’s last element.

use v6;

my @tests = [ <1 2 1 2 > ], [ < 2 1 1 0 2 > ], [ < 1 2 1 2 1 > ];
say $_, " -> ", jump $_ for @tests;

sub jump (@in) {
    my $i = 0;
    loop {
        return 0 unless @in[$i];
        my $next_i = $i + @in[$i];
        return 1 if $next_i == @in.end;
        return 0 if $next_i > @in.end;
        $i = $next_i;
    }
}

This displays the following output:

$ raku ./jump-game.raku
[1 2 1 2] -> 1
[2 1 1 0 2] -> 0
[1 2 1 2 1] -> 0

Jump Game in Perl

Same method: The jump subroutine just follows the jump game algorithm, return 0 if it landed on a zero item or if it got past the array end. And it return 1 if it landed on the array’s last element.

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

my @tests = ([ qw<1 2 1 2 > ], [ qw< 2 1 1 0 2 > ], [ qw<1 2 1 2 1 > ]);
say "@{$_}  -> ", jump($_) for @tests;

sub jump {
    my @in = @{$_[0]};
    my $i = 0;
    while (1) {
        return 0 unless $in[$i];
        my $next_i = $i + $in[$i];
        return 1 if $next_i == $#in;
        return 0 if $next_i > $#in;
        $i = $next_i;
    }
}

Output:

$ perl jump-game.pl
1 2 1 2  -> 1
2 1 1 0 2  -> 0
1 2 1 2 1  -> 0

Jump Game in Scala

We use again the same basic algorithm:

import Array._
object jumpGame extends App {
  val tests =
    Array(Array(1, 2, 1, 2), Array(2, 1, 1, 0, 2), Array(1, 2, 1, 2, 1))
  for (test <- tests) {
    println(s"${test.mkString(" ")} -> ${jump(test)}")
  }

  def jump(in: Array[Int]): Int = {
    var i = 0;
    val max = in.size - 1
    while (i <= max) {
      if (in(i) == 0) { return 0 }
      val next_i = i + in(i);
      if (next_i == max) { return 1 }
      if (next_i > max) { return 0 }
      i = next_i;
    }
    return 0
  }
}

Output:

1 2 1 2 -> 1
2 1 1 0 2 -> 0
1 2 1 2 1 -> 0

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, December 27, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 90: DNA Sequence and Ethiopian Multiplication

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

Spoiler Alert: This weekly challenge deadline is due in a few days (December 13, 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.

Task 1: DNA Sequence

DNA is a long, chainlike molecule which has two strands twisted into a double helix. The two strands are made up of simpler molecules called nucleotides. Each nucleotide is composed of one of the four nitrogen-containing nucleobases cytosine (C), guanine (G), adenine (A) and thymine (T).

You are given DNA sequence, GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG.

Write a script to print nucleobase count in the given DNA sequence. Also print the complementary sequence where Thymine (T) on one strand is always facing an adenine (A) and vice versa; guanine (G) is always facing a cytosine (C) and vice versa.

To get the complementary sequence use the following mapping:

T => A
A => T
G => C
C => G

DNA Sequence in Raku

For the nucleotide histogram, we can comb the string into individual letters, use a hash to store the letter count and print out the hash pairs. This is a quite typical way of building histograms (but there are simpler solutions in Raku, as we shall see).

For the complementary sequence, we could use a hash to store the nucleotide mapping and use a map to perform the necessary conversion.

use v6;

my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';

# count
my %histo;
%histo{$_}++ for $dna.comb;
say "Histogram:";
.say for %histo.pairs;

# Complementary sequence
my %complement = T => 'A', A => 'T', G => 'C', C => 'G';
.say for "Complement:", $dna.comb.map({%complement{$_}}).join: '';

This displays the following output:

$ raku dna.raku
Histogram:
T => 22
A => 14
C => 18
G => 13
Complement:
CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC

This program is relatively concise, but we can do much shorter code without sacrificing legibility. Each of the subtasks can be done in just one line of code.

For the nucleotide histogram, we comb the string into individual letters, feed them into an anonymous bag and print out that bag’s pairs.

For the DNA complement, we can use the TR/// non-destructive transliteration operator:

use v6;

my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';

# count
say "Histogram:"; .say for Bag.new($dna.comb).pairs;

# Complementary sequence
say  "Complement:\n", TR/TAGC/ATCG/ with $dna;

The output is almost the same as before:

Histogram:
T => 22
A => 14
G => 13
C => 18
Complement:
CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC

DNA Sequence in Perl

This program is basically a port to Perl of a combination of the Raku programs above.

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

my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
# count
my %histogram;
$histogram{$_}++ for split '', $dna;
say "$_: $histogram{$_}" for keys %histogram;

# Complementary sequence
say for "Complement:", $dna =~ tr/TAGC/ATCG/r;

This displays the following output:

$ perl dna.pl
C: 18
G: 13
A: 14
T: 22
Complement:
CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC

Task 2: Ethiopian Multiplication

You are given two positive numbers $A and $B.

Write a script to demonstrate Ethiopian Multiplication using the given numbers.

Ethiopian multiplication (also known as ancient Egyptian multiplication, Russian multiplication, or peasant multiplication) is an ancient method for multiplying two integers that does not require the multiplication table, only the ability to multiply and divide by 2, and to add. The basic idea is to apply repeatedly integer (or Euclidean) division by 2 to the first number (discarding any remainder), and to multiply repeatedly the second number by 2, until the first number becomes 1. Then we add the values of the second number for which the corresponding first number is odd. In practical terms, to do this manually, we can set up two columns with the first number on the left and the second on the right. If we want to multiply 19 and 42, we have the following process:

1st    2nd    Action       Sum so far
19      42    kept          42
 9      84    kept         126
 4     168    discarded    126    
 2     336    discarded    126
 1     672    kept         798

On the first line, the first number (17) is odd, so we will use the second number (42) in the final summation. On the second line, the first number (9) is odd again, so we will use the second number (84) in the final summation. On the third and fourth lines, the first number (4 and 2) are even, so the second number is not used in the final sum. Finally, on the last line, the first number is 1, so the process stops there and, since 1 is odd, the second number (672) is used in the final sum. When we add the numbers of the right column where the number on the left column is odd, we have: 42 + 84 + 672 = 798, which is the product of 17 by 42.

Ethiopian Multiplication in Raku

We implement a while loop whose stopping condition is when the first number ($a) becomes equal to 1. At each iteration, we use the Raku built-in div integer division operator to halve (rounding down the result) $a et we multiply the second number ($b) by 2. We also have an accumulator, $result, which accumulate the values of $b for which the corresponding $a is an odd integer (i.e. when $a % 2 is not 0).

use v6;

my ($a, $b) = map {$_.Int}, @*ARGS;
my $result = $a % 2 ?? $b !! 0;
while $a > 1 {
    $a div= 2;
    $b *= 2;
    $result += $b if $a % 2;
}
say $result;

This are a couple of example runs:

$ raku ethiopian-mult.raku 14 12
168

$ raku ethiopian-mult.raku 19 42
798

Laurent@LAPTOP-LHI8GLRC ~
$ raku ethiopian-mult.raku 42 19
798

$ raku ethiopian-mult.raku 300 600
180000

Ethiopian Multiplication in Perl

This is a port to Perl of the Raku program above. Since Perl doesn’t have a div integer operator, we could use the standard division operator and round down the result with the int operator, but since it is a division by two, it is slightly shorter to use the >> right bit shift operator by one bit, which does an integer division by 2.

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

my ($c, $d) = @ARGV;
my $result = $c % 2 ? $d : 0;
while ($c > 1) {
    $c = $c >> 1; # right shift 1 bit = div by 2
    $d *= 2;
    $result += $d if $c % 2;
}
say $result;

These are a few example runs:

$ perl ethiopian-mult.pl 19 42
798

$ perl ethiopian-mult.pl 14 22
308

$ perl ethiopian-mult.pl 45 59
2655

Perl Weekly Challenge # 90 in Scala

In 2017, I translated into French the book Scala by Example, written by Martin Odersky, the creator of the Scala programming language. At the time, I found the language to be very interesting and fairly similar in spirit to Perl and even more to Raku, since it smoothly combines the object-oriented programming and functional programming paradigms. Although I wrote a few tiny toy programs at the time (or, rather, copied example programs and tried various changes to see what happens), I thought at the time that I probably wanted to learn the language, but never really took the time to do so. Maybe the Perl Weekly Challenge is an opportunity to start learning it. So, I dived into two tutorial books on the Internet and I started to port some of my Raku solutions to Scala over the last few weeks. It is also interesting to see with real examples how Scala compares with Raku and Perl. Caveat: I am a pure beginner in Scala, so my Scala code is certainly neither expressive, nor efficient, and even less idiomatic. It is certainly quite clumsy. Please feel free to sugggest any corrections, improvements, comments, or better practices.

DNA Sequence in Scala

We use the toCharArray to split the DNA string into an array of characters. For each character, we convert the nycleotide into its complement using a match expression. At the same time, for each letter, we increment en histo map entry for that letter.

object Dna extends App {
    import scala.collection.mutable.Map
    val dna = "GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG";
    var result = ""
    var histo:Map[Char,Int] = Map('A' -> 0, 'T' -> 0, 'C' -> 0, 'G' -> 0)
    for (char <- dna.toCharArray()) {
        // println(char)
        val charout = char match {
            case 'T' => 'A'
            case 'A' => 'T'
            case 'C' => 'G'
            case 'G' => 'C'
            case _   => char
        }
        result += char
        histo(char) += 1
    }
    println(s"Complement: $result")
    for ((k,v) <- histo) println(s"$k: $v") 
}

Output:

Complement: CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC
A: 14
C: 18
T: 22
G: 13

Ethiopian Multiplication in Scala

This is Scala port of the Raku and Perl programs above.

object Ethiopian extends App {
  mult(15, 24)

  def mult(a: Int, b: Int): Unit = {
    var (i, j) = (a, b)
    var sum = if (i % 2 != 0) j else 0
    while (i > 1) {
      i /= 2;
      j *= 2;
      if (i % 2 != 0) {
        sum += j
      }
    }
    println(s"product of $a and $b is: $sum")

  }
}
// Prints: product of 15 and 24 is: 360

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, December 20, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 89: GCD Sums and Magic Squares

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

Task 1: GCD Sums

You are given a positive integer $N.

Write a script to sum GCD of all possible unique pairs between 1 and $N.

Example 1:

Input: 3
Output: 3

gcd(1,2) + gcd(1,3) + gcd(2,3)

Example 2:

Input: 4
Output: 7

gcd(1,2) + gcd(1,3) + gcd(1,4) + gcd(2,3) + gcd(2,4) + gcd(3,4)

GCD Sums in Raku

Raku has the infix gcd operator which computes the GCD for us. Thus, chaining the compinations, gcd, map, and sum built-in routines yields a solution fitting in just one code line:

use v6;

say (1..$_).combinations(2).map({$_[0] gcd $_[1]}).sum for 1..1..@*ARGS[0];

We could also use the [] reduction metaoparator with the + operator:

say (1..$_).combinations(2).map({[gcd] $_[0,1]}).sum for 1..1..@*ARGS[0];

Both solutions lead to the following output

$ raku gcd-sum.raku 10
0
1
3
7
11
20
26
38
50
67

GCD Sums in Perl

We first implement a gcd subroutine that uses the Euclidean algorithm to compute the GCD of two numbers. We then use a doubly nested for loop to generate all pairs of numbers between 1 and the input ceiling parameter:

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

sub gcd {
        my ($i, $j) = sort { $a <=> $b } @_;
        while ($j) {
                ($i, $j) = ($j, $i % $j);
        }
        return $i;
}
my $n = shift;
my $sum = 0;
for my $i (1..$n) {
    for my $j ($i+1..$n) {
        $sum += gcd $i, $j;
    }
}
say $sum;

Task 2: Magical Matrix

Write a script to display matrix as below with numbers 1 - 9. Please make sure numbers are used once.

[ a b c ]
[ d e f ]
[ g h i ]

So that it satisfies the following:

a + b + c = 15
d + e + f = 15
g + h + i = 15
a + d + g = 15
b + e + h = 15
c + f + i = 15
a + e + i = 15
c + e + g = 15

This is more commonly known as a magic square. A square array of numbers, usually positive integers, is called a magic square if the sums of the numbers in each row, each column, and both main diagonals are the same. Albrecht Dürer’s famous engraving Melencolia I (1514) includes an order 4 square with magic sum 34.

Albrecht_Dürer_Melencolia_I.jpg

Magic Square in Raku

I originally started to write a recursive subroutine to populate the square with all possible combinations of integers between 1 and 9 (or 1 and 126 for order 4 squares. This turned out to be a bit clumsy. I changed my mind and decided to use the permutations built-in routine to generate all possible lists of 9 integers (between 1 and 9) and only after that to transform them into squares of numbers and check whether they form a magic square.

use v6;
constant \SIZE = 3;
constant \MAX = SIZE - 1;
constant \SUM = (([+] 1..SIZE*SIZE)/SIZE).Int;

my ($count-perm, $count-mat) = 0, 0;

sub print-matrix (@matrix) {
    for @matrix -> @row {
        say '[', @row.fmt("%2i").join(" "), ' ]';
    }
    say " ";
}
sub col-sum (@matrix, Int $j) {
    my $sum = 0;
    $sum += @matrix[$_][$j] if defined @matrix[$_][$j] for 0..MAX;
    return $sum;
}
sub cross_sum (@matrix) {
    my $nw2se = 0;
    $nw2se += @matrix[$_][$_] for 0..MAX;
    my $ne2sw = 0;
    $ne2sw += @matrix[$_][MAX-$_] for 0..MAX;
    return $nw2se, $ne2sw;
}
sub is-valid (@matrix) {
    for (0..MAX) -> $k {
        return False if (col-sum @matrix, $k) != SUM;
    }
    return True if SUM == all cross_sum @matrix;
    return False;
}

sub find-matrices {
    my @int-list = 1..9;
    OUT: for @int-list.permutations -> $perm {
        $count-perm++;
        my @matrix = gather {
            for $perm.Array -> $i, $j, $k {
                next OUT unless $i + $j + $k == SUM;
                take [ $i, $j, $k ];
            }
        }
        $count-mat++;
        next unless is-valid @matrix; 
        print-matrix @matrix;
        # last;
    }
}

find-matrices;   
say "Counters: $count-perm $count-mat";

Note that, for performance improvement, the find-matrices routine skips early on any matrix in which any line sum if not equal to the target sum. This way, instead of having to check 362,880 (9!) matrices, we need to verify only 2,592 of them (less than 1% of the total).

This is the output displayed by this program:

$ raku magic-square2.raku
[ 2  7  6 ]
[ 9  5  1 ]
[ 4  3  8 ]

[ 2  9  4 ]
[ 7  5  3 ]
[ 6  1  8 ]

[ 4  3  8 ]
[ 9  5  1 ]
[ 2  7  6 ]

[ 4  9  2 ]
[ 3  5  7 ]
[ 8  1  6 ]

[ 6  1  8 ]
[ 7  5  3 ]
[ 2  9  4 ]

[ 6  7  2 ]
[ 1  5  9 ]
[ 8  3  4 ]

[ 8  1  6 ]
[ 3  5  7 ]
[ 4  9  2 ]

[ 8  3  4 ]
[ 1  5  9 ]
[ 6  7  2 ]

Counters: 362880 2592

The implementation above is still way too complicated. It would be better to work all the way with one-dimension arrays, and to transform them into squares at the last moment. I don’t have time to refactor this program now, but the Perl implementation below uses this much simpler implementation (despite having no permutations built-in).

Magic Square in Perl

As noted above, this implementation does all the work on flat arrays of 9 integers, and transforms them into squares only when it is needed at the latest moment for the purpose of printing the squares that have been found to be magic.

use strict;
use warnings;
use feature "say";
use constant SUM => 15;

my @in = 1..9;
my @permutations;

sub print_matrix {
    my @matrix = ( [@{$_}[0..2]], [@{$_}[3..5]], [@{$_}[6..8]] );
    for my $row (@matrix)  {
        say "[", (map { sprintf "% 2i", $_ } @$row), " ]"; # for @$row;
    }
    say " ";
}

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub permute {
    my ($in, $left) = @_;
    if (scalar @$left == 0) {
        return 
            # lines
            if sum( @{$in}[0..2]) != SUM
            or sum( @{$in}[3..5]) != SUM
            or sum( @{$in}[6..8]) != SUM
            # columns
            or sum( @{$in}[0, 3, 6]) != SUM
            or sum( @{$in}[1, 4, 7]) != SUM
            or sum( @{$in}[2, 5, 8]) != SUM 
            # diagonals
            or sum( @{$in}[0, 4, 8]) != SUM 
            or sum( @{$in}[2, 4, 6]) != SUM;
        push @permutations, $in;
        return;
    }
    for my $candidate (@$left) {
        my @vals = @$in;
        push @vals, $candidate;
        permute(\@vals, [grep $_ != $candidate, @$left]);
    }
}

permute [], \@in;
print_matrix \$_ for @permutations;

This displays the following:

$ perl magic-square.pl
[ 2 7 6 ]
[ 9 5 1 ]
[ 4 3 8 ]

[ 2 9 4 ]
[ 7 5 3 ]
[ 6 1 8 ]

[ 4 3 8 ]
[ 9 5 1 ]
[ 2 7 6 ]

[ 4 9 2 ]
[ 3 5 7 ]
[ 8 1 6 ]

[ 6 1 8 ]
[ 7 5 3 ]
[ 2 9 4 ]

[ 6 7 2 ]
[ 1 5 9 ]
[ 8 3 4 ]

[ 8 1 6 ]
[ 3 5 7 ]
[ 4 9 2 ]

[ 8 3 4 ]
[ 1 5 9 ]
[ 6 7 2 ]

Perl Weekly Challenge # 89 in Scala

As I mentioned elsewhere, what I like in Scala is the ability to combine the object-oriented and functional programming paradigms, like Raku and to a lesser degree Perl. Please note that I am a beginner in Scala, don’t look here for idionmatic Scala or for good practices.

GCD Sum

The Scala math BigInt library has a gcd routine, but I decided to implement the gcd function (using the Euclidean algorithm) myself because I wasn’t keen on using big integers for this task. This is essentially a port to Scala of my GCD program in Perl.

object Main {
  def main(args: Array[String]): Unit = {
    val in: Int = if (args.size == 1) args(0).toInt else 10
    var sum = 0
    for (m <- 1 to in) {
      for (n <- m + 1 to in) {
        sum += gcd(m, n)
      }
    }
    println(s"Sum of GCD to $in is $sum")
  }
  def gcd(a: Int, b: Int): Int = {
    var (i, j) = (a, b)
    while (j > 0) {
      var t = i
      i = j
      j = t % j
    }
    return i
  }
}

This prints out the following output:

Sum of GCD to 10 is 67

Magic Square in Scala

This is again essentially a port to Scala of my Perl program.

import Array._
object Main {
  def main(args: Array[String]): Unit = {
    var mat = range(1, 10)
    var in = Array.empty[Int]
    permute(in, mat)
  }
  def print_matrix(a: Array[Int]): Unit = {
    println(s"[ ${a(0)} ${a(1)} ${a(2)} ]")
    println(s"[ ${a(3)} ${a(4)} ${a(5)} ]")
    println(s"[ ${a(6)} ${a(7)} ${a(8)} ]")
    println(" ")
  }
  def permute(in: Array[Int], left: Array[Int]): Unit = {
    val sum = 15
    if (left.size == 0) {
      if (
        in.slice(0, 3).sum != sum ||
        in.slice(3, 6).sum != sum ||
        in.slice(6, 9).sum != sum ||
        in(0) + in(3) + in(6) != sum ||
        in(1) + in(4) + in(7) != sum ||
        in(2) + in(5) + in(8) != sum ||
        in(0) + in(4) + in(8) != sum ||
        in(2) + in(4) + in(6) != sum 
      ) {
        return
      }
      print_matrix(in)
      return
    }
    for (candidate <- left) {
      val values: Array[Int] = in.appended(candidate)
      val newleft: Array[Int] = left.filter(_ != candidate)
      permute(values, newleft)
    }
  }
}

This program displays the following output:

[ 2 7 6 ]
[ 9 5 1 ]
[ 4 3 8 ]

[ 2 9 4 ]
[ 7 5 3 ]
[ 6 1 8 ]

[ 4 3 8 ]
[ 9 5 1 ]
[ 2 7 6 ]

[ 4 9 2 ]
[ 3 5 7 ]
[ 8 1 6 ]

[ 6 1 8 ]
[ 7 5 3 ]
[ 2 9 4 ]

[ 6 7 2 ]
[ 1 5 9 ]
[ 8 3 4 ]

[ 8 1 6 ]
[ 3 5 7 ]
[ 4 9 2 ]

[ 8 3 4 ]
[ 1 5 9 ]
[ 6 7 2 ]

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, December 13, 2020. 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.