Task — 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.

Try it 

#!/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];
    
}

Output

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)