Perl Weekly Challenge 228.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 228.
Task 1: Unique Sum
Submitted by: Mohammad S Anwar
You are given an array of integers.
Write a script to find out the sum of unique elements in the given array.
Example 1
Input: @int = (2, 1, 3, 2)
Output: 4
In the given array we have 2 unique elements (1, 3).
Example 2
Input: @int = (1, 1, 1, 1)
Output: 0
In the given array no unique element found.
Example 3
Input: @int = (2, 1, 3, 4)
Output: 10
In the given array every element is unique.
I use a hash to count how many times an element appears, and then I use it to filter the unique elements which are then summed.
Example 1:
perl -MList::Util=sum0 -E '++$s{$_} for @ARGV; say "@ARGV -> ", sum0 grep {$s{$_}==1} @ARGV' 2 1 3 2
Results:
2 1 3 2 -> 4
For fun, I write an alternative solution that reads left to right using the
autobox::Core module:
perl -Mautobox::Core -E '++$s{$_} for @ARGV; say "@ARGV -> ", @ARGV->grep(sub {$s{$_}==1})->sum' 2 1 3 2
Results:
2 1 3 2 -> 4
It looks nice, but is slightly longer.
Example 2:
perl -MList::Util=sum0 -E '++$s{$_} for @ARGV; say "@ARGV -> ", sum0 grep {$s{$_}==1} @ARGV' 1 1 1 1
Results:
1 1 1 1 -> 0
Example 3:
perl -MList::Util=sum0 -E '++$s{$_} for @ARGV; say "@ARGV -> ", sum0 grep {$s{$_}==1} @ARGV' 2 1 3 4
Results:
2 1 3 4 -> 10
The full code is similar.
1 # Perl weekly challenge 228
2 # Task 1: Unique Sum
3 #
4 # See https://wlmb.github.io/2023/07/31/PWC228/#task-1-unique-sum
5 use v5.36;
6 use List::Util qw(sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage $0 N1 [N2... ]
9 to sum unique elements of the array (N1 N2...)
10 FIN
11 my %count;
12 ++$count{$_} for @ARGV;
13 say "@ARGV -> ", sum0 grep {$count{$_}==1} @ARGV
Example:
./ch-1.pl 2 1 3 2
./ch-1.pl 1 1 1 1
./ch-1.pl 2 1 3 4
Results:
2 1 3 2 -> 4
1 1 1 1 -> 0
2 1 3 4 -> 10
Task 2: Empty Array
Submitted by: Mohammad S Anwar
You are given an array of integers in which all elements are unique.
Write a script to perform the following operations until the array is
empty and return the total count of operations.
If the first element is the smallest then remove it otherwise move it
to the end.
Example 1
Input: @int = (3, 4, 2)
Ouput: 5
Operation 1: move 3 to the end: (4, 2, 3)
Operation 2: move 4 to the end: (2, 3, 4)
Operation 3: remove element 2: (3, 4)
Operation 4: remove element 3: (4)
Operation 5: remove element 4: ()
Example 2
Input: @int = (1, 2, 3)
Ouput: 3
Operation 1: remove element 1: (2, 3)
Operation 2: remove element 2: (3)
Operation 3: remove element 3: ()
I solve this problem straightforwardly by repeatedly looking for the
smallest element, rotating the array to bring it to the front and
deleting it. This may be written as a two liner using PDL.
Example 1:
perl -MPDL -E '
$x=pdl(@ARGV); $c=0; while($x->nelem>1){$m=$x->min; $r=which($x==$m)->at(0);
$c+=$r+1; $x=$x->rotate(-$r)->slice([1,-1,1]);} say "@ARGV -> ", $c+1;
' 3 4 2
Results:
3 4 2 -> 5
Example 2:
perl -MPDL -E '
$x=pdl(@ARGV); $c=0; while($x->nelem>1){$m=$x->min; $r=which($x==$m)->at(0);
$c+=$r+1; $x=$x->rotate(-$r)->slice([1,-1,1]);} say "@ARGV -> ", $c+1;
' 1 2 3
Results:
1 2 3 -> 3
I made a test with a large backwards sorted array, and I guess my solution is not that bad:
time (perl -MPDL -E '
$x=pdl(@ARGV); $c=0; while($x->nelem>1){$m=$x->min; $r=which($x==$m)->at(0);
$c+=$r+1; $x=$x->rotate(-$r)->slice([1,-1,1]);} say "@ARGV -> ", $c+1;
' `seq 20000 -1 0`) 2>&1
Results:
10000 9999 9998 ... 5 4 3 2 1 0 -> 50015001
real 0m1.601s
user 0m1.075s
sys 0m0.517s
Thus, I make a similar full code:
1 # Perl weekly challenge 228
2 # Task 2: Empty Array
3 #
4 # See https://wlmb.github.io/2023/07/31/PWC228/#task-2-empty-array
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage $0 N1 [N2...]
9 to count how many operations are required to empty the
10 array (N1 N2...)
11 FIN
12 my $x=(my $in=pdl(@ARGV))->copy;
13 my $count=0;
14 while($x->nelem>1){ # while there are two or more elements
15 my $min=$x->min;
16 my $idx=which($x==$min)->at(0); # index of minimum element
17 $count+=$idx+1; # num. of ops. to empty minimum element
18 $x=$x->rotate(-$idx) # bring smallest element to the front, rotating to the
19 # end the initial larger elements
20 ->slice([1,-1,1]); # remove smallest element, keep the rest
21 }
22 ++$count; # add the removal of the last element
23 say "$in -> $count";
Examples:
./ch-2.pl 3 4 2
./ch-2.pl 1 2 3
Results:
[3 4 2] -> 5
[1 2 3] -> 3
Written on July 31, 2023