Perl Weekly Challenge 202: Consecutive Odds and Widest Valley

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 5, 2023 at 23:59). 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: Consecutive Odds

You are given an array of integers.

Write a script to print 1 if there are THREE consecutive odds in the given array otherwise print 0.

Example 1

Input: @array = (1,5,3,6)
Output: 1

Example 2

Input: @array = (2,6,3,5)
Output: 0

Example 3

Input: @array = (1,2,3,4)
Output: 0

Example 4

Input: @array = (2,3,5,7)
Output: 1

Consecutive Odds in Raku

In Raku, we can use the %% operator to find if an integer is evenly divisible by another integer. Used with 2, we find whether an integer is odd or even. The three-odd subroutine goes through the input array and increments a counter when an item is odd, and resets the counter to 0 when an item is even. It returns 1 if the counter reaches 3 at any point in the process, and return 0 if we reach the end of the input array.

sub three-odd (@in) {
    my $count = 0;
    for @in -> $n {
        if $n %% 2 {        # Even
            $count = 0;
        } else {            # Odd
            $count++;
        }
        return 1 if $count >= 3;
    }
    return 0;
}

for <1 5 3 6>, <2 6 3 5>, <1 2 3 4>, <2 3 5 7> -> @test {
    say "@test[] => ", three-odd @test;
}

This program displays the following output:

$ raku ./three-odds.raku
1 5 3 6 => 1
2 6 3 5 => 0
1 2 3 4 => 0
2 3 5 7 => 1

Consecutive Odds in Perl

This is a port to Perl of the Raku program above. Perl doesn’t have the %% divisibility operator, but we can use the % modulo operator instead.

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

sub three_odd {
    my $count = 0;
    for my $n (@_) {
        if ($n % 2) {     # Odd
            $count++;
        } else {          # Even
            $count = 0; 
        }
        return 1 if $count >= 3;
    }
    return 0;
}

for my $test ([<1 5 3 6>], [<2 6 3 5>], 
              [<1 2 3 4>], [<2 3 5 7>]) {
    say "@$test => ", three_odd @$test;
}

This program displays the following output:

$ perl  ./three-odds.pl
1 5 3 6 => 1
2 6 3 5 => 0
1 2 3 4 => 0
2 3 5 7 => 1

Task 2: Widest Valley

Given a profile as a list of altitudes, return the leftmost widest valley. A valley is defined as a subarray of the profile consisting of two parts: the first part is non-increasing and the second part is non-decreasing. Either part can be empty.

Example 1

Input: 1, 5, 5, 2, 8
Output: 5, 5, 2, 8

Example 2

Input: 2, 6, 8, 5
Output: 2, 6, 8

Example 3

Input: 9, 8, 13, 13, 2, 2, 15, 17
Output: 13, 13, 2, 2, 15, 17

Example 4

Input: 2, 1, 2, 1, 3
Output: 2, 1, 2

Example 5

Input: 1, 3, 3, 2, 1, 2, 3, 3, 2
Output: 3, 3, 2, 1, 2, 3, 3

Widest Valley in Raku

Since either part of a valley may be missing, the input array may start with a list of ascending integers, i.e. have no left part. The first loop in the program below is designed to handle this specific case. For the other more regular cases, we look for a series of descending integers followed by a series of ascending integers. Once we’ve found a match, we store it in @temp and we replace @valley with the content of @temp if the match is wider than the precious content of @valley.

sub widest-valley (@in) {
    my (@valley, @temp);
    for 1..@in.end -> $i {     # valley with no left part
        push @valley, @in[$i-1];
        last if @in[$i] < @in[$i-1]; 
    }

    for 1..@in.end -> $i {
        my $left = True;
        for $i..@in.end -> $j {
            if $left {
                push @temp, @in[$j - 1];
                push @temp, @in[$j] and $left = False 
                    if @in[$j] > @in[$j - 1];
            } else {
                last if @in[$j] < @in[$j-1];
                push @temp, @in[$j];
            }
        }
        @valley = @temp if @temp.elems > @valley.elems;
        @temp = ();
    }
    return @valley;
}

