# Perl Weekly Challenge 197.

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

``````Submitted by: Mohammad S Anwar
You are given a list of integers, @list.

Write a script to move all zero, if exists, to the end while maintaining the relative order of non-zero elements.

Example 1
Input:  @list = (1, 0, 3, 0, 0, 5)
Output: (1, 3, 5, 0, 0, 0)
Example 2
Input: @list = (1, 6, 4)
Output: (1, 6, 4)
Example 3
Input: @list = (0, 1, 0, 2, 0)
Output: (1, 2, 0, 0, 0)
``````

I can solve this challenge by sorting the input assuming that zero is larger than any non-zero number and that all non-zero numbers are equal. This fits a short oneliner:

``````perl -E 'say join " ", sort {\$a?\$b?0:-1:1} @ARGV' 1 0 3 0 0 5
perl -E 'say join " ", sort {\$a?\$b?0:-1:1} @ARGV' 1 6 4
perl -E 'say join " ", sort {\$a?\$b?0:-1:1} @ARGV' 0 1 0 2 0
``````

Results:

``````1 3 5 0 0 0
1 6 4
1 2 0 0 0
``````

The full code is almost identical:

`````` 1  # Perl weekly challenge 197
2  # Task 1:  Move Zero
3  #
5  use v5.36;
6  say(<<~"FIN"), exit unless @ARGV;
7      Usage: \$0 N1 [N2...]
8      to move all zeroes among the numbers N1, N2... towards the right,
9      keeping the order of the rest.
10      FIN
11  say join " ", @ARGV, "->", sort {\$a?\$b?0:-1:1} @ARGV;
``````

Example:

``````./ch-1.pl 1 0 3 0 0 5
./ch-1.pl 1 6 4
./ch-1.pl 0 1 0 2 0
``````

Results:

``````1 0 3 0 0 5 -> 1 3 5 0 0 0
1 6 4 -> 1 6 4
0 1 0 2 0 -> 1 2 0 0 0
``````

A more conventional and slightly faster method ((n) vs. (n) log (n)) would be to simply filter out the zeroes while counting them, adding them back at the end:

``````perl -E 'say join " ", (grep {\$_||++\$c;\$_}  @ARGV), ((0)x\$c)' 1 0 3 0 0 5
perl -E 'say join " ", (grep {\$_||++\$c;\$_}  @ARGV), ((0)x\$c)' 1 6 4
perl -E 'say join " ", (grep {\$_||++\$c;\$_}  @ARGV), ((0)x\$c)' 0 1 0 2 0
``````

Results:

``````1 3 5 0 0 0
1 6 4
1 2 0 0 0
``````

The corresponding full code is

`````` 1  # Perl weekly challenge 197
2  # Task 1:  Move Zero. Slightly faster
3  #
5  use v5.36;
6  say(<<~"FIN"), exit unless @ARGV;
7      Usage: \$0 N1 [N2...]
8      to move all zeroes among the numbers N1, N2... towards the right,
9      keeping the order of the rest.
10      FIN
11  my \$count=0;
12  say join " ", @ARGV, "->", (grep {\$_||++\$count;\$_}  @ARGV), ((0)x\$count);
``````

Example:

``````./ch-1a.pl 1 0 3 0 0 5
./ch-1a.pl 1 6 4
./ch-1a.pl 0 1 0 2 0
``````

Results:

``````1 0 3 0 0 5 -> 1 3 5 0 0 0
1 6 4 -> 1 6 4
0 1 0 2 0 -> 1 2 0 0 0
``````

``````Submitted by: Mohammad S Anwar
You are given a list of integers, @list.

Write a script to perform Wiggle Sort on the given list.

Wiggle sort would be such as list < list > list < list….

Example 1
Input: @list = (1,5,1,1,6,4)
Output: (1,6,1,5,1,4)
Example 2
Input: @list = (1,3,2,2,3,1)
Output: (2,3,1,3,1,2)
``````

