Merge pull request #7888 from fluca1978/PWC212

Pwc212

12 files changed, 274 insertions, 0 deletions

diff --git a/challenge-212/luca-ferrari/blog-1.txt b/challenge-212/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..c7b2df0ef4
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task1
diff --git a/challenge-212/luca-ferrari/blog-2.txt b/challenge-212/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..53b1bf70c8
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task2
diff --git a/challenge-212/luca-ferrari/blog-3.txt b/challenge-212/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..790409e6c5
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task1plperl
diff --git a/challenge-212/luca-ferrari/blog-4.txt b/challenge-212/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..ac6811a2c7
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task2plperl
diff --git a/challenge-212/luca-ferrari/blog-5.txt b/challenge-212/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..68dcff15cd
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task1plpgsql
diff --git a/challenge-212/luca-ferrari/blog-6.txt b/challenge-212/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..e01a314569
--- /dev/null
+++ b/challenge-212/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/04/11/PerlWeeklyChallenge212.html#task2plpgsql
diff --git a/challenge-212/luca-ferrari/postgresql/ch-1.plperl b/challenge-212/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..861e11fe9d
--- /dev/null
+++ b/challenge-212/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,37 @@
+--
+-- Perl Weekly Challenge 212
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc212;
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc212.task1_plperl( text, int[] )
+RETURNS text
+AS $CODE$
+  my ( $string, $jumps ) = @_;
+  my @alphabet = 'a' .. 'z';
+
+  my $find_index = sub {
+     my ( $letter ) = @_;
+     for my $index ( 0 .. scalar( @alphabet ) ) {
+     	 return $index if ( $alphabet[ $index ] eq $letter );
+     }
+  };
+
+  my $offset = 0;
+  my @word;
+  for my $letter ( split //, $string ) {
+      my $index = $find_index->( $letter );
+      $index += $jumps->[ $offset++ ];
+      $index %= @alphabet;
+      push @word, $alphabet[ $index ];
+  }  
+
+  return join( '', @word );
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-212/luca-ferrari/postgresql/ch-1.sql b/challenge-212/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..5e493c0674
--- /dev/null
+++ b/challenge-212/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,67 @@
+--
+-- Perl Weekly Challenge 212
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc212;
+
+CREATE TABLE IF NOT EXISTS pwc212.alphabet
+(
+  l char
+  , n int
+  , PRIMARY KEY( l )
+);
+
+TRUNCATE pwc212.alphabet;
+INSERT INTO pwc212.alphabet
+SELECT l, row_number() over ()
+FROM regexp_split_to_table( 'abcdefghijklmnopqrstuvwxyz', '' ) l;
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc212.task1_plpgsql( s text, jumps int[] )
+RETURNS text
+AS $CODE$
+DECLARE
+	letter text;
+	word text;
+	idx int;
+	off int := 0;
+	alphabet_size int;
+BEGIN
+
+	SELECT count(*)
+	INTO alphabet_size
+	FROM pwc212.alphabet;
+
+	word := '';
+
+	FOR letter IN SELECT * FROM regexp_split_to_table( s, '' )  LOOP
+	    SELECT n
+	    INTO  idx
+	    FROM pwc212.alphabet
+	    WHERE l = letter;
+
+
+	    SELECT mod( i + idx, alphabet_size )
+	    INTO idx
+	    FROM unnest( jumps ) i
+	    LIMIT 1 	    OFFSET off;
+	    off := off + 1;
+
+	    SELECT l
+	    INTO letter
+	    FROM pwc212.alphabet
+	    WHERE n = idx;
+
+	    word := word || letter;
+
+	END LOOP;
+
+	RETURN word;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-212/luca-ferrari/postgresql/ch-2.plperl b/challenge-212/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..b78f660673
--- /dev/null
+++ b/challenge-212/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,45 @@
+--
+-- Perl Weekly Challenge 212
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc212;
+
+CREATE OR REPLACE FUNCTION
+pwc212.task2_plperl( int[], int )
+RETURNS SETOF int[]
+AS $CODE$
+   my ( $list, $size ) = @_;
+   return undef if ( scalar( $list->@* ) % $size != 0 );
+
+   my $bag = {};
+   $bag->{ $_ }++ for ( $list->@* );
+
+   my $find_min_available = sub {
+      my ( $bag, $array ) = @_;
+      for my $k ( sort keys $bag->%* ) {
+      	  if ( $bag->{ $k } > 0 && ! grep( {$_ == $k} $array->@* ) ) {
+	     $bag->{ $k } -= 1;
+	     return $k;
+	  }
+      }
+   };
+
+   my $done = 0;
+
+   while ( $done < ( $list->@* / $size ) ) {
+       my $current = [];
+       while ( scalar( $current->@* ) != $size ) {
+       	     my $value = $find_min_available->( $bag, $current );
+	     return undef if ! $value;
+	     push $current->@*, $value;
+       }
+
+      return_next( $current );
+      $done++;
+   }
+
+return undef;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-212/luca-ferrari/postgresql/ch-2.sql b/challenge-212/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..bfdcae3f68
--- /dev/null
+++ b/challenge-212/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,57 @@
+--
+-- Perl Weekly Challenge 212
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc212;
+
+CREATE OR REPLACE FUNCTION
+pwc212.task2_plpgsql( a int[], s int)
+RETURNS SETOF int[]
+AS $CODE$
+DECLARE
+	current int[];
+	done    int := 0;
+	next_value int;
+BEGIN
+
+	-- check if the array can be divided into batches
+	IF mod( array_length( a, 1 ), s ) <> 0 THEN
+	   RETURN;
+	END IF;
+
+	CREATE TEMPORARY TABLE IF NOT EXISTS bag( v int, c int default 1 );
+	TRUNCATE TABLE bag;
+	INSERT INTO bag
+	SELECT v, count(*)
+	FROM unnest( a ) v
+	GROUP BY v;
+
+
+	WHILE done < ( array_length( a, 1 ) / s ) LOOP
+	      current = array[]::int[];
+
+	      WHILE array_length( current, 1 ) IS NULL OR array_length( current, 1 ) < s LOOP
+	      	    SELECT min( v )
+		    INTO next_value
+		    FROM   bag
+		    WHERE  c > 0
+		    AND   v NOT IN ( SELECT * FROM unnest( current ) );
+
+		    UPDATE bag
+		    SET c = c - 1
+		    WHERE v = next_value;
+
+		    current := array_append( current, next_value );
+	      END LOOP;
+
+	      done := done + 1;
+	      RETURN NEXT current;
+	END LOOP;
+
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-212/luca-ferrari/raku/ch-1.p6 b/challenge-212/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..a683600349
--- /dev/null
+++ b/challenge-212/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,25 @@
+#!raku
+
+#
+# Perl Weekly Challenge 212
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+#
+
+sub MAIN( *@args ) {
+    my $word = @args[ 0 ];
+    my @jumps = @args[ 1 .. * ];
+    my @alphabet = 'a' .. 'z';
+    my @new-world;
+    my $index = 0;
+    for $word.lc.comb {
+	next if ! $_;
+	next if ! @alphabet.grep( * ~~ $_ );
+	my $jump = @jumps.shift;
+	my $idx = ( $jump + @alphabet.first( $_, :k ) ) % @alphabet.elems;
+	@new-world.push: @alphabet[ $idx ];
+    }
+
+    @new-world.join.say;
+}
diff --git a/challenge-212/luca-ferrari/raku/ch-2.p6 b/challenge-212/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..6090522ca5
--- /dev/null
+++ b/challenge-212/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,37 @@
+#!raku
+
+#
+# Perl Weekly Challenge 212
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/>
+#
+
+sub MAIN( *@args ) {
+    my $size = @args[ * - 1 ];
+    my @list = @args[ 0 .. * - 2 ];
+
+    # check if the size can be used to split the list
+    '-1'.say and exit if ( @list.elems !%% $size );
+
+    my $bag = Bag.new( @list ).Hash;
+
+    my @batches;
+    my @current;
+    while ( @batches.elems != ( @list.elems / $size ) ) {
+
+	my @available-keys = $bag.keys.grep( { $bag{ $_ } > 0 && ! @current.grep( $_ ) } );
+	my $key = @available-keys.min;
+	@current.push: $key;
+
+	$bag{ $key } -= 1;
+	$bag{ $key }:delete  if ( $bag{ $key } <= 0 );
+
+	if ( @current.elems == $size ) {
+	    @batches.push: [ @current ];
+	    @current = ();
+	}
+    }
+
+    @batches.join( "\n" ).say;
+}