for <1 5 5 2 8>, <1 5 5 2>, <2 6 8 5>, 
    <9 8 13 13 2 2 15 17>, <2 1 2 1 3>,
    <1 3 3 2 1 2 3 3 2> -> @test {
        say "@test[]".fmt("%-20s => "),  
            widest-valley @test;
}

This program displays the following output:

$ raku ./widest-valley.raku
1 5 5 2 8            => [5 5 2 8]
1 5 5 2              => [1 5 5]
2 6 8 5              => [2 6 8]
9 8 13 13 2 2 15 17  => [13 13 2 2 15 17]
2 1 2 1 3            => [2 1 2]
1 3 3 2 1 2 3 3 2    => [3 3 2 1 2 3 3]

Widest Valley in Perl

This is a port to Perl of the above Raku program. Please refer to that section for explanations.

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

sub widest_valley {
    my (@valley, @temp);
    for my $i (1..$#_) {     # valley with no left part
        push @valley, $_[$i-1];
        last if $_[$i] < $_[$i-1]; 
    }

    for my $i (1..$#_) {
        my $left = 1;
        for my $j ($i..$#_) {
            if ($left) {
                push @temp, $_[$j - 1];
                push @temp, $_[$j] and $left = 0 
                    if $_[$j] > $_[$j - 1];
            } else {
                last if $_[$j] < $_[$j-1];
                push @temp, $_[$j];
            }
        }
        @valley = @temp if scalar @temp > scalar @valley;
        @temp = ();
    }
    return @valley;
}

for my $test ([<1 5 5 2 8>], [<1 5 5 2>], [<2 6 8 5>], 
    [<9 8 13 13 2 2 15 17>], [<2 1 2 1 3>],
    [<1 3 3 2 1 2 3 3 2>]) {
        printf "%-20s  => ", join " ", @$test; 
        say join " ", widest_valley @$test;
}

This program displays the following output:

$ perl ./widest-valley.pl
1 5 5 2 8             => 5 5 2 8
1 5 5 2               => 1 5 5
2 6 8 5               => 2 6 8
9 8 13 13 2 2 15 17   => 13 13 2 2 15 17
2 1 2 1 3             => 2 1 2
1 3 3 2 1 2 3 3 2     => 3 3 2 1 2 3 3

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 February 12, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 201: Missing Numbers

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

You are given an array of unique numbers.

Write a script to find out all missing numbers in the range 0..$n where $n is the array size.

Example 1

Input: @array = (0,1,3)
Output: 2

The array size i.e. total element count is 3, so the range is 0..3.
The missing number is 2 in the given array.

Example 2

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

The array size is 2, therefore the range is 0..2.
The missing number is 2.

Missing Numbers in Raku

The find-missing subroutine uses the (-),%20infix%20%E2%88%96) set difference operator to find all the elements in the prescribed range that do not belong to the input array. The (-) set-difference operator implicitly coerces its operands (arrays) into Sets, so that we don’t need to explicitly perform the conversion and end up with essentially a one-liner.

sub find-missing (@in) {
    return ~(|(0..@in.elems) (-) @in).keys.sort;
}
for (0, 1, 3), (0, 1), (0, 1, 3, 5, 7, 2) -> @test {
    say  (~@test).fmt("%-15s => "), find-missing @test;
}

This program displays the following output:

$ raku ./missing-numbers.raku
0 1 3           => (2)
0 1             => (2)
0 1 3 5 7 2     => (4 6)

Missing Numbers in Perl

Although Perl doesn’t have Raku sets and set operators, it is only mildly more complex to port the idea to Perl: we can store the input array into a hash and then use a grep to find the items of the prescribed range that do not belong to the input array.

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

