Peter’s blog ✴ Week 196 ✴ 19 December 2022

THE WEEKLY CHALLENGE
132 and 123

The Perl Camel

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]) occurs if there exists i < j < k where a[i] < a[k] < a[j].

Examples


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)

Analysis

The obvious solution is to iterate over i, j and k in three nested loops, and that will find the answer. For the given examples, it will do so very quickly.

However, I created a 'hard' list comprising 1 .. 10000, 9999. The (only) 132 triad in this list is 1, 10000, 9999, and to do it the obvious way as described above takes tens of seconds.

Is there a better way? Given that this has been set as a challenge, the answer must be yes! First let's note that $list[$j] has to be larger than either $list[$i] or $list[$k]. So if we loop $j from 1 to $last - 1, we are looking for a $list[$i] which is less than $list[$j] and occurs where $i < $j. If no such element exists we can move on to the next $j without worrying about $k.

If we do find a possible $list[$i] we then need to see if there is a $list[$k] which is also less than $list[$j] but where $k > $j. If we find one, then we have the solution. If we still haven't found a solution, then none exists.

For my hard list, this ran in under 10 seconds.

Perl Weekly’s review

from PW issue 596

Nice and easy task analysis. There is always something to learn.

Try it 

Try running the script with any input:



example: 1, 3, 4, 2

Script


#!/usr/bin/perl

# Peter Campbell Smith - 2022-12-19
# PWC 196 task 1

use v5.28;
use utf8;
use warnings;

my (@tests, $test, @list, $j, $last, @hard, $i, $k);

# Mohammad's examples
@tests = ([3, 1, 4, 2], [1, 2, 3, 4], [1, 3, 2, 4, 6, 5], [1, 3, 4, 2]);

# loop over tests
TEST: for $test (@tests) {
    @list = @$test;
    $last = scalar @list - 1;
    
    # loop over j, which is the largest of the three
    J: for $j (1 .. $last - 1) {
        
        # find a smaller $i to the left of $j
        for $i (0 .. $j - 1) {
            if ($list[$i] < $list[$j]) {
                
                # one exists so let's see if there's a smaller $k to the right of $j
                for $k ($j + 1 .. $last) {
                    if ($list[$k] < $list[$j]) {
                        say qq[\nInput:  \@list = (] . join(', ', @list) . qq[)\nOutput: ($list[$i], $list[$j], $list[$k])];
                        next TEST;
                    }
                }
                next J;
            }
        }
    }
    say qq[\nInput:  \@list = (] . join(', ', @list) . qq[)\nOutput: none found];
    
}

17 lines of code

Output from script


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

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

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

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

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain