aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-211/luca-ferrari/blog-1.txt1
-rw-r--r--challenge-211/luca-ferrari/blog-2.txt1
-rw-r--r--challenge-211/luca-ferrari/blog-3.txt1
-rw-r--r--challenge-211/luca-ferrari/blog-4.txt1
-rw-r--r--challenge-211/luca-ferrari/blog-5.txt1
-rw-r--r--challenge-211/luca-ferrari/blog-6.txt1
-rw-r--r--challenge-211/luca-ferrari/postgresql/ch-1.plperl29
-rw-r--r--challenge-211/luca-ferrari/postgresql/ch-1.sql36
-rw-r--r--challenge-211/luca-ferrari/postgresql/ch-2.plperl40
-rw-r--r--challenge-211/luca-ferrari/postgresql/ch-2.sql65
-rw-r--r--challenge-211/luca-ferrari/raku/ch-1.p622
-rw-r--r--challenge-211/luca-ferrari/raku/ch-2.p630
12 files changed, 228 insertions, 0 deletions
diff --git a/challenge-211/luca-ferrari/blog-1.txt b/challenge-211/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..20aa3248b4
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task1
diff --git a/challenge-211/luca-ferrari/blog-2.txt b/challenge-211/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..af2ebde9dd
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task2
diff --git a/challenge-211/luca-ferrari/blog-3.txt b/challenge-211/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..26e77011ea
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task1plperl
diff --git a/challenge-211/luca-ferrari/blog-4.txt b/challenge-211/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..87794d6a99
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task2plperl
diff --git a/challenge-211/luca-ferrari/blog-5.txt b/challenge-211/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..45531804ca
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task1plpgsql
diff --git a/challenge-211/luca-ferrari/blog-6.txt b/challenge-211/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..534fca5816
--- /dev/null
+++ b/challenge-211/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/03/PerlWeeklyChallenge211.html#task2plpgsql
diff --git a/challenge-211/luca-ferrari/postgresql/ch-1.plperl b/challenge-211/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..d2085bdc4c
--- /dev/null
+++ b/challenge-211/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,29 @@
+--
+-- Perl Weekly Challenge 211
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc211;
+
+/*
+testdb=> select pwc211.task1_plperl( array[ array[4,3,2,1], array[ 5,4,3,2], array[6,5,4,3] ] );
+ task1_plperl
+--------------
+ t
+(1 row)
+
+*/
+CREATE OR REPLACE FUNCTION
+pwc211.task1_plperl( int[][] )
+RETURNS bool
+AS $CODE$
+ my ( $array ) = @_;
+
+ my $diag;
+ $diag->{ $array->[ $_ ]->[ $_ ] }++ for ( 0 .. scalar( $array->@* ) - 1 );
+ return 0 if ( keys( $diag->%* ) != 1 );
+ return 0 if ( $diag->{ $array->[ 0 ]->[ 0 ] } != scalar( $array->@* ) );
+ return 1;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-211/luca-ferrari/postgresql/ch-1.sql b/challenge-211/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..23a33447de
--- /dev/null
+++ b/challenge-211/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,36 @@
+--
+-- Perl Weekly Challenge 211
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc211;
+
+CREATE OR REPLACE FUNCTION
+pwc211.task1_plpgsql( a int[][])
+RETURNS bool
+AS $CODE$
+DECLARE
+ current_row int := 1;
+ current_col int := 1;
+ previous_val int := NULL;
+BEGIN
+ WHILE current_row <= array_length( a, 1 ) LOOP
+ IF current_row > array_length( a, 2 ) THEN
+ RETURN false;
+ END IF;
+
+ IF previous_val IS NULL THEN
+ previous_val := a[ current_row ][ current_row ];
+ ELSIF previous_val <> a[ current_row ][ current_row ] THEN
+ RETURN false;
+ END IF;
+
+ current_row := current_row + 1;
+ END LOOP;
+
+ RETURN true;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-211/luca-ferrari/postgresql/ch-2.plperl b/challenge-211/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..6513b34abf
--- /dev/null
+++ b/challenge-211/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,40 @@
+--
+-- Perl Weekly Challenge 211
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc211;
+
+/*
+estdb=# select pwc211.task2_plperl( array[ 1,2,3,4,5,6,7,8] );
+ task2_plperl
+--------------
+ {1,2,7,8}
+ {3,4,5,6}
+(2 rows)
+
+*/
+CREATE OR REPLACE FUNCTION
+pwc211.task2_plperl( int[] )
+RETURNS SETOF int[]
+AS $CODE$
+ use List::Permutor;
+ use List::Util qw/sum/;
+ my ( $array ) = @_;
+
+ my $permutator = List::Permutor->new( $array->@* );
+ while ( my @current = $permutator->next ) {
+ my ( $split_at ) = ( $#current + 1) / 2;
+ my ( $left, $right ) = ( [ @current[ 0 .. ( $split_at - 1 ) ] ], [ @current[ $split_at .. $#current ] ] );
+
+ if ( ( sum( $left->@* ) / scalar( $left->@* ) ) == ( sum( $right->@* ) / scalar( $right->@* ) ) ) {
+ return_next( $left );
+ return_next( $right );
+ return undef;
+ }
+ }
+
+return undef;
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-211/luca-ferrari/postgresql/ch-2.sql b/challenge-211/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..802a8f6932
--- /dev/null
+++ b/challenge-211/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,65 @@
+--
+-- Perl Weekly Challenge 211
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc211;
+
+-- see <https://wiki.postgresql.org/wiki/Permutations>
+CREATE FUNCTION pwc211.permute(anyarray)
+ RETURNS SETOF anyarray
+ LANGUAGE SQL IMMUTABLE
+AS $f$
+ SELECT (WITH RECURSIVE r(n,p,a,b)
+ AS (SELECT i, $1[1:0], $1, array_upper($1,1)
+ UNION ALL
+ SELECT n / b, p || a[n % b + 1], a[1:n % b] || a[n % b + 2:b], b-1
+ FROM r
+ WHERE b > 0)
+ SELECT p FROM r WHERE b=0)
+ FROM generate_series(0,factorial( (array_upper($1,1)) )::integer-1) i;
+$f$;
+
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc211.task2_plpgsql( a int[] )
+RETURNS SETOF int[]
+AS $CODE$
+DECLARE
+ split_at int := 0;
+ current_array int[];
+ l int[];
+ r int [];
+ avg_l numeric;
+ avg_r numeric;
+BEGIN
+ split_at := array_length( a, 1 ) / 2;
+
+ FOR current_array IN SELECT * FROM pwc211.permute( a ) LOOP
+ l := current_array[ 1:split_at ];
+ r := current_array[ (split_at + 1): array_length( a, 1 ) ];
+
+
+ SELECT avg( v )
+ INTO avg_l
+ FROM unnest( l ) v;
+
+ SELECT avg( v )
+ INTO avg_r
+ FROM unnest( r ) v;
+
+ IF avg_r = avg_l THEN
+ RETURN NEXT l;
+ RETURN NEXT r;
+ RETURN;
+ END IF;
+ END LOOP;
+
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-211/luca-ferrari/raku/ch-1.p6 b/challenge-211/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..6c506c4842
--- /dev/null
+++ b/challenge-211/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,22 @@
+#!raku
+
+#
+# Perl Weekly Challenge 211
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+#
+
+sub MAIN() {
+
+ my @matrix = [ [4, 3, 2, 1],
+ [5, 4, 3, 2],
+ [6, 5, 4, 3],
+ ];
+
+ my %diag;
+ %diag{ @matrix[ $_ ][ $_ ] }++ for 0 ..^ @matrix.elems;
+ 'False'.say if ( %diag.keys.elems != 1 || %diag{ @matrix[ 0 ][ 0 ] } != @matrix.elems );
+ 'True'.say;
+
+}
diff --git a/challenge-211/luca-ferrari/raku/ch-2.p6 b/challenge-211/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..aa425afa73
--- /dev/null
+++ b/challenge-211/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,30 @@
+#!raku
+
+#
+# Perl Weekly Challenge 211
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/>
+#
+
+sub MAIN( *@list where{ @list.elems == @list.grep( * ~~ Int ).elems } ) {
+
+ for @list.permutations -> @current {
+ # for 0 ..^ @current.elems {
+ # # find the first couple that gives the same average
+ # my ($left, $right) = @current[ 0 .. $_ ], @current[ $_ + 1 .. * ];
+ # if ( ( $left.sum / $left.elems ) == ( $right.sum / $right.elems ) ) {
+ # say "{ $left.join( ',' ) } = { $left.sum / $left.elems } and { $right.join( ',' ) } = { $right.sum / $right.elems } ";
+ # exit;
+ # }
+ # }
+
+ my $split-at = ( @current.elems - 1 ) / 2;
+ my ($left, $right) = @current[ 0 .. $split-at ], @current[ $split-at + 1 .. * ];
+ if ( ( $left.sum / $left.elems ) == ( $right.sum / $right.elems ) ) {
+ say "{ $left.join( ',' ) } = { $left.sum / $left.elems } and { $right.join( ',' ) } = { $right.sum / $right.elems } ";
+ exit;
+ }
+
+ }
+}
generated by cgit (git 2.34.1) at 2026-07-04 18:06:37 +0000