sub find_missing {
    my %in = map {$_ => 1} @_;
    return grep { not exists $in{$_} } 0..scalar @_;
}
for my $test ([0, 1, 3], [0, 1], [0, 1, 3, 5, 7, 2]) {
    printf "%-15s => ", "@$test";
    say map "$_ ", find_missing @$test;
}

This program displays the following output:

$ perl ./missing-numbers.pl
0 1 3           => 2
0 1             => 2
0 1 3 5 7 2     => 4 6

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 February 5, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 200: Arithmetic Slices and Seven Segment Display

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on January 22, 2023 at 23:59). 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: Arithmetic Slices

You are given an array of integers.

Write a script to find out all Arithmetic Slices for the given array of integers.

An integer array is called arithmetic if it has at least 3 elements and the differences between any three consecutive elements are the same.

Example 1

Input: @array = (1,2,3,4)
Output: (1,2,3), (2,3,4), (1,2,3,4)

Example 2

Input: @array = (2)
Output: () as no slice found.

Arithmetic Slices in Raku

The find_slices subroutine loops over the input array, computes the difference ($gap) between any two consecutive integers and checks whether the same difference can be found between the next integers.

sub find_slices (@in) {
    my @out;
    return @out if @in.elems < 3;
    for 0..@in.end - 2 -> $i {
        my $gap = @in[$i+1] - @in[$i];
        for $i+2..@in.end -> $j {
            last if @in[$j] - @in[$j-1] != $gap;
            push @out, @in[$i..$j];
        }
    }
    return @out;
}
for <1 2 3 4>, <2 5>, <3 5 7 9>, <2 5 9> -> @test {
    say (~@test).fmt("%-10s => "), find_slices @test;
}

This script displays the following output:

$ raku ./arithmetic-slices.raku
1 2 3 4    => [(1 2 3) (1 2 3 4) (2 3 4)]
2 5        => []
3 5 7 9    => [(3 5 7) (3 5 7 9) (5 7 9)]
2 5 9      => []

Arithmetic Slices in Perl

This a port to Perl of the Raku program above:

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

sub find_slices  {
    my @in = @_;
    my @out;
    # return [] if @in < 3;
    for my $i (0..$#in - 2) {
        my $gap = $in[$i+1] - $in[$i];
        for my $j ($i+2..$#in) {
            last if $in[$j] - $in[$j-1] != $gap;
            push @out, [@in[$i..$j]];
        }
    }
    return @out ? @out : [];
}
for my $test ([<1 2 3 4>], [<2 5>], [<3 4 5 6 8>],
              [<3 5 7 9>], [<2 5 9>]) {
    printf "%-10s => ", "@$test";
    say map "(@$_) ", find_slices @$test;
}

This script displays the following output:

$ perl  ./arithmetic-slices.pl
1 2 3 4    => (1 2 3) (1 2 3 4) (2 3 4)
2 5        => ()
3 4 5 6 8  => (3 4 5) (3 4 5 6) (4 5 6)
3 5 7 9    => (3 5 7) (3 5 7 9) (5 7 9)
2 5 9      => ()

Task 2: Seven Segment 200

A seven segment display is an electronic component, usually used to display digits. The segments are labeled ‘a’ through ‘g’ as shown:

lcd-display_week200.png

The encoding of each digit can thus be represented compactly as a truth table:

my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg a cdefg abc abcdefg abcfg>;

For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ enabled.

Write a program that accepts any decimal number and draws that number as a horizontal sequence of ASCII seven segment displays, similar to the following:

-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------
|        |     |  |     |
|        |     |  |     |
-------  -------  -------

To qualify as a seven segment display, each segment must be drawn (or not drawn) according to your @truth table.

The number “200” was of course chosen to celebrate our 200th week!

