Perl Weekly Challenge: Week 51

Challenge 1:

3 Sum

Given an array @L of integers. Write a script to find all unique triplets such that a + b + c is same as the given target T. Also make sure a <= b <= c.

Here is wiki page for more information.

Example:

  @L = (-25, -10, -7, -3, 2, 4, 8, 10);

One such triplet for target 0 i.e. -10 + 2 + 8 = 0.

Here's the Perl version first. I decided that my script should be able to take the values for $T and @L from the command line.

my $T = shift;
my @L = @ARGV;

The wikipedia page referenced in the task description gives an algorithm to solve this problem which seems more complicated then it needs to be. This is what I ended up doing.

First I found all the three-element combinations from @L. I reused the combinations() routine I had developed for challenge 38

for my $combo (combinations(\@L, 3)) {

Then I sorted the combination to preserve the a <= b <= c relation the task requires.

    my @triplet = sort{ $a <=> $b } @{$combo};

I added up the values of the three elements.

    my $total = 0;
    for my $elem (@triplet) {
        $total += $elem;
    }

And if the sum was equal to $T, I printed the combination out.

    if ($total == $T) {
        say join q{ }, @triplet;
    }

(Full code on Github.)

This is the Raku version. Notice how much less code it needs to do the same thing?

multi sub MAIN($T, *@L) {

    for @L.combinations(3) -> @combo {
        my @triplet = @combo.sort;

        my $total = [+] @triplet;

        if ($total == $T) {
            @triplet.join(q{ }).say;
        }
    }
}

(Full code on Github.)

Challenge 2:

Colorful Number

Write a script to display all Colorful Number with 3 digits.

A number can be declare Colorful Number where all the products of consecutive subsets of digit are different.

For example, 263 is a Colorful Number since 2, 6, 3, 2x6, 6x3, 2x6x3 are unique.

The problem can be summarized in code like this:

for my $n (grep { isColorful($_) } 100 .. 999) {
    say $n;
}

But what does that isColorful() function look like?

sub isColorful {
    my ($n) = @_;

We are going to do a lot of manipulation of individual digits so first I split the prospective colorful number into the @digits array. I created another array, @products to hold the results of all the intermediate calculations. It's initial contents are the @digits. The best way to count up the frequency elements occur in an array is by assigning them to keys in a hash. So %subsets is provided for that.

    my %subsets;
    my @digits = split //, $n;
    my @products = @digits;

Then the results of the two and three digit multiplications are added to @products.

    push @products, $digits[0] * $digits[1];
    push @products, $digits[1] * $digits[2];
    push @products, $digits[0] * $digits[1] * $digits[2];

Finally all the elements of @products are mapped to keys in %subsets.

    map { $subsets{$_}++ } @products;

If any key in %subsets has a value greater than one, we know that element occured more than once in @products and therefore this is not a colorful number.

    return !grep { $_ > 1 } values %subsets;
}

(Full code on Github.)

The Raku version is very similar. Unusually, I didn't even find any major ways to shorten the code with Raku features except perhaps the use of .all() instead of grep() in the return statement.

sub isColorful($n) {
    my %subsets;
    my @digits = $n.comb;
    my @products = @digits;

    @products.push(@digits[0] * @digits[1]);
    @products.push(@digits[1] * @digits[2]);
    @products.push(@digits[0] * @digits[1] * @digits[2]);
    @products.map({ %subsets{$_}++ });

    return %subsets.values.all == 1;
}

(Full code on Github.)