Perl Weekly Challenge: Week 90

Just a reminder, I'm doing the Advent of Code in Raku this year. So far I've managed to keep up but the problems are getting harder so who knows how much longer that will last. If you're interested, you can see my solutions here.

This weeks challenges:

Challenge 1:

DNA Sequence

DNA is a long, chainlike molecule which has two strands twisted into a double helix. The two strands are made up of simpler molecules called nucleotides. Each nucleotide is composed of one of the four nitrogen-containing nucleobases cytosine (C), guanine (G), adenine (A) and thymine (T).

You are given DNA sequence, GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG.

Write a script to print nucleiobase count in the given DNA sequence. Also print the complementary sequence where Thymine (T) on one strand is always facing an adenine (A) and vice versa; guanine (G) is always facing a cytosine (C) and vice versa.

To get the complementary sequence use the following mapping:

T => A
A => T
G => C
C => G

This task was quite easy.

First we use split() to turn the DNA sequence we have been given into an array.

my @dna = split //, 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';

Then we create a hash where the keys will be nucleobases and the values, the number of times each nucleobase occurs.

my %count;

And then we go through the array of nucleobases and add one to its matching key in %count.

for my $base (@dna) {
    $count{$base}++;
}

Print out the values of %count and the first part of this task is done. for my $base (sort keys %count) { say "$base = $count{$base}"; }

The second bit is even easier not the least because the problem description already provided the main part of the solution. We have a hash that maps each nucleobase with its' complementary one.

my %complementaries = (
    'T' => 'A',
    'A' => 'T',
    'G' => 'C',
    'C' => 'G'
);

Now we can just use map() to transpose our array of nucleobases into its complement. Join it up into a string again and print it and we're dones.

say join q{}, map { $complementaries{$_}; } @dna;

(Full code on Github.)

This is the Raku version. It's mostly the same.

sub MAIN() {
    my @dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG'.comb;

However there is one notable difference. Raku has a nice .classify() method for lists which automates all the work of creating a hash, populating the keys from a list and adding each occurence of that key in the list to the hash. In this case, we don't want all the occurrences just how many there were so an extra .map() is needed to convert an array of values back into a single number.

    for @dna.classify({ $_; }).pairs.sort.map({ $_.key => $_.value.elems; }) -> $base {
        say $base;
    }

    my %complementaries = (
        'T' => 'A',
        'A' => 'T',
        'G' => 'C',
        'C' => 'G'
    );

    @dna.map({ %complementaries{$_}; }).join(q{}).say;

}

(Full code on Github.)

Challenge 2:

Ethiopian Multiplication

You are given two positive numbers $A and $B.

Write a script to demonstrate Ethiopian Multiplication using the given numbers.

In Raku, I decided to solve this one recursively. So in MAIN() there is only some validation and one call to a function, multiply() that does all the work. multiply() takes three arguments, $A and '$B and $sum in which we will accumulate the answer.

The value of $sum is initally the value of $B if $A is an odd number or 0 if $A is even. It is not clear to me that this difference should matter. It is not mentioned in the link given in the task description for instance. But adding this in was the only way I could get my code to give correct answers for all inputs.

sub MAIN(
    $A,
    $B
    where { $A > 0 && $B > 0}
) {
    say multiply($A, $B, $A % 2 ?? $B !! 0);
}

To avoid recursing endlessly, we need a base case where we can stop calling ourselves. In this problem, that would be when $A == 1. Raku lets you give several functions the same name as long as their arguments are different. We can use that to make two versions of multiply(), one for the base case, and one for general cases. It's much neater that way.

The $A = 1 version of multiply() simply returns the value of $sum which will be our final answer.

multi sub multiply(
    Int $A,
    Int $B,
    Int $sum
    where { $A == 1 }
) {
    return $sum;
}

The $A > 1 version of multiply() first makes copies of $A and $B as function parameters are immutable. The copy of $A is halved and the copy of $B is doubled. We want to change the value of $sum so instead of working on a copy, we give it the is copy trait which makes it mutable. I suppose I could have add is copy to $A and $B too but in general it is could to keep variables immutable as far as possible. Also note the use of the div integer division operator instead of the usual /. div ensures that e.g. 5 divided by 2 is 2 not 2.5.

multi sub multiply(
    Int $A,
    Int $B,
    Int $sum is copy
    where { $A > 1 }
) {
    my $a = $A div 2;
    my $b = $B * 2;

If $a (the halved copy of $A) is an odd number, $b (the doubled copy of $B) is added to $sum. If not, nothing happens.

    if $a % 2 {
        $sum += $b;
    }

multiply() is recursively called again.

    return multiply($a, $b, $sum);
}

(Full code on Github.)

In this roundabout way, you will get the same answer as if you did multiplication the normal way. This algorithm is just an interesting curiosity but I imagine it was quite useful back in the early days of computers when many models didn't even have hardware support for multiplication.

For the Perl version I wondered if I could do it without recursion. This is what I came up with. As you can see, it is in many ways even simpler than the recursive version.

my $sum = ($A % 2) ? $B : 0;

while ($A > 1) {
    $A /= 2;
    $B *= 2;

    if ($A % 2) {
        $sum += $B;
    }
}

say $sum;

(Full code on Github.)