16 files changed, 245 insertions, 0 deletions
diff --git a/challenge-249/luca-ferrari/blog-1.txt b/challenge-249/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..27565af03b
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task1
diff --git a/challenge-249/luca-ferrari/blog-2.txt b/challenge-249/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..209549d575
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task2
diff --git a/challenge-249/luca-ferrari/blog-3.txt b/challenge-249/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..3491ba9b8a
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task1plperl
diff --git a/challenge-249/luca-ferrari/blog-4.txt b/challenge-249/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..5ff1a9b5d7
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task2plperl
diff --git a/challenge-249/luca-ferrari/blog-5.txt b/challenge-249/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..990f117b8b
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task1plpgsql
diff --git a/challenge-249/luca-ferrari/blog-6.txt b/challenge-249/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..807d648631
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task2plpgsql
diff --git a/challenge-249/luca-ferrari/blog-7.txt b/challenge-249/luca-ferrari/blog-7.txt
new file mode 100644
index 0000000000..f6c959ae3e
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-7.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task1python
diff --git a/challenge-249/luca-ferrari/blog-8.txt b/challenge-249/luca-ferrari/blog-8.txt
new file mode 100644
index 0000000000..399d6183b3
--- /dev/null
+++ b/challenge-249/luca-ferrari/blog-8.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/12/27/PerlWeeklyChallenge249.html#task2python
diff --git a/challenge-249/luca-ferrari/postgresql/ch-1.plperl b/challenge-249/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..bee03f2933
--- /dev/null
+++ b/challenge-249/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,30 @@
+--
+-- Perl Weekly Challenge 249
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc249;
+
+CREATE OR REPLACE FUNCTION
+pwc249.task1_plperl( int[] )
+RETURNS SETOF int[]
+AS $CODE$
+
+   my ( $nums ) = @_;
+
+   my $classification = {};
+
+   $classification->{ $_ }++ for ( $nums->@* );
+
+   for ( sort keys $classification->%* ) {
+       my $how_many_pairs = $classification->{ $_ } / 2;
+       next if $how_many_pairs < 1;
+
+       return_next( [ $_, $_ ] ) while ( $how_many_pairs-- >= 1 );
+       
+   }
+
+return undef;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-249/luca-ferrari/postgresql/ch-1.sql b/challenge-249/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..4320b48c52
--- /dev/null
+++ b/challenge-249/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,40 @@
+--
+-- Perl Weekly Challenge 249
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc249;
+
+CREATE OR REPLACE FUNCTION
+pwc249.task1_plpgsql( n int[] )
+RETURNS SETOF int[]
+AS $CODE$
+DECLARE
+	r record;
+BEGIN
+	CREATE TEMPORARY TABLE IF NOT EXISTS classification( v int, c int DEFAULT 1);
+	TRUNCATE classification;
+
+
+	WITH nums AS ( SELECT v::int
+	    	      FROM unnest( n ) v )
+	, counting AS ( SELECT v, count( v ) as c
+	  	        FROM nums
+			GROUP BY v )
+	INSERT INTO classification( v, c )
+	SELECT v, c
+	FROM counting;
+
+	FOR r IN SELECT * FROM classification WHERE c >= 2 ORDER BY v LOOP
+	    WHILE r.c >= 1 LOOP
+	    	  RETURN NEXT array[ r.v, r.v ]::int[];
+		  r.c := r.c - 2;
+	    END LOOP;
+	END LOOP;
+
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-249/luca-ferrari/postgresql/ch-2.plperl b/challenge-249/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..207f70dcc0
--- /dev/null
+++ b/challenge-249/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,35 @@
+--
+-- Perl Weekly Challenge 249
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc249;
+
+CREATE OR REPLACE FUNCTION
+pwc249.task2_plperl( text )
+RETURNS int[]
+AS $CODE$
+   my ( $string ) = @_;
+
+  use Algorithm::Combinatorics qw(permutations);
+
+  my @chars = split //, $string;
+  my @nums = 0 .. $#chars;
+  
+  my $iter = permutations( \ @nums );
+  while (my $perm = $iter->next) {
+  	my $ok = 1;
+  	for my $i ( 0 .. scalar( $perm->@* ) - 1 ) {
+	    $ok = 0 if ( $chars[ $i ] eq 'D' && $perm->[ $i ] < $perm->[ $i + 1 ] );
+	    $ok = 0 if ( $chars[ $i ] eq 'I' && $perm->[ $i ] > $perm->[ $i + 1 ] );
+	    last if ! $ok;
+	}
+
+	return $perm if $ok;
+  }
+
+  return undef;
+   
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-249/luca-ferrari/postgresql/ch-2.sql b/challenge-249/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..7e50c2054e
--- /dev/null
+++ b/challenge-249/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,16 @@
+--
+-- Perl Weekly Challenge 249
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc249;
+
+CREATE OR REPLACE FUNCTION
+pwc249.task2_plpgsql( s text )
+RETURNS int[]
+AS $CODE$
+   SELECT pwc249.task2_plperl( s );
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-249/luca-ferrari/python/ch-1.py b/challenge-249/luca-ferrari/python/ch-1.py
new file mode 100644
index 0000000000..229e3e2a00
--- /dev/null
+++ b/challenge-249/luca-ferrari/python/ch-1.py
@@ -0,0 +1,34 @@
+#!python
+
+#
+# Perl Weekly Challenge 249
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+#
+
+import sys
+
+# task implementation
+def main( argv ):
+    classification = {}
+    for i in argv:
+        if not i in classification:
+            classification[ i ] = 0
+        classification[ i ] += 1
+
+    pairs = []
+    for k in classification:
+        while classification[ k ] >= 2:
+            pairs.append( [ k, k ] )
+            classification[ k ] -= 2
+
+    for p in pairs:
+        print( ", ".join( p ) )
+
+
+# invoke the main without the command itself
+if __name__ == '__main__':
+    main( sys.argv[ 1: ] )
+
+
diff --git a/challenge-249/luca-ferrari/python/ch-2.py b/challenge-249/luca-ferrari/python/ch-2.py
new file mode 100644
index 0000000000..50c8088458
--- /dev/null
+++ b/challenge-249/luca-ferrari/python/ch-2.py
@@ -0,0 +1,37 @@
+#!python
+
+#
+# Perl Weekly Challenge 249
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+#
+
+import sys
+from itertools import permutations
+
+# task implementation
+def main( argv ):
+    nums = range( 0, len( argv[ 0 ] ) )
+
+
+    for perm in permutations( nums ):
+        ok = True
+        for i in range( 0, len( perm ) - 1 ):
+            if argv[ 0 ][ i ] == 'D' and perm[ i ] > perm[ i + 1 ]:
+                ok = False
+                break
+            elif argv[ 0 ][ i ] == 'I' and perm[ i ] < perm[ i + 1 ]:
+                ok = False
+                break
+
+        if ok:
+            print( ",".join( map( str, perm ) ) )
+            return
+
+
+# invoke the main without the command itself
+if __name__ == '__main__':
+    main( sys.argv[ 1: ] )
+
+
diff --git a/challenge-249/luca-ferrari/raku/ch-1.p6 b/challenge-249/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..ff5583189f
--- /dev/null
+++ b/challenge-249/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,22 @@
+#!raku
+
+#
+# Perl Weekly Challenge 249
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+#
+
+sub MAIN( *@nums where { @nums.elems %% 2 && @nums.grep( * ~~ Int ).elems == @nums.elems } ) {
+
+    my %pair-elements;
+    %pair-elements{ $_ }++ for @nums;
+    my @pairs;
+    for %pair-elements.keys.sort {
+	my $how-many-pairs = %pair-elements{ $_ } / 2;
+	next if $how-many-pairs < 1;
+	@pairs.push: [ $_, $_ ] while ( $how-many-pairs-- > 1 );
+    }
+
+    @pairs.join( ", " ).say;
+}
diff --git a/challenge-249/luca-ferrari/raku/ch-2.p6 b/challenge-249/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..5df7b1ce74
--- /dev/null
+++ b/challenge-249/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,23 @@
+#!raku
+
+#
+# Perl Weekly Challenge 249
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/>
+#
+
+sub MAIN( $string  ) {
+
+    my @chars = $string.comb;
+    for ( 0 .. @chars.elems ).permutations -> $perm {
+	my $ok = True;
+	for 0 ..^ $perm.elems - 1 -> $i {
+	    $ok = False and next if @chars[ $i ] ~~ 'D' && $perm[ $i ] < $perm[ $i + 1 ];
+	    $ok = False and next if @chars[ $i ] ~~ 'I' && $perm[ $i ] > $perm[ $i + 1 ];
+	    last if !$ok;
+	}
+
+	$perm.join(", ").say and last if $ok;
+    }
+}