Perl Weekly Challenge 310.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 310.
Task 1: Arrays Intersection
Submitted by: Mohammad Sajid Anwar
You are given a list of array of integers.
Write a script to return the common elements in all the arrays.
Example 1
Input: $list = ( [1, 2, 3, 4], [4, 5, 6, 1], [4, 2, 1, 3] )
Output: (1, 4)
Example 2
Input: $list = ( [1, 0, 2, 3], [2, 4, 5] )
Output: (2)
Example 3
Input: $list = ( [1, 2, 3], [4, 5], [6] )
Output: ()
I can count in a hash the apparitions of each number. Those whose
count equals the number of arrays are part of the intersection. The
only trouble would be if an element appears more than once in an
array, so I would have to eliminate repetitions before counting. I use
uniq from List::Util for that purpose. I assume each input array is given
by a space separated strings. The result fits a 1.5-liner.
perl -MList::Util=uniq -E '
@a=@ARGV; for(@a){$i{$_}++ for uniq split " ",$_}say map("[$_] ", @a),
" -> [", join " ", grep({$i{$_}==@a} keys %i), "]";
' "1 2 3 4" "4 5 6 1" "4 2 1 3"
Results:
[1 2 3 4] [4 5 6 1] [4 2 1 3] -> [4 1 ]
perl -MList::Util=uniq -E '
@a=@ARGV; for(@a){$i{$_}++ for uniq split " ",$_}say map("[$_] ", @a),
" -> [", join " ", grep({$i{$_}==@a} keys %i), "]";
' "1 0 2 3" "2 4 5" "2"
Results:
[1 0 2 3] [2 4 5] [2] -> [2 ]
perl -MList::Util=uniq -E '
@a=@ARGV; for(@a){$i{$_}++ for uniq split " ",$_}say map("[$_] ", @a),
" -> [", join " ", grep({$i{$_}==@a} keys %i), "]";
' "1 2 3" "4 5" "6"
Results:
[1 2 3] [4 5] [6] -> []
For the full code I use a hash to build my own uniq.
1 # Perl weekly challenge 310
2 # Task 1: Arrays Intersection
3 #
4 # See https://wlmb.github.io/2025/02/24/PWC310/#task-1-arrays-intersection
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S0 S1...
8 to find the intersection of the sets S0, S1..., represented by
9 space separated strings.
10 FIN
11 my %seen;
12 for(@ARGV){
13 my %set;
14 $set{$_}=1 for split " ", $_;
15 my @unique = keys %set;
16 $seen{$_}++ for @unique;
17 }
18 my @intersection = grep {$seen{$_} == @ARGV} keys %seen;
19 say map("[$_] ", @ARGV)," -> [", join(" ", @intersection), "]";
Examples:
./ch-1.pl "1 2 3 4" "4 5 6 1" "4 2 1 3"
./ch-1.pl "1 0 2 3" "2 4 5"
./ch-1.pl "1 2 3" "4 5" "6"
Results:
[1 2 3 4] [4 5 6 1] [4 2 1 3] -> [4 1]
[1 0 2 3] [2 4 5] -> [2]
[1 2 3] [4 5] [6] -> []
Task 2: Sort Odd Even
Submitted by: Mohammad Sajid Anwar
You are given an array of integers.
Write a script to sort odd index elements in decreasing order and even index elements
in increasing order in the given array.
Example 1
Input: @ints = (4, 1, 2, 3)
Output: (2, 3, 4, 1)
Even index elements: 4, 2 => 2, 4 (increasing order)
Odd index elements : 1, 3 => 3, 1 (decreasing order)
Example 2
Input: @ints = (3, 1)
Output: (3, 1)
Example 3
Input: @ints = (5, 3, 2, 1, 4)
Output: (2, 3, 4, 1, 5)
Even index elements: 5, 2, 4 => 2, 4, 5 (increasing order)
Odd index elements : 3, 1 => 3, 1 (decreasing order)
I can use the Perl Data Language PDL to operate in-place on slices of an array, yielding a simple one liner. I assume the inputs are strings that can be fed to PDL.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$p=pdl($_);map{$_->inplace->qsort}($p(0:-1:2), $p(1:-1:2)->(-1:0)); say "$_ ->$p"}
' "[4 1 2 3]" "[3 1]" "[5 3 2 1 4]"
Results:
[4 1 2 3] ->[2 3 4 1]
[3 1] ->[3 1]
[5 3 2 1 4] ->[2 3 4 1 5]
The full code is similar, with some explanation added and using
try/catch to handle possible input errors:
1 # Perl weekly challenge 310
2 # Task 2: Sort Odd Even
3 #
4 # See https://wlmb.github.io/2025/02/24/PWC310/#task-2-sort-odd-even
5 use v5.40;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 A0 A1...
10 to sort the even-indexed elements of Ai into ascending order
11 and the odd elements of Ai into descending order.
12 The expected inputs are strings that should be parsable as 1D
13 arrays by PDL.
14 FIN
15 for(@ARGV){
16 try {
17 my $pdl=pdl($_);
18 die "Expected a 1D nd-array: $_" unless $pdl->ndims==1;
19 map {$_->inplace->qsort}( # sort inplace
20 $pdl(0:-1:2), # the even-indexed members and
21 $pdl(1:-1:2)->(-1:0) # the odd-indexed and reversed members of the array
22 );
23 say "$_ ->$pdl"
24 }
25 catch($m){
26 say "$m";
27 }
28 }
Example:
./ch-2.pl "[4 1 2 3]" "[3 1]" "[5 3 2 1 4]"
Results:
[4 1 2 3] ->[2 3 4 1]
[3 1] ->[3 1]
[5 3 2 1 4] ->[2 3 4 1 5]
/;
Written on February 24, 2025