Merge pull request #7425 from fluca1978/PWC200

Pwc200

12 files changed, 366 insertions, 0 deletions

diff --git a/challenge-200/luca-ferrari/blog-1.txt b/challenge-200/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..c2555753bd
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task1
diff --git a/challenge-200/luca-ferrari/blog-2.txt b/challenge-200/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..7840fdbd4a
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task2
diff --git a/challenge-200/luca-ferrari/blog-3.txt b/challenge-200/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..3e390efa81
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task1plperl
diff --git a/challenge-200/luca-ferrari/blog-4.txt b/challenge-200/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..1032ec59ed
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task2plperl
diff --git a/challenge-200/luca-ferrari/blog-5.txt b/challenge-200/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..5beac38ce5
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task1plpgsql
diff --git a/challenge-200/luca-ferrari/blog-6.txt b/challenge-200/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..a68cbb119d
--- /dev/null
+++ b/challenge-200/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/16/PerlWeeklyChallenge200.html#task2plpgsql
diff --git a/challenge-200/luca-ferrari/postgresql/ch-1.plperl b/challenge-200/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..53d25fae3b
--- /dev/null
+++ b/challenge-200/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,37 @@
+--
+-- Perl Weekly Challenge 200
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc200;
+
+CREATE OR REPLACE FUNCTION
+pwc200.task1_plperl( int[] )
+RETURNS SETOF int[]
+AS $CODE$
+  my ( $list ) = @_;
+  my @slices;
+
+  for my $center ( 1 .. $list->@* - 1 ) {
+    for ( 1 .. $center ) {
+    my ( $start, $end ) = ( $center - $_, $center + $_ );
+        $start = 0 if $start < 0;
+        $end = $list->@* - 1 if $end >= $list->@*;
+
+        my @seeking = $list->@[ $start .. $end ];
+        my $ok = 1;
+	my $difference = undef;
+
+        for ( 1 .. $#seeking ) {
+	  $difference = $seeking[ $_ ] - $seeking[ $_ - 1 ] if ! defined( $difference );
+    	  $ok = 0 and last if $seeking[ $_ ] - $seeking[ $_ - 1 ] != $difference;
+        }
+
+        return_next( [@seeking] ) if $ok and scalar( @seeking ) >= 3;
+    }
+  }
+
+return;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-200/luca-ferrari/postgresql/ch-1.sql b/challenge-200/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..67ec06abc9
--- /dev/null
+++ b/challenge-200/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,27 @@
+--
+-- Perl Weekly Challenge 200
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc200;
+
+CREATE OR REPLACE FUNCTION
+pwc200.task1_plpgsql( list int[] )
+RETURNS SETOF int[]
+AS $CODE$
+DECLARE
+BEGIN
+
+	FOR i IN 2 .. array_length( list, 1 ) - 1 LOOP
+		IF list[ i + 1 ] - list [ i ] = list[ i ] - list[ i - 1 ] THEN
+		   RETURN NEXT array[ list[ i - 1 ], list[ i ], list[ i + 1 ] ];
+		END IF;
+	END LOOP;
+
+RETURN;
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-200/luca-ferrari/postgresql/ch-2.plperl b/challenge-200/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..d30bb62302
--- /dev/null
+++ b/challenge-200/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,121 @@
+--
+-- Perl Weekly Challenge 200
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc200;
+
+CREATE OR REPLACE FUNCTION
+pwc200.task2_plperl( int )
+RETURNS text
+AS $CODE$
+
+   my ( $value ) = @_;
+
+    my $lcd = [
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  ' -------- ',
+	],
+	[ '         ',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '         ',
+	],
+	[ ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	],
+
+	[ ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	],
+
+	[ '|      |',
+	  '|      |',
+	  '|      |',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+	[ ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+	[ ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	  '|      |',
+	  '|      |',
+	  ' ------ ',
+	],
+
+	[ ' -------',
+	  '       |',
+	  '       |',
+	  '       | ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  ' -------  ',
+	  '|        |',
+	  '|        |',
+	  ' -------- ',
+	],
+
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  ' -------  ',
+	  '         |',
+	  '         |',
+	  ' -------- ',
+	],
+
+
+    ];
+
+
+    my $display;
+
+      for my $row ( 0 .. 6 ) {
+      	  for ( split '', $value ) {
+	      $display .= ' ' . $lcd->[ $_ ]->[ $row ];
+	  }
+
+	  $display .= "\n";
+      }
+
+      $display .= "\n";
+
+      return $display;
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-200/luca-ferrari/postgresql/ch-2.sql b/challenge-200/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..0e07041c87
--- /dev/null
+++ b/challenge-200/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,16 @@
+--
+-- Perl Weekly Challenge 200
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc200;
+
+CREATE OR REPLACE FUNCTION
+pwc200.task2_plpgsql( v int )
+RETURNS text
+AS $CODE$
+   SELECT pwc200.task2_plperl( v );
+$CODE$
+LANGUAGE sql;
diff --git a/challenge-200/luca-ferrari/raku/ch-1.p6 b/challenge-200/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..7acf58814b
--- /dev/null
+++ b/challenge-200/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,34 @@
+#!raku
+
+#
+# Perl Weekly Challenge 200
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+#
+
+sub MAIN( *@list where { @list.elems == @list.grep( * ~~ Int ).elems } ) {
+    my @slices;
+
+    for 0 ^..^ @list.elems - 1 -> $center {
+	for 1 .. $center {
+	    my ( $start, $end ) = $center - $_, $center + $_;
+	    $start = 0 if $start < 0;
+	    $end = @list.elems - 1 if $end >= @list.elems;
+
+	    my @seeking = @list[ $start .. $end ];
+	    my $ok = @list.elems >= 3;
+	    for 1 ..^ @seeking.elems {
+		state $difference = @seeking[ $_ ] - @seeking[ $_ - 1 ];
+		$ok = False and last if @seeking[ $_ ] - @seeking[ $_ - 1 ] != $difference;
+	    }
+
+	    @slices.push: @seeking if $ok;
+	}
+    }
+
+    @slices.join( "\n" ).say;
+
+
+
+}
diff --git a/challenge-200/luca-ferrari/raku/ch-2.p6 b/challenge-200/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..a2a993b395
--- /dev/null
+++ b/challenge-200/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,125 @@
+#!raku
+
+#
+# Perl Weekly Challenge 200
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/>
+#
+
+sub MAIN( Int $value = 200, Bool :$sign = False ) {
+
+    my @sign = [
+	[ '          ',
+	  '          ',
+	  '          ',
+	  '   -----  ',
+	  '          ',
+	  '          ',
+	  '          ',
+	],
+	[ '          ',
+	  '          ',
+	  '     |    ',
+	  '   -----  ',
+	  '     |    ',
+	  '          ',
+	  '          ',
+	],
+    ];
+
+    my @lcd = [
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  '|        |',
+	  ' -------- ',
+	],
+	[ '         ',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '        |',
+	  '         ',
+	],
+	[ ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	],
+
+	[ ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  ' ------ ',
+	],
+
+	[ '|      |',
+	  '|      |',
+	  '|      |',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+	[ ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+	[ ' ------ ',
+	  '|       ',
+	  '|       ',
+	  ' ------ ',
+	  '|      |',
+	  '|      |',
+	  ' ------ ',
+	],
+
+	[ ' -------',
+	  '       |',
+	  '       |',
+	  '       | ',
+	  '       |',
+	  '       |',
+	  '        ',
+	],
+
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  ' -------  ',
+	  '|        |',
+	  '|        |',
+	  ' -------- ',
+	],
+
+	[ ' -------- ',
+	  '|        |',
+	  '|        |',
+	  ' -------  ',
+	  '         |',
+	  '         |',
+	  ' -------- ',
+	],
+
+
+    ];
+
+    my @display;
+    @display.push: @sign[ $value > 0 ?? 1 !! 0 ] if ( $value < 0 || $sign );
+    @display.push: |@lcd[ $value.comb ];
+    ( [Z] |@display ).join( "\n" ).say;
+}