For the 200th week of the Perl Weekly Challenge, Ryan J Thompson, the author of this task, has decided to bring us decades backward, back in the 1970s when they started to be widely used (remember lieutenant Theo Kojak’s LED watch?). We’re actually driven back more than decades, since the first seven-segment display devices date as far back as 1903 (but obviously did not use LEDs).

The difficulty in this task is that, for ASCII art display, we need to slice the digits into horizontal lines. I’ve decided not to use the suggested truth table, as this is quite unpractical. Instead, I’m using a table (@nums) dividing each digit into seven horizontal lines

Seven Segment Display in Raku

my %c;                   # ascii coding of digit's slices
%c<h> = "-" x 7;         # Horizontal line
%c<l> = "|      ";       # Vertical bar, left
%c<r> = "      |";       # Vertical bar, right
%c<2> = "|     |";       # 2 vertical bars
%c<n> = " " x 7;         # empty horizontal line

my @nums =               # Digit horizontal slices
    <h 2 2 n 2 2 h>,     # 0
    <n r r n r r n>,     # 1
    <h r r h l l h>,     # 2
    <h r r h r r h>,     # 3
    <n l l h 2 2 n>,     # 4
    <h l l h r r h>,     # 5
    <n l l h 2 2 h>,     # 6
    <h r r n r r n>,     # 7
    <h 2 2 h 2 2 h>,     # 8
    <h 2 2 h r r n>;     # 9

sub display ($num) {
    my @digits = $num.comb;
    for 0..6 -> $l {     # Lines 0 to 6 iof the display
        say join "  ", map {%c{@nums[$_][$l]}}, @digits;
    }
}

for <200 2023 01234 56789> -> $test {
  display $test;
}

This program displays the following output:

$ raku ./seven_segments.raku

-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------
|        |     |  |     |
|        |     |  |     |
-------  -------  -------
-------  -------  -------  -------
      |  |     |        |        |
      |  |     |        |        |
-------           -------  -------
|        |     |  |              |
|        |     |  |              |
-------  -------  -------  -------
-------           -------  -------
|     |        |        |        |  |     |
|     |        |        |        |  |     |
                  -------  -------  -------
|     |        |  |              |        |
|     |        |  |              |        |
-------           -------  -------  -------
|        |              |  |     |  |     |
|        |              |  |     |  |     |
-------  -------           -------  -------
      |  |     |        |  |     |        |
      |  |     |        |  |     |        |
-------  -------           -------

Note that digits 6 and 9 could have an additional horizontal bar and 7 an additional vertical bar:

@nums[6] = <h l l h 2 2 h>;    # 6
@nums[7] = <h 2 2 n r r n>;    # 7
@nums[9] = <h 2 2 h r r h>;    # 9

This allegedly provides a more legible display (for some eyes, at least). Thus, the test line with the last five digits would be displayed like so:

-------  -------  -------  -------  -------
|        |        |     |  |     |  |     |
|        |        |     |  |     |  |     |
-------  -------           -------  -------
      |  |     |        |  |     |        |
      |  |     |        |  |     |        |
-------  -------           -------  -------

Seven Segment Display in Perl

This a port to Perl of the Raku program above:

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

my %c;                   # ascii coding of digit's slices
$c{'h'} = "-" x 7;       # Horizontal line
$c{'l'} = "|      ";     # Vertical bar, left
$c{'r'} = "      |";     # Vertical bar, right
$c{'2'} = "|     |";     # 2 vertical bars
$c{'n'} = " " x 7;       # empty horizontal line

my @nums = (             # Digit hoirizontal slices
    [<h 2 2 n 2 2 h>],   # 0
    [<n r r n r r n>],   # 1
    [<h r r h l l h>],   # 2
    [<h r r h r r h>],   # 3
    [<n 2 2 h r r n>],   # 4
    [<h l l h r r h>],   # 5
    [<n l l h 2 2 h>],   # 6
    [<h r r n r r n>],   # 7
    [<h 2 2 h 2 2 h>],   # 8
    [<h 2 2 h r r n>]);  # 9


