Perl Weekly Challenge 226.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 226.
Task 1: Shuffle String
Submitted by: Mohammad S Anwar
You are given a string and an array of indices of same length as string.
Write a script to return the string after re-arranging the indices in the correct order.
Example 1
Input: $string = 'lacelengh', @indices = (3,2,0,5,4,8,6,7,1)
Output: 'challenge'
Example 2
Input: $string = 'rulepark', @indices = (4,7,3,1,0,5,2,6)
Output: 'perlraku'
I can solve this problem by splitting the input into an array and copying its characters into the given positions of the output array. This fits a one-liner:
Example 1:
perl -E '
print "@ARGV -> "; @l=split "", shift; $o[$_]=shift @l for @ARGV; say join "", @o
' lacelengh 3 2 0 5 4 8 6 7 1
Results:
lacelengh 3 2 0 5 4 8 6 7 1 -> challenge
Example 2:
perl -E '
print "@ARGV -> "; @l=split "", shift; $o[$_]=shift @l for @ARGV; say join "", @o
' rulepark 4 7 3 1 0 5 2 6
Results:
rulepark 4 7 3 1 0 5 2 6 -> perlraku
[After looking at @polettix solution, I realized there is an even more compact solution:
perl -E '
print "@ARGV -> "; @o[(@ARGV)]=split "", shift; say @o
' lacelengh 3 2 0 5 4 8 6 7 1
Results:
lacelengh 3 2 0 5 4 8 6 7 1 -> challenge
]
The full code would be similar:
1 # Perl weekly challenge 226
2 # Task 1: Shuffle String
3 #
4 # See https://wlmb.github.io/2023/07/16/PWC226/#task-1-shuffle-string
5 use v5.36;
6 die <<~"FIN" unless @ARGV >= 2;
7 Usage: $0 string p0 [p1.. ]
8 to reorder string sending its first character to position
9 p0 in output, the second to p1 and so on
10 FIN
11 my $in = shift; # input string
12 my @in = split "", $in; # as array of characters
13 die "Can't have more positions than input characters" unless @ARGV <= @in;
14 my @out; # output characters
15 $out[$_] = shift @in for @ARGV; # copy input to output array
16 my $out = join "", @out;
17 say "$in @ARGV -> $out";
Example:
./ch-1.pl lacelengh 3 2 0 5 4 8 6 7 1
./ch-1.pl rulepark 4 7 3 1 0 5 2 6
Results:
lacelengh 3 2 0 5 4 8 6 7 1 -> challenge
rulepark 4 7 3 1 0 5 2 6 -> perlraku
Task 2: Zero Array
Submitted by: Mohammad S Anwar
You are given an array of non-negative integers, @ints.
Write a script to return the minimum number of operations
to make every element equal zero.
In each operation, you are required to pick a positive number less than
or equal to the smallest element in the array, then subtract that from
each positive element in the array.
Example 1:
Input: @ints = (1, 5, 0, 3, 5)
Output: 3
operation 1: pick 1 => (0, 4, 0, 2, 4)
operation 2: pick 2 => (0, 2, 0, 0, 2)
operation 3: pick 2 => (0, 0, 0, 0, 0)
Example 2:
Input: @ints = (0)
Output: 0
Example 3:
Input: @ints = (2, 1, 4, 0, 3)
Output: 4
operation 1: pick 1 => (1, 0, 3, 0, 2)
operation 2: pick 1 => (0, 0, 2, 0, 1)
operation 3: pick 1 => (0, 0, 1, 0, 0)
operation 4: pick 1 => (0, 0, 0, 0, 0)
This may be easily solved using PDL. I can build an ndarrray with all input numbers and repeatedly remove zeroes and subtract the smallest remaining number incrementing a counter each time. This allows a oneliner solution:
Example 1:
perl -MPDL -E '
$c=0; print $x=pdl(@ARGV); ++$c, $x=$x->where($x>0), $x-=$x->min while $x->sumover>0; say " -> $c";
' 1 5 0 3 5
Results:
[1 5 0 3 5] -> 3
Example 2:
perl -MPDL -E '
$c=0; print $x=pdl(@ARGV); ++$c, $x=$x->where($x>0), $x-=$x->min while $x->sumover>0; say " -> $c";
' 2 1 4 0 3
Results:
[2 1 4 0 3] -> 4
For the full code I use an alternate solution, without the PDL magic. I order the input array and repeatedly remove the leading zeroes and subtract the first remaining number from all others until no numbers remain.
1 # Perl weekly challenge 226
2 # Task 2: Zero Array
3 #
4 # See https://wlmb.github.io/2023/07/16/PWC226/#task-2-zero-array
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N0 [N1 ...]
8 to find how many cycles are required to zero the array N0 N1...
9 FIN
10 my @sorted = grep {$_} sort {$a <=> $b} my @in=@ARGV;
11 my $count=0;
12 while(@sorted){ # Finished?
13 ++$count;
14 my $first=shift @sorted; # smallest remaining number
15 $sorted[$_]-=$first for 0..@sorted-1; # subtract from all others
16 shift @sorted while @sorted and $sorted[0]==0; # remove leading zeroes
17 }
18 say "@in -> $count";
Example:
./ch-2.pl 1 5 0 3 5
./ch-2.pl 2 1 4 0 3
Results:
1 5 0 3 5 -> 3
2 1 4 0 3 -> 4