Perl Weekly Challenge 156: Pernicious weirdness
It is sad that, after more than two years of me doing Raku, I still don’t have any production code project to work on. Therefore, in order to keep my coding and Raku-ing (is that a term?) knowdledge, I try to solve every Perl Weekly Challenge tasks.In the following, the assigned tasks for Challenge 156.
and for the sake of some Perl 5, let’s do some stuff also in PostgreSQL Pl/Perl:
COVID-19
Yes, I’ve Covid-19 and I’ve done this PWC late because I was sick. I’m not scared, at the moment I’m almost fine.PWC 156 - Task 1
Produce the first ten pernicious numbers, that are numbers that have the sum of their binary representation that is prime number. It is quite easy to implement this in Raku:sub MAIN( Int $limit where { $limit > 0 } = 10 ) {
my @pernicious = lazy gather {
for 1 .. Inf {
take $_ if $_.base( 2 ).comb.sum.is-prime;
}
};
@pernicious[ 0 .. $limit - 1 ].join( ', ' ).say;
}
I use a
lazy gather
block to generate the array of required numbers. Every number is translated into its binary form by means of base( 2 )
, separated into its digits by means of comb
and the sum of all the binary digits is made up by sum
. If the result is a prime number, i.e., is-prime
, the result is take
n into the array.
In the end I print the slice of the array.
PWC 156 - Task 2
Weird numbers this time: numbers that have a sum of divisors that is greater than the number itself and that cannot be obtained by any sum of any divisors.sub MAIN( Int $n where { $n > 0 } ) {
my @divisors = ( 1 .. $n - 1 ).grep( $n %% * );
'0'.say and exit if @divisors.sum <= $n
|| @divisors.combinations.map( *.sum ).grep( * == $n ).elems > 0;
'1'.say;
}
As first step, I compute the
@divisors
by means of grep
ping all the values that are divisors of the given number.
Then, I inspect the sum
of the @divisors
to see if it is greater than the number itself, and then use all combinations
of the divisors to see if any of the sum
provides the number itself, in such case the number is not weird.
PWC 156 - Task 1 in PostgreSQL
An implementation with a couple of PL/Perl functions and a single query. Pure Pl/Perl implementation, with a single function (that has nested anonymoussub
s).
CREATE SCHEMA IF NOT EXISTS pwc156;
CREATE OR REPLACE FUNCTION
pwc156.is_prime( int )
RETURNS bool
AS $CODE$
return 0 if $_[0] <= 1;
for my $i ( 2 .. $_[0] - 1 ) {
return 0 if $_[0] % $i == 0;
}
return 1;
$CODE$
LANGUAGE plperl;
CREATE OR REPLACE FUNCTION
pwc156.sumbits( int[] )
RETURNS int
AS $CODE$
my $sum = 0;
for my $bit ( @{$_[0]} ) {
$sum += $bit;
}
return $sum;
$CODE$
LANGUAGE plperl;
SELECT n
FROM generate_series( 1, 1000 ) n
WHERE pwc156.is_prime( pwc156.sumbits( regexp_split_to_array( n::bit(10)::text, '' )::int[] ) )
LIMIT 10;
The first function is the usual
is_prime
, built to return the right values for the given input.
The
sumbits
function accepts an array of digits and returns its sum. It is interesting to note that the PostgreSQL ARRAY
is not the same as a Perl list, and in fact is managed by PL/Perl by a specific object that can be used as an array reference, hence @{ $_[0] }
.
The query does all the work:
generate_series
provides the first thousand integers;- the cast to
::bit(10)
converts the integer into its binary representation; regexp_slit_to_array
converts the text binary representation into an array of integers;sumbits
computes the sum of the bits;is_prime
sees if the sum is a prime number.
PWC 156 - Task 2 in PostgreSQL
Here I decided to use a library, hence the need forplperlu
to load an external module. The module is Algorithm::Knapsack
that can provide a brute force implementation of the knapsack problem. The idea is that you can initialize the knapsack with a capacity and a set of weights, and the system computes all possible solutions that fill the bag at its maximum. The idea therefore is to see if any of these solutions fill the whole capacity, in our case the input number.
CREATE SCHEMA IF NOT EXISTS pwc156;
CREATE OR REPLACE FUNCTION
pwc156.weird( int )
RETURNS bool
AS $CODE$
use Algorithm::Knapsack;
my @divisors;
for my $i ( 2 .. $_[0] - 1 ) {
push @divisors, $i if $_[0] % $i == 0;
}
my $sum = 0;
for my $i ( @divisors ) {
$sum += $i;
}
return 0 if $sum <= $_[0];
my $knapsack = Algorithm::Knapsack->new(
capacity => $_[0],
weights => \@divisors,
);
$knapsack->compute();
foreach my $solution ($knapsack->solutions()) {
my @founds = @divisors[ $solution->@* ];
my $sum = 0;
$sum += $_ for ( @founds );
return 0 if $sum == $_[0];
}
return 1;
$CODE$
LANGUAGE plperlu;
SELECT n
FROM generate_series( 1, 100 ) n
WHERE pwc156.weird( n );
The
weird
function does everything:
- computes the array of the
@divisors
; - initializes the
$knapsack
and computes the solutions; - then inspect every solution to see if the sum of the divisors provides back the input number.
The query does everything, testing the implementation.