# Perl Weekly Challenge 226.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 226.

``````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  #
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
``````

``````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  #
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
``````
Written on July 16, 2023