Perl Weekly Challenge: Week 241

No one-liners this week but the challenges were pretty easy to solve anyway.

Challenge 1:

Arithmetic Triplets

You are given an array (3 or more members) of integers in increasing order and a positive integer.

Write a script to find out the number of unique Arithmetic Triplets satisfying the following rules:

a) i < j < k
b) nums[j] - nums[i] == diff
c) nums[k] - nums[j] == diff

Example 1

Input: @nums = (0, 1, 4, 6, 7, 10)
    $diff = 3
Output: 2

Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 == 3.
Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 == 3.

Example 2

Input: @nums = (4, 5, 6, 7, 8, 9)
    $diff = 2
Output: 2

(0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
(1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.

There have been lots of problems involving triplets in previous challenges. While I couldn't directly cut and paste code from them into this weeks problems, at least I had a good idea about how to go about solving it.

My script assumes that $diff is the first command-line argument and the rest of the arguments make up @nums.

Then for @nums...

@nums

We find all the triplets which is easy to do with the .combinations() method.

    .combinations(3)

Then we search through the list of combinations to find arithmetic triplets using .grep().

    .grep({

The criteria from the spec can be coded almost verbatim.

        my ($i, $j, $k) = @$_;

        $i < $j &&
        $j < $k &&
        $j - $i == $diff &&
        $k - $j == $diff;
    })

We don't actually need to know what the arithmetic triplets are just how many so we can count them with .elems()...

    .elems

...and print the results with .say().

    .say;

(Full code on Github.)

For Perl I had to provide my own combinations() which I already had from previous challenges. With that, it works the same way as in Raku.

say scalar grep { 
    my ($i, $j, $k) = @{$_};

    $i < $j &&
    $j < $k &&
    $j - $i == $diff &&
    $k - $j == $diff;

} combinations(\@nums, 3);

(Full code on Github.)

Challenge 2:

Prime Order

You are given an array of unique positive integers greater than 2.

Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

Example 1

Input: @int = (11, 8, 27, 4)
Output: (11, 4, 8, 27)

Prime factors of 11 => 11
Prime factors of  4 => 2, 2
Prime factors of  8 => 2, 2, 2
Prime factors of 27 => 3, 3, 3

Prime factors have also come up several times in previous challenges. For both Raku and Perl, I used the factorize() function I wrote for week 168 challenge 2

Now when passing a comparison block to .sort(), instead of directly comparing the elements, we call factorize() on each one count the prime factors with .elems and use that as the basis of comparison. And that's it! The rest of the code is just to print the results in a similar manner to the example output.

say q{(},
@int.sort({ factorize($^a).elems <=> factorize($^b).elems }).join(q{, }),
q{)};

(Full code on Github.)

The Perl solution works the same as in Raku except Perls' version of factorize() also required the provision of an isPrime() function.

say q{(},
(join q{, }, sort { scalar factorize($a) <=> scalar factorize($b) } @ARGV),
q{)};

(Full code on Github.)

One thing that later occurred to me is that because sort() compares elements two by two, every element in @int except the first and last are going to have their prime factors calculated twice which for long lists or large numbers could be very inefficient. So for those cases it would pay to memoize factorize(). But for this example it doesn't matter.