Merge pull request #8805 from fluca1978/PWC237

PWC 237

12 files changed, 242 insertions, 0 deletions

diff --git a/challenge-237/luca-ferrari/blog-1.txt b/challenge-237/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..44b7b7e16a
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task1
diff --git a/challenge-237/luca-ferrari/blog-2.txt b/challenge-237/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..0641a347e6
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task2
diff --git a/challenge-237/luca-ferrari/blog-3.txt b/challenge-237/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..2861d5c4de
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task1plperl
diff --git a/challenge-237/luca-ferrari/blog-4.txt b/challenge-237/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..8f45368032
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task2plperl
diff --git a/challenge-237/luca-ferrari/blog-5.txt b/challenge-237/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..fac722dffd
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task1plpgsql
diff --git a/challenge-237/luca-ferrari/blog-6.txt b/challenge-237/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..0461fcdb55
--- /dev/null
+++ b/challenge-237/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/10/02/PerlWeeklyChallenge237.html#task2plpgsql
diff --git a/challenge-237/luca-ferrari/postgresql/ch-1.plperl b/challenge-237/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..e66d3c0b48
--- /dev/null
+++ b/challenge-237/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,42 @@
+--
+-- Perl Weekly Challenge 237
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc237;
+
+CREATE OR REPLACE FUNCTION
+pwc237.task1_plperl( int, int, int, int )
+RETURNS text
+AS $CODE$
+   my ( $year, $month, $weekday, $week ) = @_;
+   my $current_week = 0;
+
+   my $ord = { 1 => 'first', 2 => 'second', 3 => 'third' };
+   $ord->{ $_ } = $_ . 'th' for ( 4 .. 31 );
+
+
+
+   use DateTime;
+   my $date = DateTime->new( year => $year, month => $month, day => 1 );
+
+   while ( $date->year == $year && $date->month == $month ) {
+   	 $current_week++ if ( $date->day_of_week == 1 );
+	 if ( $current_week == $week && $date->day_of_week == $weekday ) {
+	    # found
+	    return sprintf 'The %s %s of month %s in %s is %d',
+	    	   	   $ord->{ $current_week },
+			   $date->day_abbr,
+			   $date->month_abbr,
+			   $date->year,
+			   $date->day;
+	 }
+
+	 $date->add( days => 1 );
+   }
+
+   return 'Date not found';
+
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-237/luca-ferrari/postgresql/ch-1.sql b/challenge-237/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..b804ffa7e8
--- /dev/null
+++ b/challenge-237/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,76 @@
+--
+-- Perl Weekly Challenge 237
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc237;
+
+CREATE OR REPLACE FUNCTION
+pwc237.task1_plpgsql( y int, m int, d int, w int )
+RETURNS text
+AS $CODE$
+DECLARE
+	current_date date;
+	current_week int := 0;
+	current_result text;
+	current_temp text;
+BEGIN
+	SELECT make_date( y, m, 1 )
+	INTO current_date;
+
+
+	CREATE TEMPORARY TABLE IF NOT EXISTS ord( o int, t text );
+	TRUNCATE ord;
+	INSERT INTO ord
+	VALUES( 1, 'first' ), ( 2, 'second' ), (3, 'third' );
+	FOR i IN 4 .. 31 LOOP
+	    INSERT INTO ord
+	    SELECT i, i || 'th';
+	END LOOP;
+
+	CREATE TEMPORARY TABLE IF NOT EXISTS dname( o int, t text );
+	TRUNCATE dname;
+	INSERT INTO dname
+	VALUES
+	(1, 'Monday'), (2, 'Tuesday'),(3,'Wednsday'),(4,'Thursday'),(5,'Friday'),(6,'Saturday'),(7,'Sunday');
+
+
+	WHILE extract( month FROM current_date ) = m AND extract( year FROM current_date ) = y LOOP
+
+	   IF extract( dow FROM current_date ) = 1 THEN
+	      current_week := current_week + 1;
+	   END IF;
+
+	   RAISE INFO 'Date is %', current_date;
+
+	   IF current_week = w AND extract( dow FROM current_date ) = d THEN
+	      -- found
+	      RAISE INFO 'Found on %', current_date;
+	      SELECT t
+	      INTO current_temp
+	      FROM ord
+	      WHERE o = w;
+
+ 	      current_result := 'The ' || current_temp;
+
+	      SELECT t
+	      INTO current_temp
+	      FROM dname
+	      WHERE o = extract( dow FROM current_date );
+
+	      current_result := current_result || ' ' || current_temp || ' of year ' || y || ' is ' || extract(day from current_date);
+	      RETURN current_result;
+	   END IF;
+
+	   SELECT current_date + 1
+	   INTO current_date;
+
+
+	END LOOP;
+
+	RETURN 'Date not found';
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-237/luca-ferrari/postgresql/ch-2.plperl b/challenge-237/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..70d98a50f4
--- /dev/null
+++ b/challenge-237/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,37 @@
+--
+-- Perl Weekly Challenge 237
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc237;
+
+CREATE OR REPLACE FUNCTION
+pwc237.task2_plperl( int[] )
+RETURNS int
+AS $CODE$
+   my ( $nums ) = @_;
+
+   my $permutations = {};
+
+   use List::Permutor;
+   my $engine = List::Permutor->new( $nums->@* );
+   while ( my @current_permutation = $engine->next ) {
+   	 for ( 0 .. $nums->@* ) {
+	     if ( $nums->[ $_ ] > $current_permutation[ $_ ] ) {
+	     	# stop here
+		push $permutations->{ $_ }->@*, $current_permutation;
+		last;
+	     }
+	 }
+   }
+
+   
+
+
+   #seek the max key
+   return ( sort keys $permutations->%* )[ -1 ];
+
+
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-237/luca-ferrari/postgresql/ch-2.sql b/challenge-237/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..a565fa76d7
--- /dev/null
+++ b/challenge-237/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,16 @@
+--
+-- Perl Weekly Challenge 237
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc237;
+
+CREATE OR REPLACE FUNCTION
+pwc237.task2_plpgsql( nums int[] )
+RETURNS int
+AS $CODE$
+	SELECT pwc237.task2_plperl( nums );
+$CODE$
+LANGUAGE sql;
diff --git a/challenge-237/luca-ferrari/raku/ch-1.p6 b/challenge-237/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..9954c5628d
--- /dev/null
+++ b/challenge-237/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,38 @@
+#!raku
+
+#
+# Perl Weekly Challenge 237
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+#
+
+sub MAIN( Int :$y, Int :$m, Int :$d, Int :$w ) {
+    my $date = Date.new( year => $y,
+			 month => $m,
+			 day => 1 );
+
+    my %ord = 1 => 'first', 2 => 'second', 3 => 'third';
+    %ord{ $_ } = $_ ~ 'th' for ( 4 .. 31 );
+
+    my %names = 1 => 'Monday',
+		2 => 'Tuesday',
+		3 => 'Wednsday',
+		4 => 'Thursday',
+		5 => 'Friday',
+		6 => 'Saturday',
+		7 => 'Sunday';
+
+    my $current-week = 0;
+    while ( $date.month == $m && $date.year == $y ) {
+
+	$current-week++ if ( $date.day-of-week == 1 );
+	if ( $date.day-of-week == $d && $current-week == $w ) {
+	    "The { %ord{ $current-week } } { %names{ $date.day-of-week } } of month $m in year $y is { $date.day }".say;
+	    exit;
+	}
+	$date++;
+    }
+
+    'Not found'.say;
+}
diff --git a/challenge-237/luca-ferrari/raku/ch-2.p6 b/challenge-237/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..f5804126b3
--- /dev/null
+++ b/challenge-237/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,27 @@
+#!raku
+
+#
+# Perl Weekly Challenge 237
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/>
+#
+
+sub MAIN( *@nums where { @nums.grep( * ~~Int ).elems == @nums.elems } ) {
+
+    my %permutations;
+
+    for @nums.permutations -> $current-permutation {
+	for 0 ..^ @nums.elems {
+	    if ( @nums[ $_ ] > $current-permutation[ $_ ] ) {
+		%permutations.{ $_ }.push: $current-permutation;
+		last;
+	    }
+	}
+    }
+
+    my $greatest = %permutations.keys.max;
+    my $permutations = %permutations{ $greatest }.elems;
+    "Greatest $greatest with $permutations possible permutations".say;
+    %permutations{ $greatest }[ 0 ].join( ',' ).say;
+}