Perl Weekly Challenge: Week 82

Challenge 1:

Common Factors

You are given 2 positive numbers $M and $N.

Write a script to list all common factors of the given numbers.

Example 1:
Input:
    $M = 12
    $N = 18

Output:
    (1, 2, 3, 6)

Explanation:
    Factors of 12: 1, 2, 3, 4, 6
    Factors of 18: 1, 2, 3, 6, 9
Example 2:
Input:
    $M = 18
    $N = 23

Output:
    (1)

Explanation:
    Factors of 18: 1, 2, 3, 6, 9
    Factors of 23: 1

In Raku we can solve this challenge with two one-line functions.

sub factors(Int $n) {
    return  (1 .. $n div 2).grep({ $n %% $_ });
}

We can infer that the biggest factor (except for $n itself which we are apparently ignoring according to the spec) is not going to be larger than $n / 2 because the smallest factor (apart from 1 which we are not ignoring) possible is 2. So we go through all the numbers from 1 to $n / 2 and grep() out all the factors (those numbers which divide into $n without a reamainder.) 

sub MAIN(Int $M, Int $N) {
    (factors($M) ∩ factors($N)).keys.sort.join(', ').say;
}

After getting the factors for $M and $N using the function above, we need to find the ones they have in common. Mathematically, this is the intersection of two sets and Raku actually has an intersection operator, ∩ This returns a Set datatype so to convert it into a sorted list, we need to call .keys.sort on it. Finally, .join is used to prettify this list and .say to print it.

(Full code on Github.)

This is the Perl version. factors() works the same as in Raku though it is a little wordier because there is no %% operator and no div for integer division.

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

    return grep { $n % $_ == 0; } 1 .. $n / 2;
}

my ($M, $N) = @ARGV;

We don't have a native intersection operation in Perl so we have to make our own. We create a hash, %f, whose keys are factors and whose values are the number of times that factor has ocurred. First the factors of $M are added to %f then the factors of $N. Now we can grep() all the keys from %f with a value of 2 which means they occured in both sets of factors.

my %f;
map { $f{$_}++; } factors($M);
map { $f{$_}++; } factors($N);

say join q{, }, sort grep { $f{$_} == 2; } keys %f;

(Full code on Github.)

Challenge 2:

Interleave String

You are given 3 strings; $A, $B and $C.

Write a script to check if $C is created by interleave $A and $B.

Print 1 if check is success otherwise 0.

Example 1:
Input:
    $A = "XY"
    $B = "X"
    $C = "XXY"

Output: 1
EXPLANATION
"X" (from $B) + "XY" (from $A) = $C
Example 2:
Input:
    $A = "XXY"
    $B = "XXZ"
    $C = "XXXXZY"

Output: 1
EXPLANATION
"XX" (from $A) + "XXZ" (from $B) + "Y" (from $A) = $C
Example 3:
Input:
    $A = "YX"
    $B = "X"
    $C = "XXY"

Output: 0

This challenge caused me a great deal of confusion. At first it seemed really simple. It seems that all you would have to do is "zip" $A and $B and compare it to $C. Raku has the Z operator for zipping and I had previously written an equivalent of it in Perl. But I ran into trouble trying to replicate example 2. No matter what I tried, I kept getting XXXXYZ. I was about to write to Mohammed Anwar asking if there had been a typo when I looked at the specification more closely and then it suddenly dawned on me what had to be done. This is the Perl version of my solution.

my ($A, $B, $C) = @ARGV;
my $result;

We will be manipulating the 3 strings during the course of this program but $C is needed intact at the end so it can be compared to $result. Thus we shall work on a copy of $C instead.

my $copy = $C;

Now while we have any characters left in $A or B...

while (length $A || length $B) {

We find as long of a common initial substring between $A and $C (actually $copy) as possible, remove it from both strings, and add it to $result. At first I went through each string character by character in a loop and I wondered if it would be simpler to use a regular expression. My attempts at crafting the right regexp did not go well but then I came accross this Stack Overflow question which showed me the right way.

    "$A\0$copy" =~ /\A (.*) .* \0 \1/msx;
    my $prefixa = $1;
    $result .= $prefixa;
    $A =~ s/\A $prefixa//msx;
    $copy =~ s/\A $prefixa//msx;

The same procedure is performed between $B and $copy which is possibly shorter now if there was a match with $A.

    "$B\0$copy" =~ /\A (.*) .* \0 \1/msx;
    my $prefixb = $1;
    $result .= $prefixb;
    $B =~ s/\A $prefixb//msx;
    $copy =~ s/\A $prefixb//msx;
}

After one of $A or B has been exhausted, we compare $result to C. (the original not $copy.) If the two are equal, we print 1 otherwise 0.

say $result eq $C ? 1 : 0;

(Full code on Github.)

The conversion to Raku was pretty straightforward except I'm still not used to its' new regexp syntax. Another minor pitfall I came accross is that function parameters are immutable so we need copies of $A and $B as well as $C. (For consistency, I called the copy $c instead of $copy here.)

sub MAIN(Str $A, Str $B, Str $C) {
    my $result;
    my ($a, $b, $c) = ($A, $B, $C);

   while ($a.chars || $b.chars) {
        "$a\0$c" ~~ /^ (.*) .* \0 $0/;
        my $prefixa = $0;
        $result ~= $prefixa;
        $a ~~ s/^ $prefixa//;
        $c ~~ s/^ $prefixa//;

        "$b\0$c" ~~ /^ (.*) .* \0 $0/;
        my $prefixb = $0;
        $result ~= $prefixb;
        $b ~~ s/^ $prefixb//;
        $c ~~ s/^ $prefixb//;
    }

    say ($result ~~ $C) ?? 1 !! 0;
}

(Full code on Github.)