sub display{
    my @digits = split //, shift;
    for my $l (0..6) {
        say join "  ", map {$c{$nums[$_][$l]}} @digits;
    }
}

for my $test (<200 2023 01234 56789>) {
  display $test;
}

This program displays the following output:

$ perl  ./seven_segments.pl
-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------                  
|        |     |  |     |
|        |     |  |     |
-------  -------  -------
-------  -------  -------  -------
      |  |     |        |        |
      |  |     |        |        |
-------           -------  -------
|        |     |  |              |
|        |     |  |              |
-------  -------  -------  -------
-------           -------  -------
|     |        |        |        |  |     |
|     |        |        |        |  |     |
                  -------  -------  -------
|     |        |  |              |        |
|     |        |  |              |        |
-------           -------  -------
-------           -------  -------  -------
|        |              |  |     |  |     |
|        |              |  |     |  |     |
-------  -------           -------  -------
      |  |     |        |  |     |        |
      |  |     |        |  |     |        |
-------  -------           -------

We could use the changes that we did to the Raku program (definition of digits 6, 7, and 9) to presumably improve their legibility:

-------  -------  -------  -------  -------
|        |        |     |  |     |  |     |
|        |        |     |  |     |  |     |
-------  -------           -------  -------
      |  |     |        |  |     |        |
      |  |     |        |  |     |        |
-------  -------           -------  -------

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 January 29, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 199: Good Pairs and Good Triplets

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 15, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Contrary to usual, I started with the Perl implementations this week (not having Raku installed on the computer where I started to work on the challenge). So I’ll present the Perl implementations first.

Task 1: Good Pairs

You are given a list of integers, @list.

Write a script to find the total count of Good Pairs.

A pair (i, j) is called good if list[i] == list[j] and i < j.

Example 1

Input: @list = (1,2,3,1,1,3)
Output: 4

There are 4 good pairs found as below:
(0,3)
(0,4)
(3,4)
(2,5)

Example 2

Input: @list = (1,2,3)
Output: 0

Example 3 Input: @list = (1,1,1,1) Output: 6

Good pairs are below:
(0,1)
(0,2)
(0,3)
(1,2)
(1,3)
(2,3)

Good Pairs in Perl

The program uses two nested loops to get pairs ($i, $j) of indices in the proper range, in such a way that i < j. And it increments the $count variable whenever this index pair leads to equal values.

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

sub count_good_pairs {
    my @in = @_;
    my $count = 0;
    for my $i (0..$#in-1) {
        for my $j ($i+1..$#in) {
            $count++ if $in[$i] == $in[$j];
        }
    }
    return $count;
}

for my $test ( [1,2,3,1,1,3], [1,2,3], [1,1,1,1], 
               [1,2,3,1,2,3], [4,3,2,3,2,1] ) {
    say sprintf "%-15s => %d", "@$test", count_good_pairs @$test;
}

This program displays the following output:

$ perl ./good_pairs.pl
1 2 3 1 1 3     => 4
1 2 3           => 0
1 1 1 1         => 6
1 2 3 1 2 3     => 3
4 3 2 3 2 1     => 2

Good Pairs in Raku

This is a port to Raku of the Perl program above:

sub count_good_pairs (@in) {
    my $cnt = 0;
    for 0..^@in.end -> $i {
        $cnt++ if @in[$i] == @in[$_] for $i+1..@in.end;
    }
    return $cnt;
}

for <1 2 3 1 1 3>,  <1 2 3>,  <1 1 1 1>,   
    <1 2 3 1 2 3>,  <4 3 2 3 2 1> -> @test {
    say (~@test).fmt("%-15s => "), count_good_pairs @test;
}

This program displays the following output:

$ raku ./good_pairs.raku
1 2 3 1 1 3     => 4
1 2 3           => 0
1 1 1 1         => 6
1 2 3 1 2 3     => 3
4 3 2 3 2 1     => 2

