Perl Weekly Challenge 197.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 197.
Task 1: Move Zero
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 #
4 # See https://wlmb.github.io/2022/12/26/PWC197/#task-1-move-zero
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 #
4 # See https://wlmb.github.io/2022/12/26/PWC197/#task-1-move-zero
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
Task 2: Wiggle Sort
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[0] < list[1] > list[2] < list[3]….
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&¨$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&¨$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&¨$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&¨$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 #
4 # See https://wlmb.github.io/2022/12/26/PWC197/#task-2-wiggle-sort
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