Merge pull request #9238 from fluca1978/PWC247

PWC 247

16 files changed, 295 insertions, 0 deletions

diff --git a/challenge-247/luca-ferrari/blog-1.txt b/challenge-247/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..b18bcc1cab
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task1
diff --git a/challenge-247/luca-ferrari/blog-2.txt b/challenge-247/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..0d7fe57f70
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task2
diff --git a/challenge-247/luca-ferrari/blog-3.txt b/challenge-247/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..fea51cace7
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task1plperl
diff --git a/challenge-247/luca-ferrari/blog-4.txt b/challenge-247/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..a7c02c58ed
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task2plperl
diff --git a/challenge-247/luca-ferrari/blog-5.txt b/challenge-247/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..0a187f4191
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task1plpgsql
diff --git a/challenge-247/luca-ferrari/blog-6.txt b/challenge-247/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..2b65ea8baa
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task2plpgsql
diff --git a/challenge-247/luca-ferrari/blog-7.txt b/challenge-247/luca-ferrari/blog-7.txt
new file mode 100644
index 0000000000..1fea1faff9
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-7.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task1python
diff --git a/challenge-247/luca-ferrari/blog-8.txt b/challenge-247/luca-ferrari/blog-8.txt
new file mode 100644
index 0000000000..b5843707e2
--- /dev/null
+++ b/challenge-247/luca-ferrari/blog-8.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/11/PerlWeeklyChallenge247.html#task2python
diff --git a/challenge-247/luca-ferrari/postgresql/ch-1.plperl b/challenge-247/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..dbe0cad5b7
--- /dev/null
+++ b/challenge-247/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,33 @@
+--
+-- Perl Weekly Challenge 247
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc247;
+
+CREATE OR REPLACE FUNCTION
+pwc247.task1_plperl( text[] )
+RETURNS TABLE( santa text, receiver text )
+AS $CODE$
+   my ( $names ) = @_;
+
+   my @santas = $names->@*;
+   my @receivers = $names->@*;
+
+   while ( @santas > 0 && @receivers > 0 ) {
+      my ( $s, $r ) = ( int( rand( scalar( @santas ) ) ), int( rand( scalar( @receivers ) ) ) );
+      my $santa = @santas[ $s ];
+      my $receiver = @receivers[ $r ];
+      next if ! $santa || ! $receiver || $santa eq $receiver;
+
+     return_next( { santa => $santa,
+       		  receiver => $receiver } );
+     delete @santas[ $s ];
+     delete @receiver[ $r ];
+   }
+
+   return undef;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-247/luca-ferrari/postgresql/ch-1.sql b/challenge-247/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..7a9954be8e
--- /dev/null
+++ b/challenge-247/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,66 @@
+--
+-- Perl Weekly Challenge 247
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc247;
+
+CREATE OR REPLACE FUNCTION
+pwc247.task1_plpgsql( n text[] )
+RETURNS TABLE( current_santa text, current_receiver text )
+AS $CODE$
+
+DECLARE
+	remaining int;
+BEGIN
+	CREATE TEMPORARY TABLE IF NOT EXISTS santas( santa text );
+	CREATE TEMPORARY TABLE IF NOT EXISTS receivers( receiver text );
+	TRUNCATE santas;
+	TRUNCATE receivers;
+
+	INSERT INTO santas
+	SELECT unnest( n );
+
+	INSERT INTO receivers
+	SELECT unnest( n );
+
+	SELECT count(*)
+	INTO remaining
+	FROM santas;
+
+	WHILE remaining > 0 LOOP
+
+		SELECT santa
+		INTO current_santa
+		FROM santas
+		ORDER BY random()
+		LIMIT 1;
+
+
+		SELECT	receiver
+		INTO current_receiver
+		FROM receivers
+		ORDER BY random()
+		LIMIT 1;
+
+
+		IF current_receiver = current_santa THEN
+		   CONTINUE;
+		END IF;
+
+		RETURN NEXT;
+
+		DELETE FROM santas    WHERE santa = current_santa;
+		DELETE FROM receivers WHERE receiver = current_receiver;
+
+		SELECT count(*)
+		INTO remaining
+		FROM santas;
+
+	END LOOP;
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-247/luca-ferrari/postgresql/ch-2.plperl b/challenge-247/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..0f28f94a01
--- /dev/null
+++ b/challenge-247/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,32 @@
+--
+-- Perl Weekly Challenge 247
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc247;
+
+CREATE OR REPLACE FUNCTION
+pwc247.task2_plperl( text )
+RETURNS TABLE( needle text, repetitions int )
+AS $CODE$
+   my ( $string ) = @_;
+
+   my @letters = split //, $string;
+   my $score = {};
+   
+   for ( 0 .. @letters - 2 ) {
+       my $needle = $letters[ $_ ] . $letters[ $_ + 1 ];
+       my @matches = ( $string =~ / $needle /xg );
+       my $count = scalar @matches;
+       push $score->{ $count }->@*, $needle;
+   }
+
+   my $best = ( reverse sort keys $score->%* )[ 0 ];
+   return_next( { needle => ( sort $score->{ $best }->@* )[ 0 ],
+   		  repetitions => $best } );
+
+   return undef;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-247/luca-ferrari/postgresql/ch-2.sql b/challenge-247/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..040bc20a14
--- /dev/null
+++ b/challenge-247/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,37 @@
+--
+-- Perl Weekly Challenge 247
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc247;
+
+CREATE OR REPLACE FUNCTION
+pwc247.task2_plpgsql( string text )
+RETURNS TABLE( needle text, repetitions int )
+AS $CODE$
+
+DECLARE
+	needle text;
+BEGIN
+	CREATE TEMPORARY TABLE IF NOT EXISTS repetitions( needle text, repetition int );
+	TRUNCATE repetitions;
+
+	FOR i IN 1 .. length( string ) LOOP
+	    needle := substr( string, i, 2 );
+
+	    INSERT INTO repetitions
+	    SELECT needle, ( SELECT count(*) FROM  regexp_matches( string, needle, 'g' )f );
+
+	END LOOP;
+
+	RETURN QUERY
+	SELECT *
+	FROM repetitions
+	ORDER BY repetition DESC
+	LIMIT 1;
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-247/luca-ferrari/python/ch-1.py b/challenge-247/luca-ferrari/python/ch-1.py
new file mode 100644
index 0000000000..a80cf2c6bd
--- /dev/null
+++ b/challenge-247/luca-ferrari/python/ch-1.py
@@ -0,0 +1,37 @@
+#!python
+
+#
+# Perl Weekly Challenge 247
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+#
+
+import sys
+from random import randrange, choice
+
+# task implementation
+def main( argv ):
+    santas    =  argv.copy()
+    receivers =  argv.copy()
+
+    while len( santas ) >= 0 :
+        current_santa = santas[ randrange( 0, len( santas )  ) ]
+        current_receiver = receivers[ randrange( 0, len( receivers )  ) ]
+
+        if ( current_santa == current_receiver ):
+            continue
+
+        print( current_santa, " -> ", current_receiver )
+        santas.remove( current_santa )
+        receivers.remove( current_receiver )
+
+        if len( santas ) == 0:
+            break
+
+
+# invoke the main without the command itself
+if __name__ == '__main__':
+    main( sys.argv[ 1: ] )
+
+
diff --git a/challenge-247/luca-ferrari/python/ch-2.py b/challenge-247/luca-ferrari/python/ch-2.py
new file mode 100644
index 0000000000..fd59761ecf
--- /dev/null
+++ b/challenge-247/luca-ferrari/python/ch-2.py
@@ -0,0 +1,32 @@
+#!python
+
+#
+# Perl Weekly Challenge 247
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+#
+
+import sys
+
+# task implementation
+def main( argv ):
+    string = argv[ 0 ]
+    score = {}
+    for i in range( 0, len( string ) - 1 ):
+        needle = string[ i ] + string[ i + 1 ]
+        counting = string.count( needle )
+        if not counting in score:
+            score[ counting ] = []
+
+        if not needle in score[ counting ]:
+            score[ counting ].append( needle )
+
+    # get the highest key and extract the min value
+    print( min( score[ max( score.keys() ) ] ) )
+
+# invoke the main without the command itself
+if __name__ == '__main__':
+    main( sys.argv[ 1: ] )
+
+
diff --git a/challenge-247/luca-ferrari/raku/ch-1.p6 b/challenge-247/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..b982bed732
--- /dev/null
+++ b/challenge-247/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,29 @@
+#!raku
+
+#
+# Perl Weekly Challenge 247
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+#
+
+sub MAIN( *@names where { @names.grep( * ~~ / ^ M (r||rs||iss) \. .* $ / ).elems == @names.elems } ) {
+
+    my @santa = @names;
+    my @receiving = @names;
+    my @pairs;
+
+
+    while ( @pairs.elems < @names.elems ) {
+	for @santa.pick -> $santa {
+	    next if @pairs.grep( { $_[ 0 ] ~~ $santa } );
+	    for @receiving.pick -> $giving {
+		next if $santa ~~ $giving;
+		next if @pairs.grep( { $_[ 1 ] ~~ $giving } );
+		@pairs.push: [ $santa, $giving ];
+	    }
+	}
+    }
+
+    "%s -> %s\n".printf( $_[ 0 ], $_[ 1 ] ) for @pairs;
+}
diff --git a/challenge-247/luca-ferrari/raku/ch-2.p6 b/challenge-247/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..be7fff5501
--- /dev/null
+++ b/challenge-247/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,21 @@
+#!raku
+
+#
+# Perl Weekly Challenge 247
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/>
+#
+
+sub MAIN( Str $string where { $string ~~ / ^ <[a .. z ]>+ $ / } ) {
+
+    my @letters = $string.comb;
+    my %score;
+    for 0 ..^ @letters.elems - 1 {
+	my $needle = @letters[ $_ ] ~ @letters[ $_ + 1 ];
+	$string ~~ m:g/ $needle /;
+	%score{ $/.elems }.push: $needle;
+    }
+
+    ( %score{ ( %score.keys.sort )[ * - 1 ] }.sort )[ 0 ].say;
+}