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

Spoiler Alert: This weekly challenge deadline is due on August 1, 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: Ugly Numbers

You are given an integer $n >= 1.

Write a script to find the $nth element of Ugly Numbers.

Ugly numbers are those number whose prime factors are 2, 3 or 5. For example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10, 12.

Example

Input: $n = 7
Output: 8

Input: $n = 10
Output: 12

Ugly Numbers in Raku

The is-ugly subroutine finds whether its input value is ugly by dividing it by 2, 3 and 5 as long as it can do it evenly. At the end, the number is ugly if the end result is 1.

The program then simply builds an infinite lazy list of ugly numbers. The nth ` ugly number is just the nth number of that list.

use v6;

sub is-ugly (UInt $in is copy where * > 0) {
    for 2, 3, 5 -> $div {
        $in div= $div while $in %% $div;
    }
    return $in == 1;
}
my $ugly-nrs = grep {is-ugly $_}, (1...Inf);
my $n = @*ARGS[0] // 7;
say $ugly-nrs[$n-1];

Some sample executions:

$ raku ./ugly-nrs.raku
8
-
$ raku ./ugly-nrs.raku 10
12
-
$ raku ./ugly-nrs.raku 100
1536

Ugly Numbers in Perl

The is-ugly subroutine is essentially similar to its counterpart in Raku: it finds whether its input value is ugly by dividing it by 2, 3 and 5 as long as it can do it evenly. At the end, the number is ugly if the end result is 1.

The rest or the program is quite different because there is no lazy list in Perl. So we basically use an infinite loop and test the successive integers for ugliness. The program counts the ugly numbers, and it prints out the number and exits the loop when the target range is reached.

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

sub is_ugly {
    my $in = shift;
    for my $div (2, 3, 5) {
        $in /= $div while $in % $div == 0;
    }
    return $in == 1;
}

my $n = shift // 7;
my $i = 0;
my $count = 0;
while (1) {
    $count ++;
    $i++ if is_ugly $count;
    say $count and last if $i == $n
}

Some sample executions:

$ perl ./ugly-nrs.pl
8

$ perl ./ugly-nrs.pl 10
12

$ perl ./ugly-nrs.pl 100
1536

Ugly Numbers in Scala

In Scala, we also use a while loop.

object root extends App {
  def isUgly(in: Int): Boolean = {
    var cpy = in
    val div = List(2, 3, 5);
    for (i <- div) {
      while (cpy % i == 0) {
        cpy = cpy / i
      }
    }
    if (cpy == 1) { return true }
    return false
  }
  val n = 7
  var j = 0
  var k = 0
  while (k <= n) {
    j = j + 1
    if (isUgly(j)) {
      k = k + 1
      // println(k)
      if (k == n) { println(k) }
    }
  }
}

With the hard-coded input value of 7, the program duly prints 8, the 7th ugly number.

Ugly Numbers in Python

import sys
def isUgly(n):
    for div in [2, 3, 5]:
        while (n % div == 0):
            n = n / div;
    if n == 1: 
        return True
    return False;

count = 0
i = 0
target = int(sys.argv[1])
while count <= target:
    i += 1;
    if isUgly(i):
        count += 1;
    if count == target:
        print(i)
        break

Sample output:

$ python3 ugly-nums.py 7
8

$ python3 ugly-nums.py 10
12

$ python3 ugly-nums.py 100
1536

Task 2: Square Points

You are given coordinates of four points i.e. (x1, y1), (x2, y2), (x3, y3) and (x4, y4).

Write a script to find out if the given four points form a square.

Example:

Input: x1 = 10, y1 = 20
       x2 = 20, y2 = 20
       x3 = 20, y3 = 10
       x4 = 10, y4 = 10
Output: 1 as the given coordinates form a square.

Input: x1 = 12, y1 = 24
       x2 = 16, y2 = 10
       x3 = 20, y3 = 12
       x4 = 18, y4 = 16
Output: 0 as the given coordinates doesn't form a square.

How do we determine whether four points form a square? There is undoubtedly a number of ways to do that, but it seems to me that the easiest is to check whether the four edges of the quadrilateral are equal. The problem, though, is that we can compute 6 distances between four points, 4 or which are the edges, and two the diagonals. But we don’t know in advance which distance will be the edges and which will be the diagonals. So, essentially, for the six possible distances in a square, we expect four to be equal (the edges) and 2 others with a distance equal to the edge length multiplied by the square root of 2.

This is what we find with the distances computed in the first test case provided with the task:

([x => 10 y => 20] [x => 20 y => 20]) 10
([x => 10 y => 20] [x => 20 y => 10]) 14.142135623730951
([x => 10 y => 20] [x => 10 y => 10]) 10
([x => 20 y => 20] [x => 20 y => 10]) 10
([x => 20 y => 20] [x => 10 y => 10]) 14.142135623730951
([x => 20 y => 10] [x => 10 y => 10]) 10

It seems likely that having two values for the six distances might be sufficient. But I would rather test that one of the distance values appears four times.

Square Points in Raku

People who know me know that I am not really a great fan of object-oriented programming, but, in this case, I found that implementing a very simple Point class made some sense. The dist subroutine takes two Point objects as input parameters. Otherwise, the build4point subroutine creates four points from a list of numeric parameters.

The program computes the six possible distances between the four points, and confirm that the four points form a square if there are four distances that are equal. Note that, for “oblique” squares, it might be necessary to round the distances before comparing them, but that might lead to false squares. So there is a trade-off, and I’m not sure how to handle it. The program below doesn’t try to handle such specific cases.

use v6;

class Point {
    has $.x;    # abscissa
    has $.y;    # ordinate

    method gist { return "[x => $!x y => $!y]"}
}

sub dist (Point $a, Point $b) {
    return sqrt( ($b.x - $a.x)² + ($b.y - $a.y)² );
}

sub build4points (@in) {
    my @points;
    for @in -> $x, $y {
        push @points, Point.new(x => $x, y => $y)
    }
    return @points;
}

my @tests = <10 20 20 20 20 10 10 10>, 
            <12 24 16 10 20 12 18 18>;
for @tests -> @test {
    my @p = build4points @test;
    my %dist;
    for (@p).combinations: 2 -> $c {
        %dist{dist($c[0], $c[1])}++;
    }
    # say %dist;
    print @test, " => ";
    if any(values %dist) == 4 {say 1;} else {say 0}
}

This program displays the follwing output:

$ raku .:square-points.raku
10 20 20 20 20 10 10 10 => 1
12 24 16 10 20 12 18 18 => 0

Square Points in Perl

We are not using OO-programming in Perl, but the algorithm is essentially the same.

use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub dist {
    my ($p1, $p2) = @_;
    sqrt(($p2->{x} - $p1->{x}) ** 2 + ($p2->{y} - $p1->{y}) ** 2);
}

sub build4points {
    my @i = @_;
    my @p;
    for (1..4) {
        push @p, { x => shift, y => shift };
    }
    return @p;
}
my @tests = ( [ qw/10 20 20 20 20 10 10 10/ ],
              [ qw/12 24 16 10 20 12 18 18/ ] );
for my $test (@tests) {
    my @points = build4points(@$test);
    my %dist;
    for my $p ( [0, 1], [0, 2], [0, 3], [1, 2], [1, 3], [2, 3] ) {
        my $distance =  dist($points[$p->[0]], $points[$p->[1]]);
        $dist{$distance}++
    }
    # say Dumper \%dist;
    print "@$test => ";
    if ( grep { $_ == 4 } values %dist) {
        say 1;
    } else {
        say 0;
    }
}

This program displays the following output:

$ perl ./square-points.pl
10 20 20 20 20 10 10 10 => 1
12 24 16 10 20 12 18 18 => 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 August 8, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Spoiler Alert: This weekly challenge deadline is due in a few days, on July 25, 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: Average of Stream

You are given a stream of numbers, @N.

Write a script to print the average of the stream at every point.

Example:

Input: @N = (10, 20, 30, 40, 50, 60, 70, 80, 90, ...)
Output:      10, 15, 20, 25, 30, 35, 40, 45, 50, ...

Average of first number is 10.
Average of first 2 numbers (10+20)/2 = 15
Average of first 3 numbers (10+20+30)/3 = 20
Average of first 4 numbers (10+20+30+40)/4 = 25 and so on.

This is often called a moving average or a running average, or, more precisely in this case, a cumulative moving average, since we want to compute the mean of all data received so far.

It is of course possible to keep track of all data seen so far and, each time, to recompute the average from the whole dataset using standard formulas. However, if we have the current average and the number of values from which it was computed, it is quite easy to compute the new average with a new value. Suppose that the average of the first five values of a series is 8. This means that the sum s of the first five values was s = 5 x 8 = 40. As a new value, say 2, is taken into account, then the new sum is 42, and the new average is 42 / 6 = 7. So the rule it to multiply the current average by the current number of values, to add the new value and to divide this new sum by the new number of values, i.e. the current number of values plus 1.

Average of Stream in Raku

Implementing the rule described above is fairly straight forward. For our test, we use an infinite (lazy) arithmetic sequence with a common difference of 10 between two consecutive terms.

use v6;

my @n = 10, 20 ... Inf;
my @cum_moving_avg = @n[0];
for 1..^10 -> $i {
    @cum_moving_avg[$i] = (@cum_moving_avg[$i-1] * $i + @n[$i]) / ($i + 1);
}
say ~@cum_moving_avg;

This program displays the following output:

raku ./mvg_avg.raku
10 15 20 25 30 35 40 45 50 55

Note that, with an arithmetic sequence as input, the output sequence of moving average values is also an arithmetic sequence.

Average of Stream in Perl

This is an implementation of the same rule in Perl. We cannot use an infinite sequence in Perl, so we simply use an arithmetic sequence of 10 terms.

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

my @n = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100);
my @mvg_avg = ($n[0]);
for my $i (1..9) {
    $mvg_avg[$i] = ($mvg_avg[$i-1] * $i + $n[$i]) / ($i + 1);
}
say "@mvg_avg";

This program displays the following output:

$ perl ./mvg_mean.pl
10 15 20 25 30 35 40 45 50 55

Average of Stream in Scala

This is a port to Scala of the Raku and PPerl implementations above:

object root extends App {
  val n = Array.range(10, 101, 10) // (10, 20, ... 100)
  val mvg_avg = new Array[Int](10)
  mvg_avg(0) = n(0)
  for (i <- 1 to 9) {
    mvg_avg(i) = (mvg_avg(i - 1) * i + n(i)) / (i + 1)
  }
  println(mvg_avg.mkString(" "))
}

This program yields the following result:

10 15 20 25 30 35 40 45 50 55

Average of Stream in Python

A port to Python of the Raku and Perl versions above:

n = list(range(10, 100, 10)) # [10, 20 ... 90]
mvg = [n[0]]
for i in range(1, 9):
    mvg.append((mvg[i-1] * i + n[i])  / (i + 1))
print(mvg)

Output:

$ python3 mvg_mean.py
[10, 15.0, 20.0, 25.0, 30.0, 35.0, 40.0, 45.0, 50.0]

Average of Stream in C

Implementation of essentially the same algorithm in the C programming language. There is a slight change in the management of indices because the arguments passed to a C program start with argv[1} (since argv[0] contains the program name). Another slight change is that this program doesn’t populate an array of mean values, but prints out the average value as soon as it is found. This should lead to a smaller memory footprint (which may be useful if the stream is very large).

#include <stdio.h>
#include <stdlib.h>

int main(int argc, char *argv[]) {
    int avg = atoi(argv[1]);
    printf("%5i  ", avg);
    for (int i = 1; i < argc - 1; i++) {
        avg = (avg * i + atoi(argv[i+1])) / (i + 1);
        printf("%3i ", avg);
    };
    printf("\n");
}

Output:

$ ./a.out 10 20 30 40 50 60 70 80 90 100
10   15  20  25  30  35  40  45  50  55

Average of Stream in Awk

Again some tweaks on the management of indices because of the specific properties and behavior of arrays in awk, but essentially the same algorithm.

{ 
    avg[0] = $1;
    print $1;
    for (i = 1; i < NF; i++) { 
         avg[i] = (avg[i-1] * i + $(i+1)) / (i+1)
         print avg[i]
    }
}

Output:

$ echo '10 20 30 40 50 60 70 80 90 100
    ' | awk -f mvg_mean.awk
10
15
20
25
30
35
40
45
50
55

Average of Stream in D

The D programming language is similar to C or C°°, except that it is supposed to be more secure.

import std.stdio;
import std.math;
import std.conv;

void main(string[] args) {
    int avg = std.conv.to!int(args[1]);
    printf ("%d ", avg);
    for (int i = 1; i < args.length - 1; i++) {
        avg = (avg * i + std.conv.to!int(args[i+1])) / (i + 1);
        printf("%3d ", avg);
    }
    printf("\n");
}

Output:

$ mvg-mean.amx 10 20 30 40 50 60 70 80 90 100
10  15  20  25  30  35  40  45  5

Task 2: Basketball Points

You are given a score $S.

You can win basketball points e.g. 1 point, 2 points and 3 points.

Write a script to find out the different ways you can score $S.

Example:

Input: $S = 4
Output: 1 1 1 1
        1 1 2
        1 2 1
        1 3
        2 1 1
        2 2
        3 1

Input: $S = 5
Output: 1 1 1 1 1
        1 1 1 2
        1 1 2 1
        1 1 3
        1 2 1 1
        1 2 2
        1 3 1
        2 1 1 1
        2 1 2
        2 2 1
        2 3
        3 1 1
        3 2

Basketball Points in Raku

I initially tried to use the | and X operators and the combinations, unique and some other method invocations to try to generate the values with a single expression, but turned out to be more difficult than I expected. So, I gave up and decided to use a good old recursive subroutine (find-dist) to generate all possible solutions leading to the target value:

use v6;

my $target = @*ARGS[0] // 5;
my @vals = 1, 2, 3;

sub find-dist ($sum, @seq) {
    for @vals -> $i {
        my $new-sum = $sum + $i;
        # if $new-sum > $target, then we don't 
        # need to test other values of @vals and
        # can use return directly instead of next 
        # since these values are in ascending order
        return if $new-sum > $target;
        my @new-seq = |@seq, $i;
        if $new-sum == $target {
            say ~@new-seq;
            return;
        } else {
            find-dist($new-sum, @new-seq);
        }
    }
}
find-dist 0, ();

This displays the following output:

$ raku ./score-dist.raku
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

$ raku ./score-dist.raku 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

Basketball Points in Perl

This a port to Perl of the Raku solution using a recursive subroutine:

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

my $target = shift // 5;
my @vals = (1, 2, 3);

sub find_dist  {
    my ($sum, @seq) = @_;
    for my $i (@vals) {
        my $new_sum = $sum + $i;
        # if $new_sum > $target, then we don't 
        # need to test other values of @vals and
        # can use return instead of next 
        # since these values are in ascending order
        return if $new_sum > $target;
        my @new_seq = (@seq, $i);
        if ($new_sum == $target) {
            say ""@new_seq";
            return;
        } else {
            find_dist($new_sum, @new_seq);
        }
    }
}
find_dist 0, ();

This program generates the following output:

$ perl score-dist.pl
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

$ perl score-dist.pl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

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

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

Spoiler Alert: This weekly challenge deadline is due on July 18, 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.

You are given integers 0 <= $m <= 255 and 1 <= $n <= 8.

Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.

Example:

Input: $m = 12, $n = 3
Output: 8

Binary representation of $m = 00001100
Invert 3rd bit from the end = 00001000
Decimal equivalent of 00001000 = 8

Input $m = 18, $n = 4
Output: 26

Binary representation of $m = 00010010
Invert 4th bit from the end = 00011010
Decimal equivalent of 00011010 = 26

Invert Bit in Raku

We use the fmt method to convert the input numeral into a binary string. We could also use the base method, but the fmt method makes it possible to also specify an output format on 8 digits in one step (with leading 0’s when needed). Then we use the substr to obtain the value of the $nth bit from the right (using the *-$n subscript for that), and we use the substr-rw to modify the relevant bit. Finally, we use the parse-base to convert back the result into its numeric equivalent.

use v6;

sub invert-bit (UInt $m where * <=255, UInt $n where 1 <= * <= 8) {
    my $bin = $m.fmt("%08b");
    # say $bin;
    my $bit = $bin.substr(*-$n, 1);
    $bin.substr-rw(*-$n, 1) = $bit == 0 ?? 1 !! 0;
    # say $bin;
    return $bin.parse-base(2);
}
for 12, 3, 
    18, 4, 
    249, 1 {
    say "$^a $^b => ", invert-bit $^a, $^b;
}

This program displays the following output:

$ raku ./invert-bit.raku
12 3 => 8
18 4 => 26
249 1 => 248

Invert Bit in Perl

The Perl program is essentially a port to Perl of the Raku program above. Since Perl doesn’t have a binary string to numeral conversion, we re-use the bin2dec subroutine implemented in a previous challenge. And we use sprintf to perform decimal to binary representation conversion.

use strict;
use warnings;
use feature qw/say/;

sub bin2dec {
    my $bin = shift;
    my $sum = 0;
    for my $i (split //, $bin) {
        $sum = $sum * 2 + $i;
    }
    return $sum;
}

sub invert_bit {
    my ($m, $n) = @_;
    my $bin = sprintf "%08b", $m;
    # say $bin;
    my $bit = substr $bin, -$n, 1;
    substr $bin, -$n, 1, $bit == 0 ? 1 : 0;
    # say $bin;
    return bin2dec $bin;
}
for my $pair ( [12, 3], [18, 4], [249, 1] ) {
    say "@$pair => ", invert_bit @$pair;
}

This program displays the following output:

$ perl ./invert-bit.pl
12 3 => 8
18 4 => 26
249 1 => 248

Wrapping up

Because of my volunteer activity involvement in a Covid-19 vaccination center this weekend, I won’t have time this week to work on task 2. The traveling salesman problem has been studied in detail over decades and is not particularly difficult to understand and implement, but it does require quite a bit of coding effort for which I don’t have any free time this week.

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

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days, on July 11, 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: Swap Odd/Even Bits

You are given a positive integer $N less than or equal to 255.

Write a script to swap the odd positioned bit with even positioned bit and print the decimal equivalent of the new binary representation.

Example:

Input: $N = 101
Output: 154

Binary representation of the given number is 01 10 01 01.
The new binary representation after the odd/even swap is 10 01 10 10.
The decimal equivalent of 10011010 is 154.

Input: $N = 18
Output: 33

Binary representation of the given number is 00 01 00 10.
The new binary representation after the odd/even swap is 00 10 00 01.
The decimal equivalent of 100001 is 33.

Swap Odd/Even Bits in Raku

We use the fmt method to convert the input numeral into a binary string. We could also use the base method, but the fmt method makes it possible to also specify an output format on 8 digits in one step (with leading 0’s when needed). Then, we split the binary string into groups of two digits and swap them. Finally, we use the parse-base to convert back the result into its numeric equivalent.

use v6;

sub swap-bits (UInt $n where * <=255) {
    my $bin = $n.fmt("%08b");
    $bin ~~ s:g/(\d)(\d)/$1$0/;
    return $bin.parse-base: 2; 
}
say "$_ : ", swap-bits $_ for 101, 154, 33, 18;

This program displays the following output:

$ raku ./swap_bits.raku
101 : 154
154 : 101
33 : 18
18 : 33

Swap Odd/Even Bits in Perl

The Perl program is essentially a port to Perl of the Raku program above. Since Perl doesn’t have a binary string to numeral conversion, we re-use the bin2dec subroutine implemented last week.

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

sub bin2dec {
    my $bin = shift;
    my $sum = 0;
    for my $i (split //, $bin) {
        $sum = $sum * 2 + $i;
    }
    return $sum;
}

for my $test (101, 154, 33, 18) {   
    my $b2 = sprintf "%08b", $test;
    $b2 =~ s/(\d)(\d)/$2$1/g;
    say "$test: ", bin2dec $b2;;
}

This program displays the following output:

$ perl ./swap_bits.pl
101: 154
154: 101
33: 18
18: 33

Task 2: Clock Angle

You are given time $T in the format hh:mm.

Write a script to find the smaller angle formed by the hands of an analog clock at a given time.

HINT: A analog clock is divided up into 12 sectors. One sector represents 30 degree (360/12 = 30).

Example:

Input: $T = '03:10'
Output: 35 degree

The distance between the 2 and the 3 on the clock is 30 degree.
For the 10 minutes i.e. 1/6 of an hour that have passed.
The hour hand has also moved 1/6 of the distance between the 3 and the 4, which adds 5 degree (1/6 of 30).
The total measure of the angle is 35 degree.

Input: $T = '04:00'
Output: 120 degree

Clock Angle in Raku

The general problem is not very difficult, but, as with anything having to do with time, there is a number of edge cases making the solution more complicated than we might initially expect.

Here, we compute the angle of each hand with the origin (00h00) measured clockwise. Then we compute the absolute value of the difference. At he end, if we find an angle larger than 180, we replace it by its complement to 360.

use v6;

sub find-angle (Str $t) {
    my ($h, $m) = split /\:/, $t;
    # We compute angles in degrees from 0h00 and clockwise
    my $m-angle = $m * 6;  # or: $m * 360/60
    my $h-angle = ($h * 360/12 + $m-angle / 12) % 360;
    my $angle = abs ($m-angle - $h-angle);
    return $angle <= 180 ?? $angle !!  360 - $angle;
}
for <03:10 04:00 07:00 15:10 20:44> -> $test {
    say "$test: ", find-angle $test;
}

This is the output displayed for the built-in test cases:

$ raku ./find-angle.raku
03:10: 35
04:00: 120
07:00: 150
15:10: 35
20:44: 2

Clock Angle in Perl

This is essentially a port to Perl of the Raku program above (although I must admit that there is one edge case that I originally missed in my Raku implementation and that I corrected after having found out about it in the Perl program).

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

sub find_angle {
    my $time = shift;
    my ($h, $m) = split /:/, $time;
    # angles counted in deg clockwise from the 0/12 position
    my $m_angle = $m * 6; # or: $m * 360/60
    # for the short hand:
    #     1 hr = 360 / 12 = 30 degrees
    #     1 min = #m_angle / (360 / 30) = #m_angle /12
    my $h_angle = ($h * 30 + $m_angle / 12) % 360; 
    my $hands_angle = abs($h_angle - $m_angle);
    return  $hands_angle <= 180 ? $hands_angle : 360 - $hands_angle;
}

for my $t (qw / 03:10 04:00 07:00 15:10 18:00 /) {
    say "$t: ", find_angle $t;
}

This is the output displayed for the built-in test cases:

$ perl ./find-angle.pl
03:10: 35
04:00: 120
07:00: 150
15:10: 35
18:00: 180

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

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days, on Independence Day (July 4, 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: Swap Nibbles

You are given a positive integer $N.

Write a script to swap the two nibbles of the binary representation of the given number and print the decimal number of the new binary representation.

A nibble is a four-bit aggregation, or half an octet.

To keep the task simple, we only allow integer less than or equal to 255.

Example:

Input: $N = 101
Output: 86

Binary representation of decimal 101 is 1100101 or as 2 nibbles (0110)(0101).
The swapped nibbles would be (0101)(0110) same as decimal 86.

Input: $N = 18
Output: 33

Binary representation of decimal 18 is 10010 or as 2 nibbles (0001)(0010).
The swapped nibbles would be (0010)(0001) same as decimal 33.

Swap Nibbles in Raku

Raku has a built-in base method to convert a number to a string representation in a given base, and a parse-base method to perform the reverse operation. I thought it might be clever to use base 4 rather than base 2 to get directly two nibbles, but it turns out that it doesn’t make things any simpler than using a binary representation (as done in the Perl representation below). Note that we use the fmt("%04s") method invocation to pad the base-4 string representation with leading 0’s making the swap of the two nibbles very easy with a regex.

use v6;

for 254, 101, 18 -> $n {
    my $b4 = $n.base(4).fmt("%04s");
    # say $n.base(2).fmt("%08s");
    $b4 ~~ s/(\d**2)(\d**2)/$1$0/;
    # say $b4.parse-base(4).base(2).fmt("%08s");
    say "$n -> ", $b4.parse-base(4);
}

With the built-in test cases, this script displays the following output:

$ raku ./swap-nibbles.raku
254 -> 239
101 -> 86
18 -> 33

Swap Nibbles in Perl

In Perl, we use the built-in sprintf function to convert a number to a binary string representation. And since there is no built-in function to perform the reverse operation, we roll out our own bin2dec subroutine. Otherwise, the Perl implementation is essentially similar to the Raku implementation.

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

sub bin2dec {
    my $bin = shift;
    my $sum = 0;
    for my $i (split //, $bin) {
        $sum = $sum * 2 + $i;
    }
    return $sum;
}

for my $test (254, 101, 18) {
    my $b2 = sprintf "%08b", $test;
    $b2 =~ s/(\d{4})(\d{4})/$2$1/;
    say bin2dec $b2;;
}

This program displays the following output:

$ perl  swap-nibbles.pl
239
86
33

Task 2: Sequence without 1-on-1

Write a script to generate sequence starting at 1. Consider the increasing sequence of integers which contain only 1’s, 2’s and 3’s, and do not have any doublets of 1’s like below. Please accept a positive integer $N and print the $Nth term in the generated sequence.

1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, …

Example:

Input: $N = 5
Output: 13

Input: $N = 10
Output: 32

Input: $N = 60
Output: 2223

Sequence without 1-on-1 in Raku

In Raku, we just build an infinite lazy list representing this sequence. Since it’s a lazy list, Raku will generate only the sequence numbers needed by the program. We convert a list of consecutive integers into base-4 representations and filter out numbers containing 0’s or consecutive 1’s. Note that when we need the nth term of the series, we have to use index n - 1.

use v6;

my $seq-no_1 = grep { not /11 | 0 / }, map { $_.base(4) },
    1..Inf;
say $seq-no_1[$_ - 1] for 5, 10, 60;

This program displays the following output:

raku ./seq_123.raku
13
32
2223

Sequence without 1-on-1 in Perl

If we wanted to use the same principle in Perl, since we don’t have lazy lists, we would have to select a large enough maximum value. For example:

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

my @seq = grep { not /11/ } grep /^[1-3]+$/, 1..5000;
say $seq[$_ + 1] for (5, 10, 60);

This would display the following correct output:

$ perl seq_123.pl
22
121
2232

But this approach is not very satisfactory because we don’t know how to select a large enough value. If the selected value is too small, the program will fail, and it it is very large we might be doing a lot of useless computation.

The alternative is to build the successive terms of the sequence. We use the incr subroutine to implement the unusual counting rules. And call it as many times as needed to get the proper result:

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

sub incr {
    my @num = @{$_[0]};
    my $i = $#num;
    while ($i >= 0) {
        if ($num[$i] < 3) {
            $num[$i] ++;
            return \@num;
        } else {
            $num[$i] = 1;
            $i --;
        }
    }
    return [ 1, @num ];
}

for my $i (5, 10, 60) {
    my $res =  [0];
    for (1..$i) {
        $res = incr $res;
        $res = incr $res while (join "", @$res) =~ /11/;
    }
    say @$res;
}

This yields the same output as before:

$ perl seq_123_2.pl
13
32
2223

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