Perl Weekly Challenge: Triplets Prime

From disappointing to worse: not only can’t I come up with a musical theme for this week, I just discovered that I didn’t submit my pull request for last week’s solutions, so they didn’t count. 😭

This week I have to make sure I get my entries in on time.


Task 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.

Approach

Ok, we have two pieces of input: a list of integers in increasing order, and a target difference. We’re looking for three-element increasing order subsets from the list where the difference between the first and second and the second and third elements match the target difference.

It seems the most straightforward way to identify these triplets is to find pairs where the difference is the target difference, and then build triplets from those pairs.

Raku

sub findTriplets($diff, @nums) {
  my $count = 0;
  my $details = q{};
  for 0 .. @nums.elems - 3 -> $i {
    for $i + 1 .. @nums.elems - 2 -> $j {
      next unless @nums[$j] - @nums[$i] == $diff;
      for $j + 1 .. @nums.elems - 1 -> $k {
        next unless @nums[$k] - @nums[$j] == $diff;
        $count++;
        $details ~= "($i, $j, $k) is an arithmetic triplet "
          ~  "because both @nums[$k] - @nums[$j] = $diff "
          ~  "and @nums[$j] - @nums[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

Once again, I find myself chafing that I need to use @nums.elems - 1 to get the index of the last element in a Raku array. In Perl, it’s much easier.

View the entire Raku script for this task on GitHub.

Perl

sub findTriplets {
  my($diff, $nums) = @_;
  my $count = 0;
  my $details = q{};
  foreach my $i ( 0 .. $#$nums - 2 ) {
    foreach my $j ( $i + 1 .. $#$nums - 1 ) {
      next unless $nums->[$j] - $nums->[$i] == $diff;
      foreach my $k ( $j + 1 .. $#$nums ) {
        next unless $nums->[$k] - $nums->[$j] == $diff;
        $count++;
        $details .= "($i, $j, $k) is an arithmetic triplet "
          .  "because both $nums->[$k] - $nums->[$j] = $diff "
          .  "and $nums->[$j] - $nums->[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

View the entire Perl script for this task on GitHub.

Python

def findTriplets(diff, nums):
    count = 0
    details = ''
    for i in range(0, len(nums) - 2):
        for j in range(i + 1, len(nums) - 1):
            if not nums[j] - nums[i] == diff:
                continue
            for k in range(j + 1, len(nums)):
                if not nums[k] - nums[j] == diff:
                    continue
                count += 1
                details += (
                    f"({i}, {j}, {k}) is an arithmetic " +
                    f"triplet because both " +
                    f"{nums[k]} - {nums[j]} = {diff} and " +
                    f"{nums[j]} - {nums[i]} = {diff}\n"
                )
    return count, details

This screwed me up for a little while because my indentation on the innermost portion where I was counting results wasn’t properly lined up. This is one of my big complaints about Python: the lack of block delimiters, and all blocks being defined by indentation.

View the entire Python script for this task on GitHub.


Task 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

Example 2 (added by me)

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

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

Approach

Ok, so first we need to find the prime factors of a given integer. I had to look this up, but the algorithm to find the prime factors of N is:

  • Divide by 2 as many times as possible, checking to see if the remainder is 0
  • Loop from 3 to sqrt(N), dividing and checking to see if the remainder is 0
  • If the remaining number is still > 2, it’s a prime

Once we have a list of the prime factors, we need to sort by list size and numbers in the list.

Raku

First, the prime factor algorithm:

sub findPrimeFactors(Int $number) {
  my @factors;
  my $num = $number;
  while ( $num % 2 == 0 ) {
    @factors.push(2);
    $num /= 2;
  }
  for 3 .. sqrt($num).Int -> $i {
    while ( $num % $i == 0 ) {
      @factors.push($i);
      $num /= $i;
    }
  }
  if ($num > 2) {
    @factors.push($num);
  }
  return @factors;
}

Because we’re assigning to $num, I want it to be a copy of what we get passed in so we don’t change that variable. Now we use that to sort the numbers:

sub sortByPrimeFactors(@int) {
  my %primeFactors;
  # calculate the prime factors for each number
  for @int -> $n {
    %primeFactors{$n} = findPrimeFactors($n);
  }
  # now sort the numbers
  my @sorted = @int.sort({
    # first, sort by number of factors
    %primeFactors{$^a} <=> %primeFactors{$^b}
    ||
    # then sort by the value of the factors
    listCompare(%primeFactors{$^a}, %primeFactors{$^b})
  });
  # now build the output
  my $factors = q{};
  for @sorted -> $n {
    $factors ~= sprintf 'Prime factors of %2d => ', $n;
    $factors ~= %primeFactors{$n}.join(', ') ~ "\n";
  }
  return @sorted, $factors;
}

sub listCompare(@a, @b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i < @a.elems && @a[$i] == @b[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i >= @a.elems;

  return @a[$i] <=> @b[$i];
}

It isn’t an issue in the only example given, so I added another example where it would be an issue: if both lists of factors have the same number of elements, we need to compare the list items one by one until we get an inequality. 8 and 12 are perfect numbers for this, because their factor lists are (2, 2, 2) and (2, 2, 3), respectively, and we have to compare them out to the last element to find a difference.

View the entire Raku script for this task on GitHub.

Perl

The Perl solution is pretty much exactly the same.

sub findPrimeFactors {
  my $num = shift;
  my @factors;
  while ( $num % 2 == 0 ) {
    push @factors, 2;
    $num /= 2;
  }
  foreach my $i ( 3 .. int(sqrt($num)) ) {
    while ( $num % $i == 0 ) {
      push @factors, $i;
      $num /= $i;
    }
  }
  if ($num > 2) {
    push @factors, $num;
  }
  return @factors;
}

sub sortByPrimeFactors {
  my @int = @_;
  my %primeFactors;
  # calculate the prime factors for each number
  foreach my $n ( @int ) {
    $primeFactors{$n} = [ findPrimeFactors($n) ];
  }
  # now sort the numbers
  my @sorted = sort {
    # first, sort by number of factors
    $#{$primeFactors{$a}} <=> $#{$primeFactors{$b}}
    ||
    # then sort by the value of the factors
    listCompare($primeFactors{$a}, $primeFactors{$b})
  } @int;
  # now build the output
  my $factors = q{};
  foreach my $n ( @sorted ) {
    $factors .= sprintf 'Prime factors of %2d => ', $n;
    $factors .= join(', ', @{$primeFactors{$n}}) . "\n";
  }
  return \@sorted, $factors;
}

sub listCompare($a, $b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i <= $#{$a} && $a->[$i] == $b->[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i > $#{$a};

  return $a->[$i] <=> $b->[$i];
}

View the entire Perl script for this task on GitHub.

Python

import math

def findPrimeFactors(num):
    factors = []
    while num % 2 == 0:
        factors.append(2)
        num /= 2

    for i in range(3, int(math.sqrt(num))):
        while num % i == 0:
            factors.append(i)
            num /= i

    if num > 2:
        factors.append(int(num))

    return factors

def sortByPrimeFactors(nums):
    primeFactors = {}
    # calculate the prime factors for each number
    for n in nums:
        primeFactors[n] = findPrimeFactors(n)
    # now sort the numbers
    sorted_list = sorted(nums,
                         key=lambda x: (
                             len(primeFactors[x]),
                             primeFactors[x]
                         )
                        )

    # now build the output
    factors = ''
    for n in sorted_list:
        factors += f'Prime factors of {n:2d} => '
        as_list = ', '.join(
            map(lambda i: str(i), primeFactors[n])
        )
        factors += as_list + '\n'

    return sorted_list, factors

View the entire Python script for this task on GitHub.


Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-241/packy-anderson