Merge pull request #8019 from fluca1978/PWC215

Pwc215

12 files changed, 192 insertions, 0 deletions

diff --git a/challenge-215/luca-ferrari/blog-1.txt b/challenge-215/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..243b9d3ef0
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task1
diff --git a/challenge-215/luca-ferrari/blog-2.txt b/challenge-215/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..afdf300563
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task2
diff --git a/challenge-215/luca-ferrari/blog-3.txt b/challenge-215/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..6e58b53a89
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task1plperl
diff --git a/challenge-215/luca-ferrari/blog-4.txt b/challenge-215/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..6608e98682
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task2plperl
diff --git a/challenge-215/luca-ferrari/blog-5.txt b/challenge-215/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..5187e9839e
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task1plpgsql
diff --git a/challenge-215/luca-ferrari/blog-6.txt b/challenge-215/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..7478aa98af
--- /dev/null
+++ b/challenge-215/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/05/02/PerlWeeklyChallenge215.html#task2plpgsql
diff --git a/challenge-215/luca-ferrari/postgresql/ch-1.plperl b/challenge-215/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..c131788df4
--- /dev/null
+++ b/challenge-215/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,20 @@
+--
+-- Perl Weekly Challenge 215
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc215;
+
+CREATE OR REPLACE FUNCTION
+pwc215.task1_plperl( text[] )
+RETURNS SETOF text
+AS $CODE$
+  my ( $words ) = @_;
+  for ( $words->@* ) {
+      return_next( $_ ) if ( $_ eq join( '', sort( split( //, $_ ) ) ) );
+  }
+
+return undef;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-215/luca-ferrari/postgresql/ch-1.sql b/challenge-215/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..fd7b028c30
--- /dev/null
+++ b/challenge-215/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,42 @@
+--
+-- Perl Weekly Challenge 215
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc215;
+
+CREATE OR REPLACE FUNCTION
+pwc215.task1_plpgsql( words text[] )
+RETURNS SETOF text
+AS $CODE$
+DECLARE
+	current_word text;
+	sorted_word  text;
+	current_letter text;
+BEGIN
+	FOREACH current_word IN ARRAY words LOOP
+	        /*
+		sorted_word := '';
+		FOR current_letter IN SELECT l FROM regexp_split_to_table( current_word, '' ) l ORDER BY 1 LOOP
+		    sorted_word := sorted_word || current_letter;
+   	        END LOOP;
+                */
+
+		SELECT string_agg( c, '' )
+		INTO sorted_word
+		FROM ( SELECT c
+		       FROM regexp_split_to_table( current_word, '' ) c
+		       ORDER BY 1
+		     ) c;
+
+		IF sorted_word = current_word THEN
+		   RETURN NEXT current_word;
+		END IF;
+	END LOOP;
+
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-215/luca-ferrari/postgresql/ch-2.plperl b/challenge-215/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..0985b6fe4b
--- /dev/null
+++ b/challenge-215/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,35 @@
+--
+-- Perl Weekly Challenge 215
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc215;
+
+CREATE OR REPLACE FUNCTION
+pwc215.task2_plperl( int, int[] )
+RETURNS int
+AS $CODE$
+   my ( $count, $digits ) = @_;
+   my ( $done );
+
+   while ( $count ) {
+   	 $done = 0;
+	 for ( 1 .. scalar( $digits->@* ) - 1 ) {
+	     if ( $digits->[ $_ ] == 0
+	     	&& $digits->[ $_ - 1 ] == 0
+		&& $digits->[ $_ + 1 ] == 0 ) {
+		$digits->[ $_ ] = 1;
+		$done = 1;
+		$count--;
+		last;
+	     }
+	 }
+
+	 last if ! $done;
+   }
+
+   return 1 if ! $count;
+   return 0;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-215/luca-ferrari/postgresql/ch-2.sql b/challenge-215/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..e92b6c4a44
--- /dev/null
+++ b/challenge-215/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,46 @@
+--
+-- Perl Weekly Challenge 215
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc215;
+
+CREATE OR REPLACE FUNCTION
+pwc215.task2_plpgsql( c int, digits int[] )
+RETURNS boolean
+AS $CODE$
+DECLARE
+	done boolean;
+	i    int;
+BEGIN
+	i := 2;
+	WHILE c > 0 LOOP
+	      done := false;
+
+	     WHILE i < array_length( digits, 1 )  LOOP
+	     	 IF digits[ i ] = 0 AND digits[ i - 1 ] = 0 AND  digits[ i + 1 ] = 0 THEN
+		    digits[ i ] := 1;
+		    done := true;
+		    c := c - 1;
+		    EXIT;
+		 END IF;
+
+		 i := i + 1;
+	     END LOOP;
+
+
+	     IF NOT done THEN
+	     	EXIT;
+	     END IF;
+	END LOOP;
+
+	IF c = 0 THEN
+	   RETURN true;
+	ELSE
+	   RETURN false;
+	END IF;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-215/luca-ferrari/raku/ch-1.p6 b/challenge-215/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..b07ae596b0
--- /dev/null
+++ b/challenge-215/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,13 @@
+#!raku
+
+#
+# Perl Weekly Challenge 215
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+#
+
+sub MAIN( *@words where { @words.grep( * ~~ / ^ <[a..zA..Z]>+ $ / ).elems == @words.elems } ) {
+
+    say ( @words.elems -  @words.grep( { $_ ~~ $_.comb.sort.join } ).elems );
+}
diff --git a/challenge-215/luca-ferrari/raku/ch-2.p6 b/challenge-215/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..b1b99f632a
--- /dev/null
+++ b/challenge-215/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,30 @@
+#!raku
+
+#
+# Perl Weekly Challenge 215
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/>
+#
+
+sub MAIN( :$count is copy where { $count >= 0 } ,
+		*@digits is copy where { @digits.grep( 0 <= *.Int <= 1  ).elems == @digits.elems }  ) {
+
+    my $done = False;
+    while $count {
+	$done = False;
+	for 1 ..^ @digits.elems - 1 {
+	    if ( @digits[ $_ ] == 0 && @digits[ $_ - 1 ] == 0 && @digits[ $_ + 1 ] == 0 ) {
+		@digits[ $_ ] = 1;
+		$count--;
+		$done = True;
+		last;
+	    }
+	}
+
+	'0'.say and exit if ! $done;
+    }
+
+    '1'.say and exit if ! $count;
+    '0'.say;
+}