laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on June 25, 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: Matching Members

You are given a list of positive integers, @ints.

Write a script to find the total matching members after sorting the list increasing order.

Example 1

Input: @ints = (1, 1, 4, 2, 1, 3)
Output: 3

Original list: (1, 1, 4, 2, 1, 2)
Sorted list  : (1, 1, 1, 2, 3, 4)

Compare the two lists, we found 3 matching members (1, 1, 2).

Example 2

Input: @ints = (5, 1, 2, 3, 4)
Output: 0

Original list: (5, 1, 2, 3, 4)
Sorted list  : (1, 2, 3, 4, 5)

Compare the two lists, we found 0 matching members.

Example 3

Input: @ints = (1, 2, 3, 4, 5)
Output: 5

Original list: (1, 2, 3, 4, 5)
Sorted list  : (1, 2, 3, 4, 5)

Compare the two lists, we found 5 matching members.

Matching Members in Raku

The matching-members subroutine first sorts the input array and then compares the values of the input array and the sorted array for each index within the range. Note that Raku allows you to use two postfix expressions:

do-something if <condition> for <range>;

which is quite convenient and leads to fairly concise code.

sub matching-members (@in) {
    my @sorted = @in.sort;
    my $match = 0;
    $match++ if @in[$_] == @sorted[$_] for 0..@in.end;
    return $match;
}

for <1 1 4 2 1 3>, <5 1 2 3 4>, <1 2 3 4 5> -> @test {
    printf "%-12s => ", "@test[]";
    say matching-members @test;
}

This program displays the following output:

$ raku ./matching-members.raku
1 1 4 2 1 3  => 3
5 1 2 3 4    => 0
1 2 3 4 5    => 5

The matching-members subroutine can me made more concise using the grep and elems routines:

sub matching-members (@in) {
    my @sorted = @in.sort;
    (grep {@in[$_] == @sorted[$_]}, 0..@in.end).elems;
}

This modified subroutine leads to the same output as before.

Matching Members in Perl

This is a port to Perl of the first Raku program above.

use strict;
use warnings;
use feature 'say';

sub matching_members {
    my @sorted = sort { $a <=> $b } @_;
    my $match = 0;
    for my $i (0..$#sorted) {
        $match++ if $_[$i] == $sorted[$i];
    }
    return $match;
}

for my $test ([<1 1 4 2 1 3>], [<5 1 2 3 4>], [<1 2 3 4 5>]) {
    printf "%-12s => ", "@$test";
    say matching_members @$test;
}

This program displays the following output:

$ perl ./matching-members.pl
1 1 4 2 1 3  => 3
5 1 2 3 4    => 0
1 2 3 4 5    => 5

Task 2: Last Member

You are given an array of positive integers, @ints.

Write a script to find the last member if found otherwise return 0. Each turn pick 2 biggest members (x, y) then decide based on the following conditions, continue this until you are left with 1 member or none.

a) if x == y then remove both members

b) if x != y then remove both members and add new member (y-x)

Example 1:

Input: @ints = (2, 7, 4, 1, 8, 1)
Output: 1

Step 1: pick 7 and 8, we remove both and add new member 1 => (2, 4, 1, 1, 1).
Step 2: pick 2 and 4, we remove both and add new member 2 => (2, 1, 1, 1).
Step 3: pick 2 and 1, we remove both and add new member 1 => (1, 1, 1).
Step 4: pick 1 and 1, we remove both => (1).

Example 2:

Input: @ints = (1)
Output: 1

Example 3:

Input: @ints = (1, 1)
Output: 0

Step 1: pick 1 and 1, we remove both and we left with none.

In its first version, the task description told us to pick two random numbers (rather than the 2 biggest members). This could lead to different results, depending on the order in which you picked the items from the input. Given the first example provided, I decided to sort once the input in descending order and then to pick the first two items. With the revised version of the task description, I now need to sort the array at each iteration of the process.

Last Member in Raku

sub last-member (@ints) {
    my @in = reverse sort @ints;
    while @in.elems > 1 {
        @in = @in[0] == @in[1] ?? @in[2..@in.end].sort.reverse !!
              (@in[1] - @in[0], @in[2..@in.end]).flat.sort.reverse;
    }
    return @in.elems;
}

for (2, 7, 4, 1, 8, 1), (1,), (1, 1) -> @test {
  printf "%-12s => ", "@test[]";
  say last-member @test;
}

This program displays the following output:

$ raku ./last-member.raku
2 7 4 1 8 1  => 1
1            => 1
1 1          => 0

Last Member in Perl

This is a port to Perl of the above Raku program:

use strict;
use warnings;
use feature 'say';

sub last_member {
    my @in = sort { $b <=> $a } @_;
    while (@in > 1) {
        @in = $in[0] == $in[1] ? 
            sort { $b <=> $a } @in[2..$#in] :
            sort { $b <=> $a } ($in[1] - $in[0], @in[2..$#in]);
        # say "@in"; # uncomment to view the steps
    }
    return scalar @in;
}

for my $test ([2, 7, 4, 1, 8, 1], [1], [1, 1]) {
    printf "%-12s => ", "@$test";
    say last_member @$test;
}

This program displays the following output:

2 7 4 1 8 1  => 1
1            => 1
1 1          => 0

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 July 2, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.