Perl Weekly Challenge 85: Triplet Sum and Power of Two Integers

These are some answers to the Week 85 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a day or so (November 8, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Triplet Sum

You are given an array of real numbers greater than zero.

Write a script to find if there exists a triplet (a,b,c) such that 1 < a+b+c < 2. Print 1 if you succeed otherwise 0.

Example 1:

Input: @R = (1.2, 0.4, 0.1, 2.5)
Output: 1 as 1 < 1.2 + 0.4 + 0.1 < 2

Example 2:

Input: @R = (0.2, 1.5, 0.9, 1.1)
Output: 0

Example 3:

Input: @R = (0.5, 1.1, 0.3, 0.7)
Output: 1 as 1 < 0.5 + 1.1 + 0.3 < 2

Triplet Sum in Raku

We basically need to find from the input array a combination of 3 numbers whose sum is larger than 1 and less than 2. Raku has a built-in combinations routine to generate a Seq of all combinations of three (or any other number of) items from an input list. Then, for each triplet generated from each input array, we set a Boolean flag ($found) to False, compute the sum, and, if the sum matches the range criteria, we print the triplet (this is not requested in the task specification, but it helps checking the result) and set the $Found flag to True. At the end, we print a numified version of the Boolean flag.

use v6;

my @tests = [1.2, 0.4, 0.1, 2.5],
            [0.2, 1.5, 0.9, 1.1], 
            [0.5, 1.1, 0.3, 0.7],
            [0.7, 4.3, -0.1, 1.1];
for @tests -> @R {
    my $found = False;
    say "Testing: @R[]";
    for @R.combinations(3) -> $candidate {
        $found = True and say $candidate 
      if 1 < $candidate.sum < 2;
    }
    say +$found;
}

This script produces the following output:

$ raku triplet-sum.raku
Testing: 1.2 0.4 0.1 2.5
(1.2 0.4 0.1)
1
Testing: 0.2 1.5 0.9 1.1
0
Testing: 0.5 1.1 0.3 0.7
(0.5 1.1 0.3)
(0.5 0.3 0.7)
1
Testing: 0.7 4.3 -0.1 1.1
(0.7 -0.1 1.1)
1

Triplet Sum in Perl

Perl doesn’t have a built-in combinations function. There are some CPAN modules providing this feature, and I would use one of them in a real life problem, but, as I have said a number of times before, I eschew using modules in a coding challenge and prefer to detail a pure-Perl algorithm. When I want to generate combinations from an input list, I often like to use a recursive implementation to do so. However, since we’re interested here only with triplets, I decided rather to use three nested for loops to generate all possible triplets. The upside is that we can exit the loops as soon as we find a triplet matching the range condition.

use strict;
use warnings;
use feature "say";

my @tests = ([1.2, 0.4, 0.1, 2.5],
             [0.2, 1.5, 0.9, 1.1], 
             [0.5, 1.1, 0.3, 0.7],
             [0.7, 4.3, -4.1, 1.1]
            );
for my $R (@tests) {
    say "Testing: @$R";
    say test_candidates(@$R);
}
sub test_candidates {
    my @in = @_;
    for my $i (0..$#in) {
        for my $j ($i+1..$#in) {
            for my $k ($j+1..$#in) {
                my $sum = $in[$i] + $in[$j] + $in[$k];
                next if $sum < 1 or $sum > 2;
                say "@in[$i, $j, $k]";
                return 1;
            }
        }
    }
    return 0;
}

This script displays the following output:

$ perl  triplet-sum.pl
Testing: 1.2 0.4 0.1 2.5
1.2 0.4 0.1
1
Testing: 0.2 1.5 0.9 1.1
0
Testing: 0.5 1.1 0.3 0.7
0.5 1.1 0.3
1
Testing: 0.7 4.3 -4.1 1.1
4.3 -4.1 1.1
1

Task 2: Power of Two Integers

You are given a positive integer $N.

Write a script to find if it can be expressed as a ** b where a > 0 and b > 1. Print 1 if you succeed otherwise 0.

Example 1:

Input: 8
Output: 1 as 8 = 2 ** 3

Example 2:

Input: 15
Output: 0

Example 3:

Input: 125
Output: 1 as 125 = 5 ** 3

One small comment: although this is not explicitly stated in the task specification, a and b have to be integers. If either of the two numbers is not an integer, then there is no way a ** b can be an integer (except for the trivial edge case where b is 0 and $N is 1, but we’re told that b > 1).

I can see at least two approaches (with some possible variations).

One is trying all combinations of a and b where a ** b doesn’t become larger than the target integer. Although this is a brute force solution with a combinatorial explosion, it is likely to be relatively fast (except possibly for very large input integers), because powers grow so fast that the number of possibilities to be tested tends to remain quite small.

The other approach is to factorize the input value (i.e. to perform prime factor decomposition) and to find out from the list of factors and their respective exponents whether the input value can be a perfect square, cube or other power of some integer. To find whether an integer can be expressed as an integer power of an integer, we don’t really care about the factors themselves (which we know to be prime), but are interested with their relative exponents. Suppose we have a list of exponents, @exponents. It is quite clear that if any exponent is equal to 1, there will be no solution. If all exponents are equal (and larger than 1), then there is an obvious solution (a is the product of the individual prime factors, and b is the common exponent. This can be expressed in Raku as follows:

return 0 if @exponent.any == 1;
return 1 if [==] @exponents;

But if the factors of $N are, for example: a ** 2 and b ** 6, then $N can be expressed as a perfect square: (a * b ** 3) ** 2. For example, if a = 3 and b = 2 (and $Z = 576), we have: $Z = (3 * 2 * 3) * 2 = (3 * 8) * 2 = 24 * 2 = 576. How do we generalize that to more prime factors with various exponents. It is quite easy to see that, irrespective of the prime factor values, the problem will have a solution if the greatest common divisor (GCD) of the exponents is larger that 1. In Raku or Perl pseudo-code:

return 1 if GCD(@exponents) > 1;

This condition is sufficient and we no longer need the first two conditions: if any of the exponents is 1, then the GCD will be 1; and if all exponents are equal (and larger than 1), then the GCD will be the value of any of the exponents.

Power of Two Integers in Raku

We will implement both approaches detailed above.

Brute Force Approach

The first one is a brute force approach trying all valid combinations:

use v6;

my $n = @*ARGS[0].Int // 15;
say find-power $n;

sub find-power (Int $n) {
    return 1 if $n == 1; # trivial solution: 1 ** 2
    OUTERLOOP: for 2..$n.sqrt.Int -> $base {
        my $exp = 2;
        loop {
            my $power = $base ** $exp;
            return 1 if $power == $n;
            next OUTERLOOP if $power > $n;
            $exp++;
        }
    }
    return 0;
}

This works as expected:

$ raku perfect-power-int2.raku 144
1

$ raku perfect-power-int2.raku 145
0

$ raku perfect-power-int2.raku 1451
0

$ raku perfect-power-int2.raku 1
1

Prime Factor Decomposition Approach

The other approach it to perform a factorization of the input integer and to use the GCD of the factors’ exponents:

use v6;

my $n = @*ARGS[0] // 15;
sub find-factors ($n is copy) {
    my %factors;
    my $max = ($n/2).Int;
    for 2..$max -> $i {
        while  $n %% $i {
            %factors{$i}++;
            $n /= $i;
        }
    }
    say %factors;
    return 1 if 1 < [gcd] %factors.values;
    return 0;
}
say find-factors $n;

Some sample runs:

$ raku perfect-power-int.raku 144
{2 => 4, 3 => 2}
1

$ raku perfect-power-int.raku 72
{2 => 3, 3 => 2}
0

$ raku perfect-power-int.raku 12
{2 => 2, 3 => 1}
0

$ raku perfect-power-int.raku 40000
{2 => 6, 5 => 4}
1

Although the second approach is intellectually more satisfactory, the first approach is both simpler and probably more efficient most of the time.

Power of Two Integers in Perl

This is the second approach (using the GCD) described above implemented in Perl:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

sub gcd2 {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = sort { $b <=> $a } ($j, $i % $j);
    }
    return $i;
}
sub gcd_all {
    my @nums = sort {$a <=> $b } @_;
    return $nums[0] if @nums == 1;
    my $i = shift @nums;
    my $gcd;
    for my $j (@nums) {
        $gcd = gcd2 ($i, $j);
        $i = $gcd;
    }
    return $gcd;
}
sub find_factors {
    my $n = shift;
    my %factors;
    my $max = int $n/2;
    for my $i (2..$max) {
        while ($n % $i == 0) {
            $factors{$i}++;
            $n /= $i;
        }
    }
    say Dumper \%factors;
    return 1 if gcd_all (values %factors) > 1;
    return 0;
}
my $n = shift // 8;
say find_factors $n;

This script displays the following output:

$ perl perfect-power-int.pl 8
$VAR1 = {
          '2' => 3
        };

1

$ perl perfect-power-int.pl 24
$VAR1 = {
          '2' => 3,
          '3' => 1
        };

0

$ perl perfect-power-int.pl 144
$VAR1 = {
          '2' => 4,
          '3' => 2
        };

1

$ perl perfect-power-int.pl 10000
$VAR1 = {
          '2' => 4,
          '5' => 4
        };

1

$ perl perfect-power-int.pl 2500
$VAR1 = {
          '2' => 2,
          '5' => 4
        };

1

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, November, 15, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.