Perl Weekly Challenge 297.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 297.
Task 1: Contiguous Array
Submitted by: Mohammad Sajid Anwar
You are given an array of binary numbers, @binary.
Write a script to return the maximum length of a contiguous subarray with an
equal number of 0 and 1.
Example 1
Input: @binary = (1, 0)
Output: 2
(1, 0) is the longest contiguous subarray with an equal number of 0 and 1.
Example 2
Input: @binary = (0, 1, 0)
Output: 2
(1, 0) or (0, 1) is the longest contiguous subarray with an equal number of 0 and 1.
Example 3
Input: @binary = (0, 0, 0, 0, 0)
Output: 0
Example 4
Input: @binary = (0, 1, 0, 0, 1, 0)
Output: 4
I can add all contiguous subarrays. Those that have an equal number of zeroes and ones have a sum that is half their length. Thus I can grep them and choose the largest.
perl -MList::Util=sum0,max -E '
@l=@ARGV;say"@l -> ",max(map {$_->[0]}grep {$_->[0]==2*$_->[1]}map{my $f=$_;
map {[$_+1-$f, sum0 @l[$f..$_]]}$f+1..@l-1}0..@l-2)//0;
' 1 0
Results:
1 0 -> 2
perl -MList::Util=sum0,max -E '
@l=@ARGV;say"@l -> ",max(map {$_->[0]}grep {$_->[0]==2*$_->[1]}map{my $f=$_;
map {[$_+1-$f, sum0 @l[$f..$_]]}$f+1..@l-1}0..@l-2)//0;
' 0 1 0
Results:
0 1 0 -> 2
perl -MList::Util=sum0,max -E '
@l=@ARGV;say"@l -> ",max(map {$_->[0]}grep {$_->[0]==2*$_->[1]}map{my $f=$_;
map {[$_+1-$f, sum0 @l[$f..$_]]}$f+1..@l-1}0..@l-2)//0;
' 0 0 0 0 0
Results:
0 0 0 0 0 -> 0
perl -MList::Util=sum0,max -E '
@l=@ARGV;say"@l -> ",max(map {$_->[0]}grep {$_->[0]==2*$_->[1]}map{my $f=$_;
map {[$_+1-$f, sum0 @l[$f..$_]]}$f+1..@l-1}0..@l-2)//0;
' 0 1 0 0 1 0
Results:
0 1 0 0 1 0 -> 4
The full code is:
1 # Perl weekly challenge 297
2 # Task 1: Contiguous Array
3 #
4 # See https://wlmb.github.io/2024/11/25/PWC297/#task-1-contiguous-array
5 use v5.36;
6 use List::Util qw(sum0 max all);
7 die <<~"FIN" unless @ARGV and all{$_==0 || $_==1}@ARGV;
8 Usage: $0 N0 N1...
9 to find the largest balanced contiguous sub array
10 from the binary (0's or 1's only) array N0 N1...
11 FIN
12 my $result = max( # get largest
13 map {$_->[0]} # get length
14 grep {$_->[0]==2*$_->[1]} # select sublist
15 map{
16 my $f=$_; # start of list
17 map {[$_+1-$f, sum0 @ARGV[$f .. $_]]} # [start, length]
18 grep {($_-$f)%2} # filter even lengths only
19 $f+1 .. @ARGV-1 # all possible remaining elements
20 } 0..@ARGV-2 # all possible first elements.
21 )//0; # default for empty case
22 say "@ARGV -> $result";
Examples:
./ch-1.pl 1 0
./ch-1.pl 0 1 0
./ch-1.pl 0 0 0 0 0
./ch-1.pl 0 1 0 0 1 0
Results:
1 0 -> 2
0 1 0 -> 2
0 0 0 0 0 -> 0
0 1 0 0 1 0 -> 4
Task 2: Semi-Ordered Permutation
Submitted by: Mohammad Sajid Anwar
You are given permutation of $n integers, @ints.
Write a script to find the minimum number of swaps needed to make the @ints
a semi-ordered permutation.
A permutation is a sequence of integers from 1 to n of length n containing
each number exactly once.
A permutation is called semi-ordered if the first number is 1 and the last
number equals n. You are ONLY allowed to pick adjacent elements and swap them.
Example 1
Input: @ints = (2, 1, 4, 3)
Output: 2
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)
Example 2
Input: @ints = (2, 4, 1, 3)
Output: 3
Swap 4 <=> 1 => (2, 1, 4, 3)
Swap 2 <=> 1 => (1, 2, 4, 3)
Swap 4 <=> 3 => (1, 2, 3, 4)
Example 3
Input: @ints = (1, 3, 2, 4, 5)
Output: 0
Already a semi-ordered permutation.
If the minimum occupies the n-th position, (counting from 0)
n permutations are required to bring it to the first position. If the
maximum occupies the m-th position, N-1-m permutations are required to
bring it to the last position. Here, N is the length of the array.
If m<n, then on of this permutations
would have already been made when moving the minimum, so I have to
subtract one from the total n+N-1. I use minmax_by from
List::AllUtils to get the indices of the minimum and maximum values.
This yields a oneliner.
Example 1:
perl -MList::AllUtils=minmax_by -E '
@l=@ARGV; ($s,$l)=minmax_by{$l[$_]}0..@l-1; say "@l -> ", $s+@l-1-$l-($l<$s);
' 2 1 4 3
Results:
2 1 4 3 -> 2
Example 2:
perl -MList::AllUtils=minmax_by -E '
@l=@ARGV; ($s,$l)=minmax_by{$l[$_]}0..@l-1; say "@l -> ", $s+@l-1-$l-($l<$s);
' 2 4 1 3
Results:
2 4 1 3 -> 3
Example 3:
perl -MList::AllUtils=minmax_by -E '
@l=@ARGV; ($s,$l)=minmax_by{$l[$_]}0..@l-1; say "@l -> ", $s+@l-1-$l-($l<$s);
' 1 3 2 4 5
Results:
1 3 2 4 5 -> 0
The full code is
1 # Perl weekly challenge 297
2 # Task 2: Semi-Ordered Permutation
3 #
4 # See https://wlmb.github.io/2024/11/25/PWC297/#task-2-semi-ordered-permutation
5 use v5.36;
6 use List::AllUtils qw(minmax_by);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N0 N1...
9 to count permutations needed for the list (N0 N1...) to become
10 semiordered.
11 FIN
12 my ($min_index, $max_index) = minmax_by {$ARGV[$_]} 0..@ARGV-1;
13 my $result = $min_index + @ARGV -1 - $max_index -
14 ($max_index < $min_index);
15 say "@ARGV -> $result";
Examples:
./ch-2.pl 2 1 4 3
./ch-2.pl 2 4 1 3
./ch-2.pl 1 3 2 4 5
Results:
2 1 4 3 -> 2
2 4 1 3 -> 3
1 3 2 4 5 -> 0
I test now some border cases:
./ch-2.pl 1 2
./ch-2.pl 1 1
./ch-2.pl 1
Results:
1 2 -> 0
1 1 -> 0
1 -> 0
/;
Written on November 25, 2024