1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
[< Previous 196](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-196/james-smith) |
[Next 198 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith)
# The Weekly Challenge 197
You can find more information about this weeks, and previous weeks challenges at:
https://theweeklychallenge.org/
If you are not already doing the challenge - it is a good place to practise your
**perl** or **raku**. If it is not **perl** or **raku** you develop in - you can
submit solutions in whichever language you feel comfortable with.
You can find the solutions here on github at:
https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-196/james-smith
# Task 1 - Move Zero
***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.***
## Solution
I looked at a number of solutions for this - but it turns out that perl grep seems to be the best...
```perl
sub move_zero{
grep({$_}@_),grep{!$_}@_
}
```
Using `$_` and `!$_` to pull the lists apart. Anything more complex in the grep slows it down more than you lose by doing the second `grep`.
# Task 2 - Wiggle sort
***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]…
```
## Solution
OK if we relax the condition with `<=`/`=>` rather than `<`/`>` we can always come up with a solution. The simplest way to do this is to split the list in two (using `splice` and then stitching them back together. (If it has an odd length we keep the first list as the longest!)
```perl
sub ws_lax {
return @_ if @_<2; ## Always works if 0/1 element.
my@q=splice @_,0,$#_/2+1;
map{$_,@_?shift:()}@q
}
```
If we wish to perform the strict version we have to test conditions for which there are no solution...
* If we have more than half (if even length) or *half + 1* (if odd) of the lowest digit we have no solution.
* o/w if we have exactly half (if even length) or *half + 1* (if odd) of the lowest digit we have a solution.
* o/w if we have more than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution
* o/w if we have exactly than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution
* o/w if we have half or more (if even length) or *half - 1* or more (if odd) of any other digit we have no solution
* o/w we have a solution
This leads us to:
```perl
sub _ws {
## Does wiggle sort by splicing and interleaving sorted list...
my@q=splice @_,0,$#_/2+1;map{$_,@_?shift:()}@q
}
sub ws_strict {
## Return "wiggle sorted list" or error message indicating if
## the problem number is the first number, last number or one
## of the other numbers...
return @_ if @_<2;
@_=sort{$a<=>$b} @_;
return $_[0] == $_[$#_/2+1] ? 'Bottom' # We can't have more than ceil(n/2) of the first number
: $_[0] == $_[$#_/2 ] ? _ws(@_) # But we can have ceil(n/2) of the first number
: $_[-1] == $_[$#_/2 ] ? 'Top' # We can't have more than floor(n/2) of the last number
: $_[-1] == $_[$#_/2+1] ? _ws(@_) # But we can have floor(n/2) of it
: (grep{$_[$_]==$_[$_+$#_/2]}0..@_/2-1) ? 'Middle' # We can't have equal or more than floor(n/2) of any other number
: _ws(@_)
;
}
sub ws_lax {
## Return "wiggle sorted list" - note we are using the lax <= => check here
@_<2?@_:_ws(sort{$a<=>$b}@_)
}
```
|
