This is my response to the Perl Weekly Challenge #085.
(a,b,c) such that
1 < a+b+c < 2. Print 1 if you succeed otherwise 0.
Input: @R = (1.2, 0.4, 0.1, 2.5)
Output: 1 as 1 < 1.2 + 0.4 + 0.1 < 2
Input: @R = (0.2, 1.5, 0.9, 1.1)
Output: 0
Input: @R = (0.5, 1.1, 0.3, 0.7)
Output: 1 as 1 < 0.5 + 1.1 + 0.3 < 2
Obtaining triplets from an array is easy with
combinations(3), where 3 is the number of items
in each combination. Here with the values from the first example:
> say (1.2, 0.4, 0.1, 2.5).combinations(3);
((1.2 0.4 0.1) (1.2 0.4 2.5) (1.2 0.1 2.5) (0.4 0.1 2.5))
See
docs.raku.org/routine/combinations
for more information about combinations.
We need the sum of each triplet, and can get that with sum
on each triplet with the hyper operator >> like this:
> say (1.2, 0.4, 0.1, 2.5).combinations(3)>>.sum;
(1.7 4.1 3.8 3)
See
docs.raku.org/routine/sum
for more information about sum.
See
docs.raku.org/language/operators#index-entry-hyper…
for more information about Hyper Operators and >>.
We are not interested in any of the sums as such, just the fact that any
of them at all satisfy the expression 1 < sum < 2. We can use
an any Junction for this:
> say 1 < any( (1.2, 0.4, 0.1, 2.5).combinations(3)>>.sum ) < 2;
any(True, False, False, False)
The result is a Junction, telling us that the first value is ok, and the last three are not.
See
docs.raku.org/routine/any for
more information about any, and
docs.raku.org/type/Junction for
more information about Junctions.
so operator: This will give us True if any of the values
are True.
> say so 1 < any( (1.2, 0.4, 0.1, 2.5).combinations(3)>>.sum ) < 2
True
See
docs.raku.org/routine/so
for more information about the so operator.
The challenge wanted the numbers 1 instead of
True, and 0 instead of False. We can achieve that by coercing
the Boolean value to a number with the + operator:
> say + so 1 < any( (1.2, 0.4, 0.1, 2.5).combinations(3)>>.sum ) < 2;
1
See
docs.raku.org/routine/+
for more information about the Numeric Context Operator +.
Then the program:
File: triplet-sum
unit sub MAIN (*@R where @R.elems > 0 && all(@R) > 0);
say + triplet-sum(@R);
sub triplet-sum (@numbers)
{
so 1 < any(@numbers.combinations(3)>>.sum) < 2;
}
Running it on the examples:
$ ./triplet-sum 1.2 0.4 0.1 2.5
1
$ ./triplet-sum 0.2 1.5 0.9 1.1
0
$ ./triplet-sum 0.5 1.1 0.3 0.7
1
We can make it even shorter, by inlining the procedure:
File: triplet-sum-inlined
unit sub MAIN (*@R where @R.elems > 0 && all(@R) > 0);
say + so 1 < any(@R.combinations(3)>>.sum) < 2;
all Junction used to verify the argument type.)
File: triplet-sum-perl
#! /usr/bin/env perl
use strict;
use feature 'say';
use Getopt::Long;
use List::Util qw(all sum);
use Algorithm::Combinatorics 'combinations';
my $verbose = 0;
GetOptions("verbose" => \$verbose);
die "At least 3 values" unless @ARGV > 2;
die "Only positive Real numbers" unless all { $ ~= /^\d+(\.\d+)?$/ } @ARGV;
say ": ARGS: ", join(", ", @ARGV) if $verbose;
for my $combination (combinations(\@ARGV, 3))
{
my $sum = sum(@$combination);
say "Comb: ", join(", ", @$combination), " sum: $sum" if $verbose;
if ($sum > 1 && $sum < 2)
{
say 1;
exit;
}
}
say 0;
Note that the loop replacing the «any» Junction
short circuits, as it terminates the program (exit) when (if) it finds
a triplet that satisfies the challenge.
Running it on the examples:
$ ./triplet-sum-perl -v 1.2 0.4 0.1 2.5
: ARGS: 1.2, 0.4, 0.1, 2.5
Comb: 1.2, 0.4, 0.1 sum: 1.7
1
$ ./triplet-sum-perl -v 0.2 1.5 0.9 1.1
: ARGS: 0.2, 1.5, 0.9, 1.1
Comb: 0.2, 1.5, 0.9 sum: 2.6
Comb: 0.2, 1.5, 1.1 sum: 2.8
Comb: 0.2, 0.9, 1.1 sum: 2.2
Comb: 1.5, 0.9, 1.1 sum: 3.5
0
$ ./triplet-sum-perl -v 0.5 1.1 0.3 0.7
: ARGS: 0.5, 1.1, 0.3, 0.7
Comb: 0.5, 1.1, 0.3 sum: 1.9
1
$N.
a ** b where
a > 0 and b > 1. Print 1 if you succeed
otherwise 0.
Input: 8
Output: 1 as 8 = 2 ** 3
Input: 15
Output: 0
Input: 125
Output: 1 as 125 = 5 ** 3
Note that 5 ** 3 is the same as 5 * 5 * 5.
So the task is really to get the factors of the number
$N, and check if any of the factors (which by the way are prime numbers)
occur more than one time (which follows from «b > 1»). That is a task for
repeated, which will remove the first instance of any distinct
value from the list, keeping the rest (if any).
The «factors» procedure come from the program with the same name (in the section with the same name) in my Centenary Sequences with Raku - Part 5: Divisors and Factors article.
File: power-of-two-integers
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my @factors = factors($N);
my @repeated = @factors.repeated;
if $verbose
{
say ": Factors: { @factors.join(", ") }";
say ": Repeated: { @repeated.join(", ") }";
}
say @repeated ?? 1 !! 0;
sub factors ($number is copy)
{
return (1) if $number == 1;
return ($number) if $number.is-prime;
my @factors;
for (2 .. $number div 2).grep( *.is-prime) -> $candidate
{
while $number %% $candidate
{
@factors.push: $candidate;
$number /= $candidate;
}
}
return @factors;
}
See
docs.raku.org/routine/repeated for more
information about the repeated method.
Running it:
$ ./power-of-two-integers -v 8
: Factors: 2, 2, 2
: Repeated: 2, 2
1
$ ./power-of-two-integers -v 15
: Factors: 3, 5
: Repeated:
0
$ ./power-of-two-integers -v 125
: Factors: 5, 5, 5
: Repeated: 5, 5
1
#! /usr/bin/env perl
use strict;
use feature 'say';
use Getopt::Long;
use Math::Prime::Util 'factor';
use List::MoreUtils 'duplicates';
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = $ARGV[0] // die "Please specify a number";
my @factors = factor($ARGV[0]);
my @repeated = duplicates(@factors);
if ($verbose)
{
say ": Factors: ", join(", ", @factors);
say ": Repeated: ", join(", ", @repeated);
}
say @repeated ? 1 : 0;
Running it gives the same result as the Raku version:
$ ./power-of-two-integers-perl-errorfix --verbose 8
: Factors: 2, 2, 2
: Repeated: 2
1
$ ./power-of-two-integers-perl-errorfix --verbose 15
: Factors: 3, 5
: Repeated:
0
$ ./power-of-two-integers-perl-errorfix --verbose 125
: Factors: 5, 5, 5
: Repeated: 5
1
The program above crashed for me, as Perl was unable to locate «duplicates»:
$ ./power-of-two-integers-perl 11
Could not find sub 'duplicates' exported by List::MoreUtils at
./power-of-two-integers-perl line 8.
BEGIN failed--compilation aborted at ./power-of-two-integers-perl line 8.
I have no idea why it failed. But a workaround is to remove the «use» line, and add the procedure to the program.
A version of the program («power-of-two-integers-perl-errorfix») doing just that, is included in the zip file.
And that's it.