Task 2: Good Triplets

You are given an array of integers, @array and three integers $x,$y,$z.

Write a script to find out total Good Triplets in the given array.

A triplet array[i], array[j], array[k] is good if it satisfies the following conditions: a) 0 <= i < j < k <= n (size of given array) b) abs(array[i] - array[j]) <= x c) abs(array[j] - array[k]) <= y d) abs(array[i] - array[k]) <= z

Example 1

Input: @array = (3,0,1,1,9,7) and $x = 7, $y = 2, $z = 3
Output: 4

Good Triplets are as below:
(3,0,1) where (i=0, j=1, k=2)
(3,0,1) where (i=0, j=1, k=3)
(3,1,1) where (i=0, j=2, k=3)
(0,1,1) where (i=1, j=2, k=3)

Example 2

Input: @array = (1,1,2,2,3) and $x = 0, $y = 0, $z = 1
Output: 0

Good Triplets in Perl

The program works similarly to the Goof Pairs program. It uses three nested loops to get triplets ($i, $j, $k) of indices in the proper range, in such a way that i < j < k. And it increments the $count variable whenever this index triplet satisfies the conditions for $x,$y,$z.

sub count_good_triplets {
    my @in = @{$_[0]};
    my ($x, $y, $z) = @{$_[1]};
    my $count = 0;
    for my $i (0..$#in-2) {
        for my $j ($i+1..$#in-1) {
            # short-cut the $k loop if $i $j not good
            next if abs($in[$i] - $in[$j]) > $x;
            for my $k ($j+1..$#in) {
                $count++ if abs($in[$j] - $in[$k]) <= $y
                    and abs($in[$i] - $in[$k]) <= $z;
            }
        }
    }
    return $count;
}

for my $test ( [ [3,0,1,1,9,7], [7,2,3] ],
               [ [1,1,2,2,3], [0,0,1] ],
               [ [1,1,2,2,3], [1,1,2] ],
             ) {
    say sprintf "%-15s - xyz = %-10s => %d", 
                "@{@$test[0]}", "@{@$test[1]}", 
                count_good_triplets @$test;
}

This program displays the following output:

$ perl  ./good_triplets.pl
3 0 1 1 9 7     - xyz = 7 2 3      => 4
1 1 2 2 3       - xyz = 0 0 1      => 0
1 1 2 2 3       - xyz = 1 1 2      => 9

Good Triplets in Raku

This is a port to Raku of the above Perl program. Note that the management of nested data structures is significantly simpler and easier in Raku than in Perl.

sub count_good_triplets (@in, @xyz) {
    my $count = 0;
    my ($x, $y, $z) = @xyz;
    for 0..@in.end-2 -> $i {
        for $i+1..^@in.end -> $j {
            next if abs(@in[$i] - @in[$j]) > $x;
            for $j+1..@in.end -> $k {
                $count++ if abs(@in[$j] - @in[$k]) <= $y
                    && abs(@in[$i] - @in[$k]) <= $z;
            }
        }
    }
    return $count;
}

for ( <3 0 1 1 9 7>,  <7 2 3> ),
    ( <1 1 2 2 3>, <0 0 1> ),
    ( <1 1 2 2 3>, <1 1 2> ) -> @test {

    say sprintf "%-15s - xyz = %-10s => %d", 
                "@test[0]", "@test[1]", 
                count_good_triplets @test[0], @test[1];
}

This program displays the following output:

raku ./good_triplets.raku
3 0 1 1 9 7     - xyz = 7 2 3      => 4
1 1 2 2 3       - xyz = 0 0 1      => 0
1 1 2 2 3       - xyz = 1 1 2      => 9

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 January 22, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 198: Max Gap and Prime Count

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

Spoiler Alert: This weekly challenge deadline is due in a few of days from now (on January 8, 2023 at 23:59). 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: Max Gap

You are given a list of integers, @list.

