Perl Weekly Challenge 196.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 196.
Task 1: Pattern 132
Submitted by: Mohammad S Anwar
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)
I just have to enumerate in order all combinations of three elements and stop when I find the first with
the 132 pattern. To that end, I use the combinations from Algorithm::Combinatorics.
perl -MAlgorithm::Combinatorics=combinations -E 'print join " ", @ARGV, "-> ";
$c=combinations(\@ARGV, 3); while($n=$c->next){say(join " ", @$n), exit if $n->[0]<$n->[2]<$n->[1]}
say "";' 3 1 4 2
perl -MAlgorithm::Combinatorics=combinations -E 'print join " ", @ARGV, "-> ";
$c=combinations(\@ARGV, 3); while($n=$c->next){say(join " ", @$n), exit if $n->[0]<$n->[2]<$n->[1]}
say "";' 1 2 3 4
perl -MAlgorithm::Combinatorics=combinations -E 'print join " ", @ARGV, "-> ";
$c=combinations(\@ARGV, 3); while($n=$c->next){say(join " ", @$n), exit if $n->[0]<$n->[2]<$n->[1]}
say "";' 1 3 2 4 6 5
perl -MAlgorithm::Combinatorics=combinations -E 'print join " ", @ARGV, "-> ";
$c=combinations(\@ARGV, 3); while($n=$c->next){say(join " ", @$n), exit if $n->[0]<$n->[2]<$n->[1]}
say "";' 1 3 4 2
Results:
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
The full code is almost identical.
1 # Perl weekly challenge 196
2 # Task 1: Pattern 132
3 #
4 # See https://wlmb.github.io/2022/12/19/PWC196/#task-1-pattern-132
5 use v5.36;
6 use Algorithm::Combinatorics qw(combinations);
7 say(<<"FIN"), exit unless @ARGV && @ARGV>=3;
8 Usage: $0 N1 N2 N3 [N4...]
9 to find the first 132 pattern in the sequence N1 N2...
10 FIN
11 my $c=combinations(\@ARGV, 3);
12 while(my $n=$c->next){
13 say(join " ", @ARGV, "->", @$n), exit if $n->[0]<$n->[2]<$n->[1];
14 }
15 say join " ", @ARGV, "->";
Example:
./ch-1.pl 3 1 4 2
./ch-1.pl 1 2 3 4
./ch-1.pl 1 3 2 4 6 5
./ch-1.pl 1 3 4 2
Results:
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
Submitted by: Mohammad S Anwar
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]
I guess my solution won’t be the cleanest. I keep the first value of each subsequence of consecutive integers, which is finished at the end of input or when the input is larger than the next expected integer. In that case I output the first and last values of the run if they are different, and update them in preparation for the next sequence. The result fits a two-liner:
Example 1:
perl -MList::Util=pairmap -E '$p=$f=shift; say join ", ", pairmap {"[$a, $b]"} map{f($_)} @ARGV, undef;
sub f($c){@o=$f<$p?($f,$p):();return @o if !defined $c;$p=$c, return () if $c==$p+1; $f=$p=$c; return @o;}
' 1 3 4 5 7
Results:
[3, 5]
Example 2:
perl -MList::Util=pairmap -E '$p=$f=shift; say join ", ", pairmap {"[$a, $b]"} map{f($_)} @ARGV, undef;
sub f($c){@o=$f<$p?($f,$p):();return @o if !defined $c;$p=$c, return () if $c==$p+1; $f=$p=$c; return @o;}
' 1 2 3 6 7 9
Results:
[1, 3], [6, 7]
Example 3:
perl -MList::Util=pairmap -E '$p=$f=shift; say join ", ", pairmap {"[$a, $b]"} map{f($_)} @ARGV, undef;
sub f($c){@o=$f<$p?($f,$p):();return @o if !defined $c;$p=$c, return () if $c==$p+1; $f=$p=$c; return @o;}
' 0 1 2 4 5 6 8 9
Results:
[0, 2], [4, 6], [8, 9]
The corresponding full code is:
1 # Perl weekly challenge 196
2 # Task 2: Range List
3 #
4 # See https://wlmb.github.io/2022/12/19/PWC196/#task-2-range-list
5 use v5.36;
6 use List::Util qw(all pairmap);
7
8 say(<<"FIN"), exit unless @ARGV > 0;
9 Usage: $0 N1 [N2...]
10 to identify subsequences of contiguous intgers
11 FIN
12 say("Expected integer arguments"), exit unless all {/^[+-]?\d+$/} @ARGV;
13 my @input=my @rest=sort {$a <=> $b} @ARGV; # make sure list is sorted and make copies
14 my $previous=my $first=shift @rest;
15 say join " ", @input, "->",
16 pairmap {"[$a, $b]"}
17 map{subseq($_)} @rest, undef; # finish inputs with undef
18
19 sub subseq($current){ # identify and output complete contiguous subsequences
20 my @output = $first<$previous ? ($first, $previous): ();
21 return @output if
22 !defined $current # input is consumed
23 && $first < $previous; # and a range has been found
24 $previous = $current, return () if $current==$previous+1; # not done yet
25 $first=$previous=$current; # prepare next sequence
26 return @output;
27 }
Examples:
./ch-2.pl 1 3 4 5 7
./ch-2.pl 1 2 3 6 7 9
./ch-2.pl 0 1 2 4 5 6 8 9
Results:
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]
Written on December 19, 2022