# Perl Weekly Challenge 233: Sorting, by similarity and frequency

This post presents my solutions to the Perl Weekly Challenge 233.
I keep doing the Perl Weekly Challenge in order to mantain my coding skills in good shape, as well as in order to learn new things, with particular regard to Raku, a language that I love.
This week, I solved the following tasks:
The PL/Perl implementations are very similar to a pure Perl implementation, even if the PostgreSQL environment could involve some more constraints. Similarly, the PL/PgSQL implementations help me keeping my PostgreSQL programming skills in good shape.

# Raku Implementations

## PWC 233 - Task 1 - Raku Implementation

The first task was about finding similar words, words made by the same amount and value of letters. This is quite simple, after all: extract all the letters from a word, sort them, so to create a kind of unique key, and append each word within the same key.

``````sub MAIN( *@words where { @words.elems > 1  } ) {
my %similars;
for @words -> \$word {
my \$key = \$word.comb.sort.join;
%similars{ \$key }.push: \$word;
}

say 'Similar words: ' ~ \$_.join( ' <-> ' ) for %similars.values.grep( *.elems > 1 );
}

``````

## PWC 233 - Task 2 - Raku Implementation

The second task was about sorting numbers by means of their decreasing frequency of appearence in the input. There is the need for a kind of bag to this aim.

``````sub MAIN( *@nums where { @nums.elems == @nums.grep( * ~~ Int ) } ) {
my %sorting;
for @nums -> \$current {
my \$frequency = @nums.grep( * == \$current ).elems;
%sorting{ \$frequency } //= Array.new;
%sorting{ \$frequency }.push: \$current if ( ! %sorting{ \$frequency }.grep( * == \$current ) );
}

%sorting{ \$_ }.sort.join( ',' ).say for %sorting.keys.sort;

}

``````

Every cell of `%sorting` is keeping an array of numbers, and is keyed by the `\$frequency`, that is obtained by `grep`ping and counting all the elements in the input array. In the end, printing out the values corresponding to the sorted keys (i.e., sorted frequencies) does the trick.

# PL/Perl Implementations

## PWC 233 - Task 1 - PL/Perl Implementation

The implementation follows the same idea of the Raku one: use an hash `\$similars` that handles the sorted list of letters as the key, and the list of words as values. Then cross the hash with the key and, in the case the list is made by more than one word, return all of them.

``````CREATE OR REPLACE FUNCTION
RETURNS SETOF text
AS \$CODE\$
my ( \$words ) = @_;

my \$similars = {};

for my \$word ( \$words->@* ) {
my \$key = join '', sort split //, \$word;
push \$similars->{ \$key }->@*, \$word;
}

for my \$key ( keys \$similars->%* ) {
next if \$similars->{ \$key }->@* <= 1;
return_next( \$_ ) for ( \$similars->{ \$key }->@* );
}

return undef;

\$CODE\$
LANGUAGE plperl;

``````

## PWC 233 - Task 2 - PL/Perl Implementation

Same implementation as the Raku solution, only a little more verbose.

``````CREATE OR REPLACE FUNCTION
RETURNS SETOF int
AS \$CODE\$
my ( \$nums ) = @_;

my \$freqs = {};

for my \$current ( \$nums->@* ) {
my \$f = grep { \$_ == \$current } \$nums->@*;
push \$freqs->{ \$f }->@*, \$current;
}

for my \$f ( sort keys \$freqs->%* ) {
return_next( \$_ ) for ( sort \$freqs->{ \$f }->@* );
}
return undef;

\$CODE\$
LANGUAGE plperl;

``````

# PostgreSQL Implementations

## PWC 233 - Task 1 - PL/PgSQL Implementation

Implemented with a couple of queries and a temporary table.

``````CREATE OR REPLACE FUNCTION
RETURNS SETOF text
AS \$CODE\$
DECLARE
current_word text;
BEGIN
CREATE TEMPORARY TABLE IF NOT EXISTS sorting( key text, word text );
TRUNCATE sorting;

FOREACH current_word IN ARRAY words LOOP
INSERT INTO sorting( key, word )
SELECT string_agg( k::text, '' )::text, current_word
FROM ( SELECT v::text
FROM regexp_split_to_table( current_word, '' ) v
ORDER BY 1
) k
;
END LOOP;

RETURN QUERY
SELECT word
FROM   sorting
WHERE  key IN ( SELECT key
FROM sorting
GROUP BY key
HAVING COUNT(*) > 1 );

END
\$CODE\$
LANGUAGE plpgsql;

``````

In the beginning there is the creation of the temporary table and its truncation, to prevent dirty data from previous executions. Then a single query inserts into the table the ordered letters of the word, and the word itself. Last, a query returns the words out of the table, having selected only those keys that appears more than once.

## PWC 233 - Task 2 - PL/PgSQL Implementation

Room for an UPSERT here! Again, use a temporary table as storage.

``````CREATE OR REPLACE FUNCTION
RETURNS SETOF int
AS \$CODE\$
DECLARE
current_number int;
BEGIN
CREATE TEMPORARY TABLE IF NOT EXISTS freqs( v int, f int DEFAULT 1, primary key ( v ) );
TRUNCATE freqs;

FOREACH current_number IN ARRAY nums LOOP
INSERT INTO freqs( v )
VALUES( current_number )
ON CONFLICT ( v )
DO UPDATE
SET f = ( SELECT f + 1
FROM freqs
WHERE v = EXCLUDED.v )
;
END LOOP;

RETURN QUERY
SELECT v
FROM freqs
ORDER BY f DESC, v DESC;
END
\$CODE\$
LANGUAGE plpgsql;

``````

I traverse the array of numbers, and insert into the table every number. In the case the number is already present, I use the UPSERT capability to update the frequency field instead. Therefore, the result, is to return the records out of the table having sorted them by frequency.

The article Perl Weekly Challenge 233: Sorting, by similarity and frequency has been posted by Luca Ferrari on September 4, 2023