Write a script to find the total pairs in the sorted list where 2 consecutive elements has the max gap. If the list contains less than 2 elements then return 0.

Example 1

Input:  @list = (2,5,8,1)
Output: 2

Since the sorted list (1,2,5,8) has 2 such pairs (2,5) and (5,8)

Example 2

Input: @list = (3)
Output: 0

Max Gap in Raku

The max-gap subroutine builds a hash (%gaps) mapping computed gaps to a list of the ranges leading to this gap and finally returns the size of the list of corresponding ranges.

sub max-gap (@in) {
    return 0 if @in.elems < 2;
    my @sorted = sort @in;
    my %gaps;
    for 1..@sorted.end -> $i {
        push %gaps, ( @sorted[$i] - @sorted[$i-1] => $i );
    }
    my $max-gap = %gaps.keys.max;
    return %gaps{$max-gap}.elems;
}
for <2 5 8 1>, <2 7>, (3,), <12 2 6 5 15 9> -> @test { 
    say (~@test).fmt("%-20s => "), max-gap @test;
}

This program displays the following output:

$ raku ./maximum-gap.raku
2 5 8 1              => 2
2 7                  => 1
3                    => 0
12 2 6 5 15 9        => 4

Max Gap in Perl

This is port to Perl of the above Raku program:

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

sub max_gap  {
    return 0 if scalar @_ < 2;
    my @sorted = sort { $a <=> $b } @_;
    my %gaps;
    for my $i (1..$#sorted) {
        push @{$gaps{$sorted[$i] - $sorted[$i-1]}}, $i;
    }
    my $max_gap = 0;
    for my $k (keys %gaps) {
        $max_gap = $k if $k > $max_gap;
    }
    return scalar @{$gaps{$max_gap}};
}
for my $test ([<2 5 8 1>], [<2 7>], [3,], [<12 2 6 5 15 9>]) { 
    printf "%-20s => %d\n", "@$test", max_gap @$test;
}

This program displays the following output:

$ perl ./maximum-gap.pl
2 5 8 1              => 2
2 7                  => 1
3                    => 0
12 2 6 5 15 9        => 4

Task 2: Prime Count

You are given an integer $n > 0.

Write a script to print the count of primes less than $n.

Example 1

Input: $n = 10
Output: 4 as in there are 4 primes less than 10 are 2, 3, 5 ,7.

Example 2

Input: $n = 15
Output: 6

Example 3

Input: $n = 1
Output: 0

Example 4

Input: $n = 25
Output: 9

With more information about the aim of the exercise, we may want to store in a cache the number of primes below a given integer, in order to avoid duplicate work. Here, with no information and given the small size of the input integers, it’s not worth the effort.

Prime Count in Raku

Raku has a very fast built-in is-prime method. So we just grep prime numbers and count them. The count-primes subroutine is essentially a one-liner.

sub count-primes (Int $n) {
    return (grep ({.is-prime}), 1..$n).elems;
}
for <10 15 1 25> -> $i {
    say "$i \t => ", count-primes $i;
}

This program displays the following output:

$ raku ./prime-count.raku
10       => 4
15       => 6
1        => 0
25       => 9

Prime Count in Perl

This Perl version is essentially the same as the Raku implementation above, except that we had to roll out our own is_prime subroutine. Since we are running this program with only a small set of small input integer, there is really no need to try to aggressively optimize is_prime for performance.

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

sub is_prime {
    my $num = shift;
    for my $i (2 .. $num ** .5) {
        return 0 if $num % $i == 0;
    }
    return 1;
}
sub count_primes {
    my $n = shift;
    return scalar grep is_prime($_), 2..$n;
}
for my $i (<10 15 1 25>) {
    say "$i \t => ", count_primes $i;
}

This program displays the following output:

$ perl ./prime-count.pl
10       => 4
15       => 6
1        => 0
25       => 9

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 January 15, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.