Wherein we do something, anything, to distract us from this mess. Carpe diem!
THE WEEKLY CHALLENGE – PERL & RAKU #85
chapter one:
“It was very effective!”
TASK #1 › Triplet Sum
Submitted by: Mohammad S Anwar
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
Method
A couple of rather easy challenges this week. With the continuous ongoing pressing distractions of the world I suspect this week’s post to be a bit shorter than usual. We shall have to see, won’t we?
The first challenge seems well defined: we need to evaluate combinations of three elements from a list to see if they sum to within the defined range.
So what we have here is another combinations problem, this one limited to sets of three members, or n choose 3. To make it a little more interesting, rather than reach for a module, this time we’ll just roll up a homegrown combinations generator. It’s generic and returns arrays of indices rather than the actual selected array elements, so the actual substitution with real values takes place in the body of the routine. That was next time we need it, we can just grab it and reuse it. This combination generator will be bulk part of the code, as the conditional evaluation is pretty straightforward.
Once we have generated a list of combinations, the sums of the elements are computed and checked immediately against the conditional, and any that pass the validation cause the program to print a positive outcome and exit.
We don’t care about the specific combination that summed within the range, nor whether there was more than one possible such sequence. One solution is all that is needed to prove existence. Thus whenever a valid combination arises, the program outputs a 1 for a valid response and exits without continuing further.
Perl Solution
For the Perl solution we, as I said, build a machine that spits out numeric combinations of a sequence starting from 0. We only need 3-sets, but the routine is generic and accepts a parameter for combination lengths, adding elements to the groups until the correct number is reached. These sets can then be used in turn to reference the indices in our initial array, and the value sets from that substitution are summed. Again, we’re not using modules today so the summing is a simple iteration. The conditional is performed immediately and should any achieve success we print out findings and exit, else the program flow falls through to a negative result.
The machine itself starts with a list of arrays, each composed of one element, ranging from 0 to the end of the list minus the number of combinations. We will need to always leave enough room after a given element to complete the combination with the remaining values in the sequence, so the upper value is limited by this. For example, in the combination [ 2, 3, 4, 5 ]
, for a set of 4 elements selected from 6 (remember 0-indexing), we could not start this particular set with 3, as we do not have enough values higher than 3 to take four members.
From that point the combinations list gets recycled through the routine. With every pass the list is recreated, replacing every element with a new set of lists encompassing that partial list combined with every possible next element. In this way every pass through the routine adds one more element to the combinations. When the specified length is reached, recursion stops and the final array of arrays is returned.
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
@ARGV == 0 and @ARGV = (1.2, 0.4, 0.1, 2.5);
my @arr = @ARGV;
my @index_combos = combinations( scalar( @arr ), 3 )->@* ;
for (@index_combos) {
my $sum = 0;
for my $idx ($_->@*) {
$sum += $arr[$idx];
}
if (1 < $sum && $sum [0]->@* == $num_elems;
my @newlist = ();
my $pos = $list->[0]->@*; ## this position, num_elems of prev list + 1
for my $combo ( $list->@* ) {
my $start = $combo->[-1] // -1 ; ## value of last elem in list + 1
my $end = $length - $num_elems + $pos; ## max - length + position
push @newlist, [ $combo->@*, $_ ] for (++$start .. $end );
}
return combinations( $length, $num_elems, \@newlist);
}
Raku Solution
In Raku function chaining make this whole process quite elegant. Of course we get a combinations function right out of the box, so we will use that to produce different selections from our input array. The output from this function, which is an array of combination arrays, is passed to map, where each array is replaced by its sum. The summed values are evaluated against the conditional in a grep filter, only allowing through those that pass. If the result array still contains any elements we have found a triplet and return 1 for success.
unit sub MAIN ( *@reals ) ;
@real.elems == 0 and @reals = (1.2, 0.4, 0.1, 2.5);
say @reals .combinations(3)
.map({sum $_})
.grep({ 1 < $_ < 2 })
.elems ?? 1
!! 0 ;
chapter two:
“A Study in Power”
TASK #2 › Power of Two Integers
Submitted by: Mohammad S Anwar
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
Method
At first glance this looks impressively complex, but that illusion falls apart quite quickly under scrutiny. The reason for this is in the nature of exponentiation: higher powers are lower powers multiplied by the root again. So any power of three will be found first as a power of two, and any power of two is going to be a factor. So if we find the factors, we’re already most of the way there.
The way to find a factor is by trying out numbers up the square root, so that’s what we’ll do. If we do find a factor, we try dividing out the target repeatedly, and if the operation evenly divides down until the result is 1, we have a winner.
Perl Solution
Two solutions are provided. They both function the same way, only one is a more verbose version that discusses the results and the other a minimal version without frills that returns 1/0.
Both check every number up to the square root of the target for divisibility. If a number is found to be a factor, the target value is divided and the remainder checked; this process continues until the last division yields a quotient of 1 or a remainder is found.
In the compact version the requested response is provided, so on the first occurrence of completely dividing down the target a 1 is output and the program exits. In the verbose version each sucessful value and power is noted and evaluation continues to find all possible combinations of nm that produce the target.
As almost all numbers will not divide out and only a few will continue up into multiple powers, the number of values checked approaches just the square root, with checking multiple powers making no meaningful difference as the input values get larger, so the algorithmic complexity is 𝖮(√n).
And oh yea, by setting the $VERBOSE flag to 2, a complete blow-by-blow of the calculation is provided. It gets a little long to put here, but it’s there if you want it.
~/PWC/85_2_power_to_the_wholes.pl
-------------------------------------------------
2 ^ 24
4 ^ 12
8 ^ 8
16 ^ 6
64 ^ 4
256 ^ 3
4096 ^ 2
1
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
my $VERBOSE = 1;
my $input = shift @ARGV || 16777216; ## 2^16, etc
$VERBOSE and say $_ for root_power_verbose($input);
say '';
## minimal
for my $try ( 2..sqrt $input ) {
my $copy = $input;
while ($copy % $try == 0) {
$copy /= $try;
$copy == 1 and say 1 and exit;
}
}
say 0;
## verbose
## takes longer because it will not short-circuit, returns list of all solutions
sub root_power_verbose {
my ($input) = @_;
my $max = sqrt $input;
my @out;
for my $try ( 2..$max ) {
say "trying $try" if $VERBOSE == 2;
my $count = 0;
my $copy = $input;
while ($copy % $try == 0) {
$count++;
say "\tcount is $count" if $VERBOSE == 2;
$copy /= $try;
if ($copy == 1) {
say "\t\t\tsuccess!" if $VERBOSE == 2;
push @out, "$try ^ $count";
}
}
}
return @out ? @out
: "no powers found";
}
Raku Solution
unit sub MAIN (Int $input where $input > 0 = 823543) ; ## 7^7
for 2..sqrt $input -> $try {
my $copy = $input;
while $copy %% $try and $copy /= $try {
$copy == 1 and 1.say and exit;
}
}
0.say;