aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-216/luca-ferrari/blog-1.txt1
-rw-r--r--challenge-216/luca-ferrari/blog-2.txt1
-rw-r--r--challenge-216/luca-ferrari/blog-3.txt1
-rw-r--r--challenge-216/luca-ferrari/blog-4.txt1
-rw-r--r--challenge-216/luca-ferrari/blog-5.txt1
-rw-r--r--challenge-216/luca-ferrari/blog-6.txt1
-rw-r--r--challenge-216/luca-ferrari/postgresql/ch-1.plperl26
-rw-r--r--challenge-216/luca-ferrari/postgresql/ch-1.sql33
-rw-r--r--challenge-216/luca-ferrari/postgresql/ch-2.plperl49
-rw-r--r--challenge-216/luca-ferrari/postgresql/ch-2.sql67
-rw-r--r--challenge-216/luca-ferrari/raku/ch-1.p625
-rw-r--r--challenge-216/luca-ferrari/raku/ch-2.p634
12 files changed, 240 insertions, 0 deletions
diff --git a/challenge-216/luca-ferrari/blog-1.txt b/challenge-216/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..bc60db2e40
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1
diff --git a/challenge-216/luca-ferrari/blog-2.txt b/challenge-216/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..a17a747527
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task2
diff --git a/challenge-216/luca-ferrari/blog-3.txt b/challenge-216/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..e26b6dc467
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1plperl
diff --git a/challenge-216/luca-ferrari/blog-4.txt b/challenge-216/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..8d03a8fda7
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task2plperl
diff --git a/challenge-216/luca-ferrari/blog-5.txt b/challenge-216/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..2aeb4b3370
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1plpgsql
diff --git a/challenge-216/luca-ferrari/blog-6.txt b/challenge-216/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..de0f0ae486
--- /dev/null
+++ b/challenge-216/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task2plpgsql
diff --git a/challenge-216/luca-ferrari/postgresql/ch-1.plperl b/challenge-216/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..e254eb6d7b
--- /dev/null
+++ b/challenge-216/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,26 @@
+--
+-- Perl Weekly Challenge 216
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc216;
+
+CREATE OR REPLACE FUNCTION
+pwc216.task1_plperl( text, text[])
+RETURNS SETOF text
+AS $CODE$
+ my ( $registration_code, $strings ) = @_;
+ for my $word ( $strings->@* ) {
+ my $matches = 0;
+ for my $needle ( split( //, $word ) ) {
+ $matches++ if ( grep( { $needle eq $_ } split( //, $registration_code ) ) );
+ }
+
+ return_next( $word ) if ( $matches == length( $word ) );
+ }
+
+return undef;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-216/luca-ferrari/postgresql/ch-1.sql b/challenge-216/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..b929a9a3fb
--- /dev/null
+++ b/challenge-216/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,33 @@
+--
+-- Perl Weekly Challenge 216
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc216;
+
+CREATE OR REPLACE FUNCTION
+pwc216.task1_plpgsql( rc text, strings text[] )
+RETURNS SETOF TEXT
+AS $CODE$
+DECLARE
+ current_word text;
+ matches int;
+BEGIN
+ FOREACH current_word IN ARRAY strings LOOP
+ SELECT count(*)
+ INTO matches
+ FROM regexp_split_to_table( rc, '' ) r
+ , regexp_split_to_table( current_word, '' ) w
+ WHERE r = w;
+
+ IF matches = length( current_word ) THEN
+ RETURN NEXT current_word;
+ END IF;
+ END LOOP;
+
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-216/luca-ferrari/postgresql/ch-2.plperl b/challenge-216/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..de9b5baafd
--- /dev/null
+++ b/challenge-216/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,49 @@
+--
+-- Perl Weekly Challenge 216
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc216;
+
+CREATE OR REPLACE FUNCTION
+pwc216.task2_plperl( text, text[] )
+RETURNS TABLE ( sticker text, run int, letter text )
+AS $CODE$
+ my ( $needle, $words ) = @_;
+ my $searching_for = {};
+
+ # create the bag
+ for ( split //, $needle ) {
+ $searching_for->{ $_ }++;
+ }
+
+ my $run = 0;
+ while ( grep( { $_ >= 1 } values( $searching_for->%* ) ) ) {
+ $run++;
+ my $found = 0;
+
+ for my $letter ( keys $searching_for->%* ) {
+ next if ! $searching_for->{ $letter };
+ for my $word ( $words->@* ) {
+ if ( grep( { $_ eq $letter } split( //, $word ) ) ) {
+ $searching_for->{ $letter }--;
+ return_next( { run => $run, sticker => $word, letter => $letter } );
+ $found++;
+ last;
+ }
+ }
+
+
+ }
+
+ if ( ! $found ) {
+ elog(INFO, "Cannot find match with letter $letter in any word!" );
+ return undef;
+ }
+ }
+
+return undef;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-216/luca-ferrari/postgresql/ch-2.sql b/challenge-216/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..ceca3277e2
--- /dev/null
+++ b/challenge-216/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,67 @@
+--
+-- Perl Weekly Challenge 216
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc216;
+
+CREATE OR REPLACE FUNCTION
+pwc216.task2_plpgsql( word text, stickers text[] )
+RETURNS TABLE ( sticker text, run int, letter text )
+AS $CODE$
+DECLARE
+ cl text;
+ current_sticker text;
+ m int;
+BEGIN
+ CREATE TEMPORARY TABLE IF NOT EXISTS letters( l text, c int DEFAULT 1, s text );
+ TRUNCATE letters;
+
+ INSERT INTO letters( l, c )
+ SELECT ll, count(*)
+ FROM regexp_split_to_table( word, '' ) ll
+ GROUP BY ll;
+
+ FOUND := true;
+ run := 0;
+ WHILE FOUND LOOP
+ run := run + 1;
+
+ PERFORM count(*)
+ FROM letters
+ WHERE c > 0;
+
+ IF NOT FOUND THEN
+ RETURN;
+ END IF;
+
+ FOR cl IN SELECT l FROM letters WHERE c > 0 LOOP
+ FOREACH current_sticker IN ARRAY stickers LOOP
+ SELECT count(*)
+ INTO m
+ FROM regexp_split_to_table( current_sticker, '' ) s
+ WHERE s = cl;
+
+
+ IF m <= 0 THEN
+ CONTINUE;
+ END IF;
+
+ UPDATE letters
+ SET c = c - m
+ , s = s || ', ' || current_sticker;
+
+ sticker := current_sticker;
+ letter := cl;
+
+ RETURN NEXT;
+ EXIT;
+ END LOOP;
+ END LOOP;
+ END LOOP;
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-216/luca-ferrari/raku/ch-1.p6 b/challenge-216/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..bdef28ee4d
--- /dev/null
+++ b/challenge-216/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,25 @@
+#!raku
+
+#
+# Perl Weekly Challenge 216
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+#
+
+sub MAIN( *@strings is copy ) {
+ my @registration-code = @strings.pop.comb;
+
+ # first implementation
+ for @strings -> $word {
+ my @result.push: @registration-code.grep( $_ ) for $word.comb;
+ say $word if @result.join ~~ $word;
+ }
+
+ # second implementation
+ my $sorted-registration-code = @registration-code.sort.join;
+ for @strings -> $word {
+ say $word if ( $sorted-registration-code ~~ / ^ { $word.comb.sort.join } / );
+ }
+
+}
diff --git a/challenge-216/luca-ferrari/raku/ch-2.p6 b/challenge-216/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..9544e801f6
--- /dev/null
+++ b/challenge-216/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,34 @@
+#!raku
+
+#
+# Perl Weekly Challenge 216
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-216/>
+#
+
+sub MAIN( *@strings is copy ) {
+ my $letters = BagHash.new: @strings.pop.comb;
+ my %stickers;
+ my $loop = 0;
+
+ while ( $letters.values.grep( * >= 1 ) ) {
+ $loop++;
+
+ for $letters.keys -> $needle {
+ next if ! $letters{ $needle };
+ my $found = False;
+ for @strings -> $word {
+ if ( $word.comb.grep( $needle ) ) {
+ $letters{ $needle }--;
+ %stickers{ $word }{ $loop }.push: $needle;
+ $found = True;
+ }
+ }
+
+ say "Cannot find $needle in any word!" and exit if ! $found;
+ }
+ }
+
+ "$_ used { %stickers{ $_ }.keys.elems } times".say for %stickers.keys;
+}
generated by cgit (git 2.34.1) at 2026-07-02 07:03:52 +0000