Perl Weekly Challenge 294.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 294.
Task 1: Consecutive Sequence
Submitted by: Mohammad Sajid Anwar
You are given an unsorted array of integers, @ints.
Write a script to return the length of the longest consecutive elements sequence.
Return -1 if none found. The algorithm must runs in O(n) time.
Example 1
Input: @ints = (10, 4, 20, 1, 3, 2)
Output: 4
The longest consecutive sequence (1, 2, 3, 4).
The length of the sequence is 4.
Example 2
Input: @ints = (0, 6, 1, 8, 5, 2, 4, 3, 0, 7)
Output: 9
Example 3
Input: @ints = (10, 30, 20)
Output: -1
I can map each number in the array to the bounds of a the consecutive interval to which it belongs while saving the longest. As I traverse the array I update the bounds. The bounds of the inner elements are not used so they don’t have to be updated when a new element is added. It is only neccesary that the boundary themselves be correct. This yields a two-liner.
Example 1:
perl -MList::Util=max -E '
sub d($x){defined $x}$w=0;for(@ARGV){$n=$b{$_+1};$p=$b{$_-1};$l=d($p)?$p->[0]:$_;$u=d($n)?$n->[1]:
$_;$b{$l}[0]=$b{$u}[0]=$l;$b{$l}[1]=$b{$u}[1]=$u;$w=max $w,$u-$l}say "@ARGV -> ", $w?$w+1:-1
' 10 4 20 1 3 2
Results:
10 4 20 1 3 2 -> 4
Example 2:
perl -MList::Util=max -E '
sub d($x){defined $x}$w=0;for(@ARGV){$n=$b{$_+1};$p=$b{$_-1};$l=d($p)?$p->[0]:$_;$u=d($n)?$n->[1]:
$_;$b{$l}[0]=$b{$u}[0]=$l;$b{$l}[1]=$b{$u}[1]=$u;$w=max $w,$u-$l}say "@ARGV -> ", $w?$w+1:-1
' 0 6 1 8 5 2 4 3 0 7
Results:
0 6 1 8 5 2 4 3 0 7 -> 9
Example 3:
perl -MList::Util=max -E '
sub d($x){defined $x}$w=0;for(@ARGV){$n=$b{$_+1};$p=$b{$_-1};$l=d($p)?$p->[0]:$_;$u=d($n)?$n->[1]:
$_;$b{$l}[0]=$b{$u}[0]=$l;$b{$l}[1]=$b{$u}[1]=$u;$w=max $w,$u-$l}say "@ARGV -> ", $w?$w+1:-1
' 10 30 20
Results:
10 30 20 -> -1
I would have prefered to answer 1 in this case, rather than -1, as there are three (degenerate) contiguous sequences of length 1, but I did follow the problem statement.
The full code is:
1 # Perl weekly challenge 294
2 # Task 1: Consecutive Sequence
3 #
4 # See https://wlmb.github.io/2024/11/04/PWC294/#task-1-consecutive-sequence
5 use v5.36;
6 use List::Util qw(max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 N2...
9 to find the length of the longest consecutive sequence
10 that may be built from the (possibly disordered) numbers
11 N1, N2...
12 FIN
13 my $length = 0;
14 my %bounds;
15 for(@ARGV){
16 my $previous = $bounds{$_-1};
17 my $next = $bounds{$_+1};
18 my $lower = defined($previous)? $previous->[0] : $_;
19 my $upper = defined($next)? $next->[1] : $_;
20 $bounds{$lower}[0] = $bounds{$upper}[0] = $lower;
21 $bounds{$lower}[1] = $bounds{$upper}[1] = $upper;
22 $length = max $length, $upper-$lower
23 }
24 my $result = $length? $length+1 : -1;
25 say "@ARGV -> ", $result;
Examples:
./ch-1.pl 10 4 20 1 3 2
./ch-1.pl 0 6 1 8 5 2 4 3 0 7
./ch-1.pl 10 30 20
Results:
10 4 20 1 3 2 -> 4
0 6 1 8 5 2 4 3 0 7 -> 9
10 30 20 -> -1
Task 2: Next Permutation
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.
Write a script to find out the next permutation of the given array.
The next permutation of an array of integers is the next lexicographically
greater permutation of its integer.
Example 1
Input: @ints = (1, 2, 3)
Output: (1, 3, 2)
Permutations of (1, 2, 3) arranged lexicographically:
(1, 2, 3)
(1, 3, 2)
(2, 1, 3)
(2, 3, 1)
(3, 1, 2)
(3, 2, 1)
Example 2
Input: @ints = (2, 1, 3)
Output: (2, 3, 1)
Example 3
Input: @ints = (3, 1, 2)
Output: (3, 2, 1)
A simple, brute force, inefficient method would be to generate all permutations in
order until we find the current one and return the next. To that
purpose, we may use the permutations iterator from the
Algorithm::Combinatorics package, and use PDL to compare
arrays. This yields a 1.5 liner.
Example 1:
perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
$i=permutations([sort {$a <=> $b}@ARGV]); $o=pdl(@ARGV);1 while(any(pdl($i->next->@*)!=$o));
say "$o -> ", pdl($i->next->@*);
' 1 2 3
Results:
[1 2 3] -> [1 3 2]
Example 2:
perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
$i=permutations([sort {$a <=> $b}@ARGV]); $o=pdl(@ARGV);1 while(any(pdl($i->next->@*)!=$o));
say "$o -> ", pdl($i->next->@*);
' 2 1 3
Results:
[2 1 3] -> [2 3 1]
Example 3:
perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
$i=permutations([sort {$a <=> $b}@ARGV]); $o=pdl(@ARGV);1 while(any(pdl($i->next->@*)!=$o));
say "$o -> ", pdl($i->next->@*);
' 3 1 2
Results:
[3 1 2] -> [3 2 1]
For the full code I follow hints from section 4.3.1 of the book Higher Order Perl by Mark Jason Dominus. I first identify the actual permutation given, i.e., the places of the numbers I should remove from the ordered sequence to produce the given permutation, and then, increment them to get the next permutation.
1 # Perl weekly challenge 294
2 # Task 2: Next Permutation
3 #
4 # See https://wlmb.github.io/2024/11/04/PWC294/#task-2-next-permutation
5 use v5.36;
6 use List::AllUtils qw(first_index);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 N2...
9 to find the next permutation of the numbers N1 N2...
10 in lexicographic order.
11 FIN
12 sub pattern($permutation, $original){
13 my @permutation=@$permutation;
14 my @original=@$original;
15 my @result;
16 for my $n(@permutation){
17 my $first=first_index {$n == $_} @original;
18 splice @original, $first, 1;
19 push @result, $first;
20 }
21 return [@result];
22 }
23 sub next_pattern($permutation){
24 my @permutation=@$permutation;
25 my @next=reverse @permutation;
26 for(0..@next-1){
27 $next[$_]++;
28 last unless $next[$_]>$_;
29 $next[$_]=0;
30 }
31 return [reverse @next];
32 }
33 sub pattern_to_permutation($pattern, $original){
34 my @pattern=@$pattern;
35 my @original=@$original;
36 my @result;
37 for(@pattern){
38 push @result, splice @original, $_, 1;
39 }
40 return [@result];
41 }
42
43 my @permutation=@ARGV;
44 my @sorted=sort {$a <=> $b} @permutation;
45 my $pattern=pattern([@permutation],[@sorted]);
46 my $next_pattern=next_pattern($pattern);
47 my $next_permutation=pattern_to_permutation($next_pattern, [@sorted]);
48 say "@permutation -> @$next_permutation";
Example 1:
./ch-2.pl 1 2 3
Results:
1 2 3 -> 1 3 2
The sequence (1 2 3) corresponds to the ordered sequence (1 2 3) (the same) and is obtained by removing the zeroth term (1), then the zeroth term of the ordered remaining numbers (2 3) and finally the zeroth term of the remaining number (3), corresponding to the pattern 0 0 0. We increment it starting from the right, taking into account that there is only one choice for the last index, two choices for the next to last, three choices for the next to next to last, etc., obtaining the pattern 0 1 0, so we take the zeroth element (1) from the array (1 2 3), the element 1 (3) from the remaining array (2 3) and finally, the element 0 (2) from the array (2), yielding the pattern (1 3 2).
Example 2:
./ch-2.pl 2 1 3
Results:
2 1 3 -> 2 3 1
In this case, the pattern corresponding to the permutation (2 1 3) is (1 0 0), which is incremented to (1 1 0), which corresponds to the permutation (2 3 1).
Example 3:
./ch-2.pl 3 1 2
Results:
3 1 2 -> 3 2 1
I compare the performance of the full code to that of the one liner above:
(time perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
$i=permutations([sort {$a <=> $b}@ARGV]); $o=pdl(@ARGV);1 while(any(pdl($i->next->@*)!=$o));
say "$o -> ", pdl($i->next->@*);
' 10 9 8 7 6 5 4 3 1 2 ) 2>&1
(time ./ch-2.pl 10 9 8 7 6 5 4 3 1 2) 2>&1
Results:
[10 9 8 7 6 5 4 3 1 2] -> [10 9 8 7 6 5 4 3 2 1]
real 1m3.098s
user 1m3.073s
sys 0m0.016s
10 9 8 7 6 5 4 3 1 2 -> 10 9 8 7 6 5 4 3 2 1
real 0m0.017s
user 0m0.012s
sys 0m0.004s
So my first solution becomes ridiculously inefficient as the size of the array has a modest increase.
Another difference between the one liner and the full code is the tratment of the last permutation:
perl -MAlgorithm::Combinatorics=permutations -MPDL -E '
$i=permutations([sort {$a <=> $b}@ARGV]); $o=pdl(@ARGV);1 while(any(pdl($i->next->@*)!=$o));
say "$o -> ", pdl($i->next->@*);
' 3 2 1
./ch-2.pl 3 2 1
Results:
[3 2 1] -> 0
3 2 1 -> 1 2 3
The one liner didn’t find a next permutation and answered 0, while my full code started over again with the first permutation.
/;