laurent_r

These are some answers to the Week 197 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on January 1, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

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.

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)

Move Zero in Raku

We simply use two greps to pick up non-zero items on the one hand and zero items on the other hand and rearrange them in the desired order by concatenating them.

sub move-zero (@in) {
    return (@in.grep({$_ != 0}), @in.grep({$_ == 0})).flat;
}
for <1 0 3 0 0 5>, <1 6 4>, <0 1 0 2 0> -> @test {
    say (~@test).fmt("%-15s"), " => ", move-zero @test;
}

This program displays the following output:

$ raku ./move-zero.raku
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)

Move Zero in Perl

Same method as in Raku: we simply use two greps to pick up non-zero items on the one hand and zero items on the other hand and rearrange them in the desired order.

use strict;
use warnings;
use feature qw/say/;

sub move_zero {
    return ((grep $_ != 0, @_), grep $_ == 0, @_);
}
for my $test ([<1 0 3 0 0 5>], [<1 6 4>], [<0 1 0 2 0>]){
    say "@$test => \t", join " ", move_zero  @$test;
}

This program displays the following output:

$ perl ./move-zero.pl
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

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)

Basically, we need items with even indices to be smaller than the next item and items with odd indices to be larger than the next item.

Note that, for a given input list, there can be several output lists in wiggle order. We will only display the first one found.

Also note that it might be better to specify wiggle sort as follows:

Wiggle sort would be such as list[0] <= list[1] >= list[2] <= list[3]…

as it would make it possible to define output for lists having many times the same item.

We could sort the input list, partition it into two list, one with the larger items and one with the smaller items, and store the larger items in the odd positions and the smaller items in the even positions.

But it can be made simpler: we only need to go through the list one item at a time (e.g. from left to right) and swap current item with the next one when they don’t match the requirement.

Wiggle Sort in Raku

This program implements the observations made at the end of the previous section:

sub wiggle_sort (@in is copy) {
    for 0..^@in.end -> $i {
        if $i %% 2 {
            @in[$i, $i+1] = @in[$i+1, $i] 
                if @in[$i] > @in[$i+1];
        } else {
            @in[$i, $i+1] = @in[$i+1, $i] 
                if @in[$i] < @in[$i+1];
        }
    }
    return @in;
}
for <1 5 1 1 6 4>, <1 3 2 2 3 1>, 
    <8 12 11 13 9>, <1 2 3 4 5 6 7 8 9> -> @test {
    say (~@test).fmt("%-20s => "), wiggle_sort @test;
}

This program displays the following output:

$ raku ./wiggle_sort.raku
1 5 1 1 6 4          => [1 5 1 6 1 4]
1 3 2 2 3 1          => [1 3 2 3 1 2]
8 12 11 13 9         => [8 12 11 13 9]
1 2 3 4 5 6 7 8 9    => [1 3 2 5 4 7 6 9 8]

Wiggle Sort in Perl

This program implements the same method:

use strict;
use warnings;
use feature qw/say/;

sub wiggle_sort {
    my @in = @_;
    for my $i (0..$#in - 1) {
        if ($i % 2) {
            @in[$i, $i+1] = @in[$i+1, $i] 
                if $in[$i] < $in[$i+1];
        } else {
            @in[$i, $i+1] = @in[$i+1, $i] 
                if $in[$i] > $in[$i+1];
        }
    }
    return @in;
}
for my $test ([<1 5 1 1 6 4>], [<1 3 2 2 3 1>], 
    [<8 12 11 13 9>], [<1 2 3 4 5 6 7>]) {
    say "@$test \t=> ", join " ", wiggle_sort @$test;
}

This program displays the following output:

$ perl ./wiggle_sort.pl
1 5 1 1 6 4     => 1 5 1 6 1 4
1 3 2 2 3 1     => 1 3 2 3 1 2
8 12 11 13 9    => 8 12 11 13 9
1 2 3 4 5 6 7   => 1 3 2 5 4 7 6

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on January 8, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.