Advent Calendar - December 17, 2023

Sunday, Dec 17, 2023| Tags: Raku

Advent Calendar 2023

|   Day 16   |   Day 17   |   Day 18   |


The gift is presented by Luca Ferrari. Today he is talking about his solution to The Weekly Challenge - 228. This is re-produced for Advent Calendar 2023 from the original post.



Sums and Swaps


PWC 228 - Task 1 - Raku Implementation

You are given an array of integers.

Write a script to find out the sum of unique elements in the given array.

Example 1
    Input: @int = (2, 1, 3, 2)
    Output: 4

    In the given array we have 2 unique elements (1, 3).

Example 2
    Input: @int = (1, 1, 1, 1)
    Output: 0

    In the given array no unique element found.

Example 3
    Input: @int = (2, 1, 3, 4)
    Output: 10

    In the given array every element is unique.

The first task was about summing only the non-repeated numbers given as input.


sub MAIN( *@nums  where { @nums.elems == @nums.grep( * ~~ Int ).elems } ) {
    my $bag = @nums.Bag;
    $bag.keys.grep( { $bag{ $_ } == 1 } ).sum.say;
}

My solution is to classify the input array as a Bag, then to grep only those keys that have a value of 1, and sum those keys.


PWC 228 - Task 2 - Raku Implementation

You are given an array of integers in which all elements are unique.

Write a script to perform the following operations until the array is empty and return the total count of operations.

If the first element is the smallest then remove it otherwise move it to the end.

Example 1
    Input: @int = (3, 4, 2)
    Ouput: 5

    Operation 1: move 3 to the end: (4, 2, 3)
    Operation 2: move 4 to the end: (2, 3, 4)
    Operation 3: remove element 2: (3, 4)
    Operation 4: remove element 3: (4)
    Operation 5: remove element 4: ()

Example 2
    Input: @int = (1, 2, 3)
    Ouput: 3

    Operation 1: remove element 1: (2, 3)
    Operation 2: remove element 2: (3)
    Operation 3: remove element 3: ()

This task was about doing a kind of bubble sort on an array, removing the smallest one if it is the leftmost, and counting the operations required to empty the array.


sub MAIN( *@nums where { @nums.grep( * ~~ Int ).elems == @nums.elems } ) {
    my @current = @nums;
    my $moves = 0;

    while ( @current ) {
        my $swap = @current.shift;
        @current.push: $swap  if $swap > @current.min;
        $moves++;
    }

    $moves.say;
}

Until the @current array is empty, I extract the leftmost value in the array by means of a shift operation. If such value is the current minimum, than nothing else is required (since the element has been already removed from the array), otherwise I need to push it to the end of the array. In any case, an operation has been performed, so $moves is increased.


PWC 228 - Task 1 - PL/Perl Implementation


Same idea as in the Raku implementation: I do classify the input array, then grep to keep only unique keys, and then sum.


CREATE OR REPLACE FUNCTION
pwc228.task1_plperl( int[] )
RETURNS int
AS $CODE$
   my ( $array ) = @_;
   my $bag = {};

   # classify the elements
   $bag->{ $_ }++ for ( $array->@* );

   my ( @uniques ) = grep( { $bag->{ $_ } == 1 } keys( $bag->%* ) );
   my $sum = 0;
   $sum += $_ for ( @uniques );
   return $sum;
$CODE$
LANGUAGE plperl;

PWC 228 - Task 2 - PL/Perl Implementation


The same idea of the Raku implementation, but a little more verbose since I define a min inner function to calculate the min value of the given array. Also please note that there is the need to terminate the loop when the min function returns an undef value.


CREATE OR REPLACE FUNCTION
pwc228.task2_plperl( int[] )
RETURNS int
AS $CODE$
   my ( $array ) = @_;
   my $moves = 0;

   # a function to find out the min value
   my $min = sub {
      my $min = undef;
      for ( $_[0]->@* ) {
            $min = $_ if ( ! $min || $min > $_ );
      }

      return $min;
   };

   while ( scalar $array->@* ) {
        my ( $swap, $min ) = ( shift( $array->@* ), $min->( $array ) );
     $moves++;
     last if ! $swap;
     last if ! $min;
     push $array->@*, $swap  if ( $swap > $min );

   }

   return $moves;
$CODE$
LANGUAGE plperl;

PWC 228 - Task 1 - PL/PgSQL Implementation


This task can be solved with a single SQL query:

CREATE OR REPLACE FUNCTION
pwc228.task1_plpgsql( a int[] )
RETURNS int
AS $CODE$
   WITH BAG as (
      SELECT v
      FROM unnest( a ) v
      GROUP BY v
      HAVING count(*) = 1
   )
   SELECT sum( v )
   FROM bag;
$CODE$
LANGUAGE sql;

The bag part of the query materializes the unique set of values that are not repeated, then the other part of the query performs the sum.


PWC 228 - Task 2 - PL/PgSQL Implementation


The second task can be solved as in the PL/Perl way, but it is importan to note that PostgreSQL does not provide a shift like array operation.


CREATE OR REPLACE FUNCTION
pwc228.task2_plpgsql( a int[] )
RETURNS int
AS $CODE$
DECLARE
    current_min int;
    current_swap int;
    moves int := 0;
BEGIN
    WHILE array_length( a, 1 ) > 1 LOOP
          -- find the min value
          SELECT min( v )
          INTO current_min
          FROM unnest( a ) v;



          -- unshift the first element
          current_swap := a[ 1 ];
          a := a[ 2 : array_length( a, 1 ) ];

          IF current_swap > current_min THEN
               a := array_append( a, current_swap );
          END IF;

          moves := moves + 1;

    END LOOP;

    RETURN moves;

END
$CODE$
LANGUAGE plpgsql;

The trick to simulate the shift operation is to access an array slice starting from 2 (because in SQL the arrays all start at index 1).


If you have any suggestion then please do share with us perlweeklychallenge@yahoo.com.

|   Advent Calendar 2023   |

SO WHAT DO YOU THINK ?

If you have any suggestions or ideas then please do share with us.

Contact with me