laurent_r

These are some answers to the Week 196 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 December 25, 2022 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: Pattern 132

You are given a list of integers, @list.

Write a script to find out subsequence that respect Pattern 132. Return empty array if none found.

Pattern 132 in a sequence (a[i], a[j], a[k]) such that i < j < k and a[i] < a[k] < a[j].

Example 1

Input:  @list = (3, 1, 4, 2)
Output: (1, 4, 2) respect the Pattern 132.

Example 2

Input: @list = (1, 2, 3, 4)
Output: () since no susbsequence can be found.

Example 3

Input: @list = (1, 3, 2, 4, 6, 5)
Output: (1, 3, 2) if more than one subsequence found then return the first.

Example 4

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

Pattern 132 in Raku

The find_132 subroutine is a recursive subroutine which does different things, depending on the number of items in the partial result array passed to it.

sub find_132 (@input, @part-result) {
    # say @input, " - ", @part-result;
    given @part-result.elems {
        when 3 { return @part-result }
        when 2 {
            for 0..@input.end -> $i {
                my $ret = find_132 @input[$i^..@input.end],
                    (@part-result, @input[$i]).flat
                    if @input[$i] > @part-result[0]
                    && @input[$i] < @part-result[1];
                return $ret if $ret;
            }
        }
        when 1 {
            for 0..@input.end -> $i {
                my $ret =find_132 @input[$i^..@input.end],
                    (@part-result, @input[$i]).flat
                    if @input[$i] > @part-result[0];
                return $ret if $ret;
            }
        }
        when 0 {
            for 0..@input.end -> $i {
                my $ret = find_132(@input[$i^..@input.end],
                    (@input[$i],));
                return $ret if $ret;
            }
        }
    }
}
for <3 1 4 2>, <1 2 3 4>, <1 3 2 4 6 5>, <1 3 4 2> -> @test {
    say @test, "\t=> ", (find_132 @test, ()) // "()";
}

This program displays the following output:

$ raku  ./pattern-132.raku
(3 1 4 2)       => (1 4 2)
(1 2 3 4)       => ()
(1 3 2 4 6 5)   => (1 3 2)
(1 3 4 2)       => (1 3 2)

I’m afraid I got carried away by my love for recursive solutions. Using a recursive subroutine might in our case be overkill, or over-engineering, especially in view of the fact that we always need three steps, so that these steps can easily be hard-coded in an iterative loop. In the real life, I would probably rewrite it with an iterative approach. In the case of this challenge, I’ll simply try that option in the Perl implementation.

Pattern 132 in Perl

Using a recursive subroutine is useful when there is an unpredictable, or rather variable, number of nested loops, depending on the input data. Here, we know that we essentially need three loops, one for each integer in the output. So, rather than porting to Perl the recursive approach used in Raku, we’ll try an iterative approach with three nested hard-coded loops, which should presumably be simpler.

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

sub find_132 {
    my @in = @_;
    for my $i (0..$#in) {
        my @out = ($in[$i]);
        for my $j ($i+1..$#in) {
            next unless $in[$j] > $out[0];
            my @out2 = (@out, $in[$j]);
            for my $k ($j+1..$#in) {
                if ($in[$k] > $out2[0] 
                    and $in[$k] < $out2[1]) {
                    return @out2, $in[$k];
                }
            }
        }
    }
    return "()"; # no solution if we've got here
}
for my $test ( [<3 1 4 2>], [<1 2 3 4>], 
               [<1 3 2 4 6 5>], [<1 3 4 2>] ) {
    say "@$test \t=> ", join " ", find_132 @$test;
}

The find_123 subroutine is only is only 17 code lines (versus 30 lines for the recursive version used in the Raku implementation), so this is definitely significantly shorter, and also, I believe, simpler.

This program displays the following output:

$ perl  ./pattern-132.pl
3 1 4 2         => 1 4 2
1 2 3 4         => ()
1 3 2 4 6 5     => 1 3 2
1 3 4 2         => 1 3 2

Task 2: Range List

You are given a sorted unique integer array, @array.

Write a script to find all possible Number Range i.e [x, y] represent range all integers from x and y (both inclusive).

Each subsequence of two or more contiguous integers

Example 1

Input: @array = (1,3,4,5,7)
Output: [3,5]

Example 2

Input: @array = (1,2,3,6,7,9)
Output: [1,3], [6,7]

Example 3

Input: @array = (0,1,2,4,5,6,8,9)
Output: [0,2], [4,6], [8,9]

Range List in Raku

We loop over the input list and keep track of successive ranges.

sub find-ranges (@in) {
    my ($start, $curr);
    my @result;
    $start = $curr = @in[0];
    for 1..@in.end -> $i {
        next if @in[$i] == $start;
        if @in[$i] == $curr + 1 {
            $curr = @in[$i];
        } else {
            push @result, "[$start $curr]" 
                if $curr - $start > 0;
            $start = @in[$i];
            $curr = $start;
        }
    }
    push @result, "[$start $curr]" if $curr > $start;
    return @result.elems > 0 ?? @result !! "[]";
}
for <1 3 4 5 7>, <1 2 3 6 7 9>, <0 1 2 4 5 6 8 9>,
    <1 3 4 6 7 11 12 13>, <1 3 4 5 7 9>, <1 3 5> -> @test {
    printf "%-20s => %s\n", ~@test, ~find-ranges @test;
}

This program displays the following output:

$ raku ./find-ranges.raku
1 3 4 5 7            => [3 5]
1 2 3 6 7 9          => [1 3] [6 7]
0 1 2 4 5 6 8 9      => [0 2] [4 6] [8 9]
1 3 4 6 7 11 12 13   => [3 4] [6 7] [11 13]
1 3 4 5 7 9          => [3 5]
1 3 5                => []

Range List in Perl

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

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

sub find_ranges {
    my @in = @_;
    my ($start, $curr);
    my @result;
    $start = $curr = $in[0];
    for my $i (1..$#in) {
        next if $in[$i] == $start;
        if ($in[$i] == $curr + 1) {
            $curr = $in[$i];
        } else {
            push @result, "[$start $curr] " 
                if $curr > $start;
            $start = $in[$i];
            $curr = $start;
        }
    }
    push @result, "[$start $curr]" if $curr > $start;
    return @result > 0 ? @result : "[]";
}
for my $test ([<1 3 4 5 7>], [<1 2 3 6 7 9>], 
    [<0 1 2 4 5 6 8 9>], [<1 3 4 6 7 11 12 13>], 
    [<1 3 4 5 7 9>], [<1 3 5>]) {
    say sprintf("%-25s", "@$test => "), find_ranges @$test;
}

This program displays the following output:

$ perl ./find-ranges.pl
1 3 4 5 7 =>             [3 5]
1 2 3 6 7 9 =>           [1 3] [6 7]
0 1 2 4 5 6 8 9 =>       [0 2] [4 6] [8 9]
1 3 4 6 7 11 12 13 =>    [3 4] [6 7] [11 13]
1 3 4 5 7 9 =>           [3 5]
1 3 5 =>                 []

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