I first sort the input into two arrays `@low` and `@high`, one that has elements that are not larger than the median and another that has elements that are not smaller than the median. Then I alternatively take elements from each. If `\$x` is from `@low` and `\$y` is from `@high`, then typically `\$x<\$y`. The problem is that its is possible that `\$x=\$m=\$y`, where `\$m` is the median. To minimize this problem, I `reverse` both arrays, so that `@low` starts closer to the median while `@high` ends closer to the median. If even after this rearrangement I find that some `\$x==\$y`, then there is no solution with strict inequalities.

Thus may be proved by realizing that if any solution has two consecutive ascending (descending) terms from either the `@high` or the `@low` sets, then it must also have two consecutive ascending (descending) terms from the other set. Interchanging one term from each of these yields two ascending (descending) pairs with the first term from the set `@low` (`@high`) and the second from the set `@high` (~@low). The permutation between the elements of both sets allow mapping any solution into the solution proposed here.

The code fits a two liner:

``````perl -MList::MoreUtils=pairwise -E '
my @h=sort {\$a <=> \$b} @ARGV; @l=reverse splice @h, 0, (@h+1)/2; @h=reverse @h;
say join " ", grep {\$_==\$p&&die;\$p=\$_; defined \$_} pairwise {(\$a, \$b)} @l, @h
' 1 5 1 1 6 4
``````

Results:

``````1 6 1 5 1 4
``````

Another example:

``````perl -MList::MoreUtils=pairwise -E '
my @h=sort {\$a <=> \$b} @ARGV; @l=reverse splice @h, 0, (@h+1)/2; @h=reverse @h;
say join " ", grep {\$_==\$p&&die;\$p=\$_; defined \$_} pairwise {(\$a, \$b)} @l, @h
' 1 3 2 2 3 1
``````

Results:

``````2 3 1 3 1 2
``````

Now I test a case that would seem to have no solution without reversing the arrays,

``````perl -MList::MoreUtils=pairwise -E '
my @h=sort {\$a <=> \$b} @ARGV; @l=reverse splice @h, 0, (@h+1)/2; @h=reverse @h;
say join " ", grep {\$_==\$p&&die;\$p=\$_; defined \$_} pairwise {(\$a, \$b)} @l, @h
' 1 2 2 3
``````

Results:

``````2 3 1 2
``````

Finally, an example with no solution

``````perl -MList::MoreUtils=pairwise -E '
my @h=sort {\$a <=> \$b} @ARGV; @l=reverse splice @h, 0, (@h+1)/2; @h=reverse @h;
say join " ", grep {\$_==\$p&&die;\$p=\$_; defined \$_} pairwise {(\$a, \$b)} @l, @h
' 1 2 2
``````

Results:

``````Died at -e line 3.
``````

The full code is similar

`````` 1  # Perl weekly challenge 197
2  # Task 2:  Wiggle Sort
3  #
5  use v5.36;
6  use List::MoreUtils qw(any pairwise slide);
7  say(<<~"FIN"), exit unless @ARGV;
8      Usage: \$0 N1 [N2...]
9      to wiggle sort the numbers N1 N2...
10      FIN
11  my @high=sort {\$a <=> \$b} @ARGV;
12  my @low=reverse splice @high, 0, (@high+1)/2;
13  @high=reverse @high;
14  my \$prev;
15  my @out = grep {defined \$_} pairwise {(\$a, \$b)} @low, @high;
16  my \$failed=any {\$_} slide {\$a == \$b} @out;
17  say join " ", @ARGV, "->", \$failed?"No solution":@out;
``````

Example:

``````./ch-2.pl 1 5 1 1 6 4
./ch-2.pl 1 3 2 2 3 1
./ch-2.pl 1 2 2 3
./ch-2.pl 1 2 2
``````

Results:

``````1 5 1 1 6 4 -> 1 6 1 5 1 4
1 3 2 2 3 1 -> 2 3 1 3 1 2
1 2 2 3 -> 2 3 1 2
1 2 2 -> No solution
``````
Written on December 26, 2022