laurent_r

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.