Merge pull request #8438 from fluca1978/PWC227

PWC 227

12 files changed, 339 insertions, 0 deletions

diff --git a/challenge-227/luca-ferrari/blog-1.txt b/challenge-227/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..fa2952f623
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1
diff --git a/challenge-227/luca-ferrari/blog-2.txt b/challenge-227/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..a598730e67
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2
diff --git a/challenge-227/luca-ferrari/blog-3.txt b/challenge-227/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..851f75b38c
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1plperl
diff --git a/challenge-227/luca-ferrari/blog-4.txt b/challenge-227/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..1a7bc7ba29
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2plperl
diff --git a/challenge-227/luca-ferrari/blog-5.txt b/challenge-227/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..4bfd9bf593
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1plpgsql
diff --git a/challenge-227/luca-ferrari/blog-6.txt b/challenge-227/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..15c3922562
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2plpgsql
diff --git a/challenge-227/luca-ferrari/postgresql/ch-1.plperl b/challenge-227/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..9cc242ad14
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,25 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task1_plperl( int )
+RETURNS int
+AS $CODE$
+   my ( $year ) = @_;
+   my $fridays = 0;
+   
+   use DateTime;
+   my $day = DateTime->new( year => $year, day => 13, month => 1 );
+   while ( $day->month <= 12 && $day->year == $year ) {
+   	 $fridays++ if ( $day->day_abbr eq 'Fri' );
+	 $day->add(  months => 1  );
+   }
+
+   return $fridays;
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-1.sql b/challenge-227/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..fea32c14fa
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,27 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task1_plpgsql( y int)
+RETURNS int
+AS $CODE$
+DECLARE
+	fridays int := 0;
+	m int;
+BEGIN
+	FOR m IN 1 .. 12 LOOP
+	    IF extract( dow FROM make_date( y, m, 13 ) ) = 5 THEN
+	       fridays := fridays + 1;
+	    END IF;
+	END LOOP;
+
+	RETURN fridays;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-2.plperl b/challenge-227/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..802920a72b
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,80 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task2_plperl( text, text, text )
+RETURNS text
+AS $CODE$
+   use v5.20;
+   my ( $left, $operator, $right ) = @_;
+
+   my $symbols = {
+          1 => 'I',
+	  4 => 'IV',	  
+	  5 => 'V',	  
+	  9 => 'IX',	  
+	 10 => 'X',	  
+	 40 => 'XL',
+	 50 => 'L',
+	 90 => 'XC',
+	 100 => 'C',
+	 400 => 'CD',
+	 500 => 'D',
+	 900 => 'CM',
+	1000 => 'M'
+      };
+
+
+   my $unsymbols = {};
+   $unsymbols->{ $symbols->{ $_ } } = $_   for ( keys $symbols->%* );
+
+
+
+   use Sub::Recursive;
+
+   my $to_roman = recursive {
+      my ( $number ) = @_;
+
+      
+
+
+      return '' if ! $number;
+
+      for my $arabic ( sort  { $b <=> $a } keys $symbols->%* ) {
+      	  if ( $number >= $arabic ) {
+	     return $symbols->{ $arabic } . $REC->( $number - $arabic );
+	  }
+      }
+
+   };
+
+
+   my $to_arabic = sub {
+      my ( $number ) = @_;
+      my $value = 0;
+      for my $roman ( reverse sort keys $unsymbols->%* ) {
+      	  $value += $unsymbols->{ $roman } while $number =~ s/^$roman//i;
+      }
+
+      return $value;
+   };
+
+
+   my $result = 0;
+   given ( $operator ) {
+   	 when (/\+/) { $result = $to_arabic->( $left ) + $to_arabic->( $right ); }
+    	 when (/\-/) { $result = $to_arabic->( $left ) - $to_arabic->( $right ); }
+   	 when (/\//) { $result = $to_arabic->( $left ) / $to_arabic->( $right ); }
+   	 when (/\*/) { $result = $to_arabic->( $left ) * $to_arabic->( $right ); }	 
+   }
+
+   return undef if ( $result < 1 );
+   return $to_roman->( $result );
+
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-2.sql b/challenge-227/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..df110b1be6
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,108 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+
+CREATE  TABLE IF NOT EXISTS pwc227.roman( r text, n int );
+
+TRUNCATE TABLE pwc227.roman;
+
+INSERT INTO pwc227.roman
+VALUES
+('I', 1 )
+,( 'IV', 4 )
+,( 'V', 5 )
+,( 'IX', 9 )
+,( 'X', 10 )
+,( 'XL', 40 )
+,( 'L', 50 )
+,( 'XC', 90 )
+,( 'C', 100 )
+,( 'CD', 400 )
+,( 'D', 500 )
+,( 'CM', 900 )
+,( 'M', 1000 );
+
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.to_roman( n int )
+RETURNS text
+AS $CODE$
+
+DECLARE
+	roman_value text := '';
+        current_record pwc227.roman%rowtype;
+BEGIN
+	IF n <= 0 THEN
+	   RETURN NULL;
+	END IF;
+
+	IF n = 1 THEN
+	   RETURN 'I';
+	END IF;
+
+	FOR current_record IN SELECT * FROM pwc227.roman ORDER BY n DESC LOOP
+
+	    WHILE n >= current_record.n LOOP
+	       roman_value := roman_value || current_record.r;
+	       n := n - current_record.n;
+	    END LOOP;
+	END LOOP;
+
+	RETURN roman_value;
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.from_roman( r text )
+RETURNS int
+AS $CODE$
+DECLARE
+	v int := 0;
+	current_record pwc227.roman%rowtype;
+BEGIN
+	FOR current_record IN SELECT * FROM pwc227.roman ORDER BY n DESC LOOP
+	    WHILE r ~ ( '^' || current_record.r)	   LOOP
+	       v := v + current_record.n;
+	       r := regexp_replace( r, '^' || current_record.r, '' );
+	    END LOOP;
+	END LOOP;
+
+	RETURN v;
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.task2_plpgsql( a text, op text, b text )
+RETURNS text
+AS $CODE$
+DECLARE
+	v int;
+BEGIN
+	IF op = '+' THEN
+	   v := pwc227.from_roman( a ) + pwc227.from_roman( b );
+	ELSIF op = '-' THEN
+	   v := pwc227.from_roman( a ) - pwc227.from_roman( b );
+	ELSIF op = '*' THEN
+	  v := pwc227.from_roman( a ) * pwc227.from_roman( b );
+	ELSIF op = '/' THEN
+   	  v := pwc227.from_roman( a ) / pwc227.from_roman( b );
+	END IF;
+
+	RETURN pwc227.to_roman( v );
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-227/luca-ferrari/raku/ch-1.p6 b/challenge-227/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..c9068592ab
--- /dev/null
+++ b/challenge-227/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,19 @@
+#!raku
+
+#
+# Perl Weekly Challenge 227
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+#
+
+sub MAIN( Int $year where { 1753 <= $year <= 9999 }, Bool :$verbose = True ) {
+    my @fridays;
+    for 1 .. 12 -> $month {
+	my $day = Date.new( year => $year, day => 13, month => $month );
+	@fridays.push: $day if ( $day.day-of-week == 5 );
+    }
+
+    @fridays.elems.say;
+    @fridays.join( ', ' ).say if $verbose;
+}
diff --git a/challenge-227/luca-ferrari/raku/ch-2.p6 b/challenge-227/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..c57f2c3963
--- /dev/null
+++ b/challenge-227/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,74 @@
+#!raku
+
+#
+# Perl Weekly Challenge 227
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+#
+
+sub rom-to-num($r) {
+    [+] gather $r.uc ~~ /
+        ^
+        [
+        | M  { take 1000 }
+        | CM { take 900 }
+        | D  { take 500 }
+        | CD { take 400 }
+        | C  { take 100 }
+        | XC { take 90 }
+        | L  { take 50 }
+        | XL { take 40 }
+        | X  { take 10 }
+        | IX { take 9 }
+        | V  { take 5 }
+        | IV { take 4 }
+        | I  { take 1 }
+        ]+
+        $
+    /;
+}
+
+
+my %symbols =
+    1 => 'I',
+    4 => 'IV',
+    5 => 'V',
+    9 => 'IX',
+    10 => 'X',
+    40 => 'XL',
+    50 => 'L',
+    90 => 'XC',
+    100 => 'C',
+    400 => 'CD',
+    500 => 'D',
+    900 => 'CM',
+    1000 => 'M'
+;
+
+sub arabic-to-roman( $number ) {
+    return ''  if $number == 0;
+
+    for %symbols.keys.sort( { $^b <=> $^a } ) {
+	if $number >= $_ {
+	    return %symbols{ $_ } ~ arabic-to-roman( $number - $_ );
+	}
+    }
+
+}
+
+sub MAIN( *@s where { @s.elems == 3 } ) {
+
+    my @operands = rom-to-num( @s[ 0 ] ), rom-to-num( @s[ 2 ] );
+    my $result;
+    given ( @s[ 1 ] ) {
+	when '+' { $result = [+] @operands; }
+	when '-' { $result = [-] @operands; }
+	when '*' { $result = [*] @operands; }
+	when '/' { $result = [/] @operands; }
+
+    }
+
+    exit if $result <= 0;
+    say arabic-to-roman( $result );
+}