Perl Weekly Challenge 171: numbers and refenreces

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

and for the sake of some Perl 5, let’s do some stuff also in PostgreSQL Pl/Perl:
Last, the solutions in PostgreSQL PL/PgSQL:

PWC 171 - Task 1

This task was about to compute the first 20 odd abundant numbers, those that have a sum of divisors greater than the number itself. 

sub is-abundant( Int:D $n ) {
    my @divisors = 1;
    @divisors.push: $_ if $n %% $_ for ( 2 .. $n / 2 );
    return @divisors.sum > $n;
}

sub MAIN() {
    my @abundant = lazy gather {
      take $_ if $_ !%% 2 && is-abundant( $_ ) for ( 1 .. Inf );
    };

    @abundant[ 0 .. 20 ].join( "\n" ).say;
}


I decided to create an is-abundant function that extracts all the divisors, put them int the @divisors array and sum them, returning if the sum if greater or not than the original number.
Then, in the MAIN, I lazy gather over all numbers and provide only those odd and that are abundant.

PWC 171 - Task 2

I’m not sure I’ve correctly understood the task. The task was requiring you to make a function that accepts two functions and returns the result of invoking them in a nested way. 

sub compose( Sub:D $f, Sub:D $g ) {
    return sub (*@a) {
        "F( G( { @a } ) )".say;
        $f( $g( @a ) )
    };
}

sub MAIN() {
    my $f = sub (*@a) {
        "F( { @a } )".say;
        return @a;
    };
    my $g = sub (*@a) {
        "G( { @a } )".say;
        return @a;
    };

    my $h = compose( $f, $g );
    $h( 'PWC 171' );
}


I produced two function, $f and $g that both slurp their arguments and return them unmodified. Of course, in real like, such functions are going to do something. Then compose accepts two defined Sub references and invokes them in a nested way.

PWC 171 - Task 1 in PostgreSQL PL/Perl

A translation of the Raku solution: 

CREATE OR REPLACE FUNCTION
pwc171.task1_plperl( int )
RETURNS SETOF INT
AS $CODE$
my ($limit) = @_;

my $is_abundant = sub {
   my ( $n ) = @_;
   my @divisors = ( 1 );

   for ( 2 .. $n / 2 ) {
       next if $n % $_ != 0;
       push @divisors, $_;
   }

   my $sum = 0;
   $sum += $_ for ( @divisors );

   return $sum > $n;
};


for ( 1 .. 99999 ) {
    next if $_ % 2 == 0;
    if ( $is_abundant->( $_ ) ) {
       $limit--;
       return_next( $_ );
    }

    last if $limit <= 0;
}

return undef;

$CODE$
LANGUAGE plperl;


The $is_abundant code references implements the function that sums all divisors of the given odd number and returns true if the number is abundant. Then, the main loop does a return_next to append a new number to the result set in the case it is abundant.

PWC 171 - Task 2 in PostgreSQL PL/Perl

Assuming I understood the tast, theimplementation is just a crafted SELECT: 

CREATE OR REPLACE FUNCTION
pwc171.task2_f( text )
RETURNS TEXT
AS $CODE$
   elog( DEBUG, "F( $_[0] )" );
   return $_[0];
$CODE$
LANGUAGE plperl;


CREATE OR REPLACE FUNCTION
pwc171.task2_g( text )
RETURNS TEXT
AS $CODE$
   elog( DEBUG, "G( $_[0] )" );
   return $_[0];
$CODE$
LANGUAGE plperl;


/*
testdb=> select * from pwc171.task2_plperl( 'pwc171.task2_f', 'pwc171.task2_g', 'Hello World' );
DEBUG:  Query [SELECT pwc171.task2_f( pwc171.task2_g( 'Hello World' ) ) AS compose;]
DEBUG:  G( Hello World )
DEBUG:  F( Hello World )
 task2_plperl
--------------
 Hello World
*/
CREATE OR REPLACE FUNCTION
pwc171.task2_plperl( text, text, text )
RETURNS TEXT
AS $CODE$



my $compose = sub {
   my $query = sprintf( "SELECT %s( %s( '%s' ) ) AS compose;",
               $_[ 0 ],
               $_[ 1 ],
               $_[ 2 ] );
   elog( DEBUG, "Query [$query]" );
   my $result_set = spi_exec_query( $query );
   return $result_set->{ rows }[ 0 ]->{ compose };
};

return $compose->( @_ );
$CODE$
LANGUAGE plperl;


I wrote a couple of functions, f and g just to use to test the machinery.
The main function build a crafted nested SELECT that invokes all the functions in the right order, and then returns the result outside. Why using an anonymous code reference? Well, because if you want to transform that into a set returning function is easier!

PWC 171 - Task 1 in PostgreSQL PL/PgSQL

Quite same approach as in the PL/Perl solution: 

CREATE OR REPLACE FUNCTION
pwc171.task1_plpgsql( l int DEFAULT 20 )
RETURNS SETOF INT
AS $CODE$
DECLARE
        s int := 0;
        i int;
        d int;
BEGIN
      FOR i IN  2 .. 99999  LOOP
          IF i % 2 = 0 THEN
             CONTINUE;
          END IF;
          s := 0;
          FOR d in  2 .. ( i / 2 )  LOOP
              IF i % d = 0 THEN
                 s := s + d;
              END IF;
          END LOOP;

          IF s > i THEN
             RETURN NEXT i;
             l := l - 1;

             IF l = 0 THEN
                RETURN;
             END IF;
          END IF;
    END LOOP;
RETURN;
END
$CODE$
LANGUAGE plpgsql;


The only different with the Perl and Raku solutions is that I don’t care about divisors, but keep only the sum of them while processing them.

PWC 171 - Task 2 in PostgreSQL PL/PgSQL

Easy enough to be done with a simple query: 

CREATE OR REPLACE FUNCTION
pwc171.task2_plpgsql( f text DEFAULT 'pwc171.task2_f',
                      g text DEFAULT 'pwc171.task2_g',
                      v text DEFAULT 'PWC 171' )
RETURNS SETOF TEXT
AS $CODE$
BEGIN
        RETURN QUERY
        EXECUTE format( 'SELECT * FROM %s( %s( $$%s$$ ) )', f, g, v );
END
$CODE$
LANGUAGE plpgsql;


The EXECUTE accepts a dynamically built query, built on top of format() (a kind of printf) that does the SELECT of the nested functions. Note the usage of dollar quoting $$ around the function argument to escape it in already quoted string.

The article Perl Weekly Challenge 171: numbers and references has been posted by Luca Ferrari on June 27, 2022

Tags: raku , perlweeklychallenge , perl