# Perl Weekly Challenge 196.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 196.

``````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  #
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
``````

``````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  #
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