Merge pull request #7500 from fluca1978/PWC202

Pwc202

12 files changed, 261 insertions, 0 deletions

diff --git a/challenge-202/luca-ferrari/blog-1.txt b/challenge-202/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..670a0b07ff
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task1
diff --git a/challenge-202/luca-ferrari/blog-2.txt b/challenge-202/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..3861789f73
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task2
diff --git a/challenge-202/luca-ferrari/blog-3.txt b/challenge-202/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..1333d03baf
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task1plperl
diff --git a/challenge-202/luca-ferrari/blog-4.txt b/challenge-202/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..fb1dc1093f
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task2plperl
diff --git a/challenge-202/luca-ferrari/blog-5.txt b/challenge-202/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..4d8a45bb5f
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task1plpgsql
diff --git a/challenge-202/luca-ferrari/blog-6.txt b/challenge-202/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..b4a0d2349c
--- /dev/null
+++ b/challenge-202/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/01/30/PerlWeeklyChallenge202.html#task2plpgsql
diff --git a/challenge-202/luca-ferrari/postgresql/ch-1.plperl b/challenge-202/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..96f16598d5
--- /dev/null
+++ b/challenge-202/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,28 @@
+--
+-- Perl Weekly Challenge 202
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc202;
+
+CREATE OR REPLACE FUNCTION
+pwc202.task1_plperl( int[] )
+RETURNS int
+AS $CODE$
+  my ( $list ) = @_;
+  my @odds;
+
+  for ( $list->@* ) {
+    next if $_ % 2 == 0;
+
+    push( @odds, $_ ) and next if ! @odds;
+    next if $_ != ( $odds[ -1 ] + 2 );
+    push( @odds, $_ );
+  }
+
+  return 1 if @odds >= 3;
+  return 0;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-202/luca-ferrari/postgresql/ch-1.sql b/challenge-202/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..ddc906c223
--- /dev/null
+++ b/challenge-202/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,42 @@
+--
+-- Perl Weekly Challenge 202
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc202;
+
+CREATE OR REPLACE FUNCTION
+pwc202.task1_plpgsql( l int[] )
+RETURNS int
+AS $CODE$
+DECLARE
+	odds int[];
+	cur int;
+BEGIN
+	FOREACH cur IN ARRAY l LOOP
+		IF cur % 2 = 0 THEN
+		   CONTINUE;
+		END IF;
+
+		IF array_length( odds, 1 ) = 0 OR odds IS NULL THEN
+		   odds := odds || cur;
+		   CONTINUE;
+		END IF;
+
+		IF odds[ array_length( odds, 1 ) ] + 2 <> cur THEN
+		   CONTINUE;
+		END IF;
+
+   	        odds := odds || cur;
+	END LOOP;
+
+	IF array_length( odds, 1 ) >= 3 THEN
+	   RETURN 1;
+	ELSE
+	  RETURN 0;
+	END IF;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-202/luca-ferrari/postgresql/ch-2.plperl b/challenge-202/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..d8beda06ef
--- /dev/null
+++ b/challenge-202/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,49 @@
+--
+-- Perl Weekly Challenge 202
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc202;
+
+CREATE OR REPLACE FUNCTION
+pwc202.task2_plperl( int[] )
+RETURNS int[]
+AS $CODE$
+  my ( $list ) = @_;
+  my ( %valleys );
+  my $largest = 0;
+
+  for my $index ( 0 .. scalar( $list->@* ) - 1 ) {
+     my $current = $list->[ $index ];
+     next if $list->[ $index + 1 ] > $current;
+
+     my ( @valley_left ) = ( $current );
+     for ( $index + 1 .. scalar( $list->@* ) - 1 ) {
+         my $previous = $valley_left[ -1 ];
+     	 push( @valley_left, $list->[ $_ ] ) if ( $list->[ $_ ] <= $previous );
+	 last if $list->[ $_ ] > $previous;
+     }
+
+
+     my @valley_right;
+     if ( $index + scalar( @valley_left ) < scalar( $list->@* ) ) {
+     	my $previous = $list->[ $index + scalar( @valley_left ) ];
+	@valley_right = ( $previous );
+	for ( $index + scalar( @valley_left ) + 1 .. scalar( $list->@* ) - 1 ) {
+	    my $previous = $valley_right[ -1 ];
+     	    push( @valley_right, $list->[ $_ ] ) if ( $list->[ $_ ] >= $previous );
+	    last if $list->[ $_ ] < $previous;
+	}
+     }
+
+
+
+     $valleys{ scalar( @valley_right ) + scalar( @valley_left ) } = [ @valley_left, @valley_right ];
+     $largest = scalar( @valley_right ) + scalar( @valley_left ) if ( scalar( @valley_right ) + scalar( @valley_left ) > $largest );
+
+  }
+
+  return $valleys{ $largest };
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-202/luca-ferrari/postgresql/ch-2.sql b/challenge-202/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..46efaf0434
--- /dev/null
+++ b/challenge-202/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,70 @@
+--
+-- Perl Weekly Challenge 202
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc202;
+
+CREATE OR REPLACE FUNCTION
+pwc202.task2_plpgsql( l int[] )
+RETURNS SETOF int[]
+AS $CODE$
+DECLARE
+	cur int;
+	lft int[];
+	rgt int[];
+	idx int;
+	iter int;
+	prev int;
+BEGIN
+
+	CREATE TEMPORARY TABLE IF NOT EXISTS pwc202
+	( lft int[], rgt int[], dim int DEFAULT 0 );
+	TRUNCATE pwc202;
+
+
+	FOR idx IN 1 .. array_length( l, 1 ) - 1 LOOP
+		cur := l[ idx ];
+		IF l[ idx + 1 ] > cur THEN
+		   CONTINUE;
+		END IF;
+
+		lft := NULL;
+		lft := array_append( lft, cur );
+		FOR iter IN idx + 1 .. array_length( l, 1 ) - 1 LOOP
+		    prev := lft[ array_length( lft, 1 ) ];
+		    IF l[ iter ] <= prev THEN
+		       lft := array_append( lft, l[ iter ] );
+		    END IF;
+		    EXIT WHEN l[ iter ] > prev;
+		END LOOP;
+
+		rgt := NULL;
+		IF array_length( lft, 1 ) + idx <= array_length( l, 1 ) THEN
+		   prev := l[ idx + array_length( lft, 1 ) ];
+		   rgt := array_append( rgt, prev );
+		   FOR iter IN array_length( lft, 1 ) + idx + 1 .. array_length( l, 1 )  LOOP
+		      prev := rgt[ array_length( rgt, 1 ) ];
+		      IF l[ iter ] >= prev THEN
+		       rgt := array_append( rgt, l[ iter ] );
+		      END IF;
+		      EXIT WHEN l[ iter ] < prev;
+		   END LOOP;
+		END IF;
+
+		INSERT INTO pwc202
+		VALUES( lft, rgt, array_length( lft, 1 ) + array_length( rgt, 1 ) );
+
+
+
+	END LOOP;
+
+       RETURN QUERY SELECT array_cat( p.lft, p.rgt )
+       FROM pwc202 p
+       ORDER BY dim DESC
+       LIMIT 1;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-202/luca-ferrari/raku/ch-1.p6 b/challenge-202/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..1224d1b9ae
--- /dev/null
+++ b/challenge-202/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,24 @@
+#!raku
+
+#
+# Perl Weekly Challenge 202
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+#
+
+sub MAIN( Bool :$verbose = False,
+	*@list where { @list.grep( { $_ ~~ Int && $_ > 0 } ).elems == @list.elems } ) {
+    my @odds;
+    for @list {
+	next if $_ %% 2;
+	@odds.push: $_ and next if ( ! @odds );
+	next if @odds.grep( $_ );
+	next if $_ != ( @odds[ * - 1 ] + 2 );
+	@odds.push: $_;
+    }
+
+    @odds.join( ', ' ).say if $verbose;
+    '1'.say and exit if ( @odds.elems >= 3 );
+    '0'.say;
+}
diff --git a/challenge-202/luca-ferrari/raku/ch-2.p6 b/challenge-202/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..4fc4c5452e
--- /dev/null
+++ b/challenge-202/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,42 @@
+#!raku
+
+#
+# Perl Weekly Challenge 202
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/>
+#
+
+sub MAIN( *@list where { @list.grep( { $_ > 0 && $_ ~~ Int } ).elems == @list.elems } ) {
+
+    my %valleys;
+
+    for 0 ..^ @list.elems - 1 -> $index {
+	my $current = @list[ $index ];
+	next if @list[ $index + 1 ] > $current;  # increasing!
+
+	my @valley-left;
+	@valley-left.push: $current;
+	for $index ^..^ @list.elems {
+	    my $previous = @valley-left[ * - 1 ];
+	    @valley-left.push: @list[ $_ ] if ( @list[ $_ ] <= $previous );
+	    last if @list[ $_ ] > $previous;
+	}
+
+	my @valley-right;
+
+	if ( $index + @valley-left.elems  < @list.elems ) {
+	    @valley-right.push: @list[ $index + @valley-left.elems ];
+	    for $index + @valley-left.elems ^..^ @list.elems {
+		my $previous = @valley-right[ * - 1 ];
+		@valley-right.push: @list[ $_ ] if ( @list[ $_ ] >= $previous );
+		last if @list[ $_ ] < $previous;
+	    }
+	}
+
+	%valleys{ @valley-left.elems + @valley-right.elems } = [ |@valley-left, |@valley-right ];
+    }
+
+    %valleys{ %valleys.keys.max }.join( ', ' ).say;
+
+}