Merge pull request #6463 from fluca1978/PWC174

Pwc174

12 files changed, 214 insertions, 0 deletions

diff --git a/challenge-174/luca-ferrari/blog-1.txt b/challenge-174/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..e866f76e11
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task1
diff --git a/challenge-174/luca-ferrari/blog-2.txt b/challenge-174/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..3c1060d323
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task2
diff --git a/challenge-174/luca-ferrari/blog-3.txt b/challenge-174/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..482fba219c
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task1plperl
diff --git a/challenge-174/luca-ferrari/blog-4.txt b/challenge-174/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..8451faf8a0
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task2plperl
diff --git a/challenge-174/luca-ferrari/blog-5.txt b/challenge-174/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..77f90c1513
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task1plpgsql
diff --git a/challenge-174/luca-ferrari/blog-6.txt b/challenge-174/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..f48d618b0d
--- /dev/null
+++ b/challenge-174/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/07/18/PerlWeeklyChallenge174.html#task2plpgsql
diff --git a/challenge-174/luca-ferrari/postgresql/ch-1.plperl b/challenge-174/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..6aa3183f55
--- /dev/null
+++ b/challenge-174/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,29 @@
+-- Perl Weekly Challenge 174
+-- Task 1
+
+CREATE SCHEMA IF NOT EXISTS pwc174;
+
+CREATE OR REPLACE FUNCTION
+pwc174.task1_plperl( int )
+RETURNS SETOF BIGINT
+AS $CODE$
+
+my ( $limit ) = @_;
+my ( $current ) = 9;
+while ( $limit > 0 ) {
+     $current++;
+     my $index = 0;
+     my @digits = map { $_ ** ++$index } split( //, $current );
+     my $sum = 0;
+     $sum += $_  for ( @digits );
+
+     if ( $current == $sum ) {
+        $limit--;
+        return_next( $current );
+     }
+}
+
+return undef;
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-174/luca-ferrari/postgresql/ch-1.sql b/challenge-174/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..0487a7c19e
--- /dev/null
+++ b/challenge-174/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,60 @@
+-- Perl Weekly Challenge 174
+-- Task 1
+
+CREATE SCHEMA IF NOT EXISTS pwc174;
+
+CREATE OR REPLACE FUNCTION
+pwc174.task1_plpgsql( l int DEFAULT 19 )
+RETURNS SETOF BIGINT
+AS $CODE$
+DECLARE
+        i int;
+        v bigint;
+        n bigint;
+        s bigint;
+BEGIN
+        FOR n IN 10 .. 999999 LOOP
+            i := 1;
+            s := 0;
+
+            FOR v IN SELECT * FROM regexp_split_to_table( n::text, '' ) LOOP
+                s := s + pow( v::bigint, i );
+                i := i + 1;
+            END LOOP;
+
+            IF s = n THEN
+               l := l - 1;
+               RETURN NEXT n;
+            END IF;
+
+            IF l <= 0 THEN
+               EXIT;
+            END IF;
+        END LOOP;
+RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+-- single query approach
+WITH digits AS
+(
+   SELECT v, digits.*, pow( digits.d, digits.rn) AS p
+   FROM generate_series( 10, 99999 ) v
+   , LATERAL ( SELECT d::bigint, row_number() over () AS rn
+       FROM regexp_split_to_table( v::text, '') d
+     ) digits
+
+)
+, comparison AS
+(
+   SELECT v, sum( p ) as s
+   FROM digits
+   GROUP BY v
+)
+SELECT *
+FROM comparison
+WHERE v = s
+ORDER BY v
+;
diff --git a/challenge-174/luca-ferrari/postgresql/ch-2.plperl b/challenge-174/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..65e9656fa7
--- /dev/null
+++ b/challenge-174/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,55 @@
+-- Perl Weekly Challenge 174
+-- Task 2
+
+CREATE SCHEMA IF NOT EXISTS pwc174;
+
+CREATE OR REPLACE FUNCTION
+pwc174.task2_permutation2rank( int[] )
+RETURNS int
+AS $CODE$
+
+use List::Permutor;
+
+my $input = shift;
+elog( DEBUG, "INPUT " . join( ",", @{ $input } ) );
+
+my @permutations;
+my $permutator   = List::Permutor->new( @{ $input } );
+while ( my @current = $permutator->next ) {
+      push @permutations, join( '', @current );
+}
+
+@permutations = sort @permutations;
+
+for ( 0 .. $#permutations ) {
+    return $_ if $permutations[ $_ ] == join( '', @{ $input } );
+}
+
+return -1;
+$CODE$
+LANGUAGE plperlu;
+
+
+CREATE OR REPLACE FUNCTION
+pwc174.task2_rank2permutation( int, int[] )
+RETURNS int[]
+AS $CODE$
+
+use List::Permutor;
+
+my $index = shift;
+my $input = shift;
+elog( DEBUG, "INPUT " . join( ",", @{ $input } ) );
+
+my @permutations;
+my $permutator   = List::Permutor->new( @{ $input } );
+while ( my @current = $permutator->next ) {
+      push @permutations, join( '-', @current );
+}
+
+@permutations = sort @permutations;
+return [ split '-', @permutations[ $index ] ];
+
+return undef;
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-174/luca-ferrari/postgresql/ch-2.sql b/challenge-174/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..75a89aa958
--- /dev/null
+++ b/challenge-174/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,26 @@
+-- Perl Weekly Challenge 174
+-- Task 2
+
+CREATE SCHEMA IF NOT EXISTS pwc174;
+
+CREATE OR REPLACE FUNCTION
+pwc174.task2_plpgsql_permutation2rank( input int[] )
+RETURNS int
+AS $CODE$
+BEGIN
+        RETURN pwc174.task2_permutation2rank( input );
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc174.task2_plpgsql_rank2permutation( i int, input int[] )
+RETURNS int[]
+AS $CODE$
+BEGIN
+RETURN pwc174.task2_rank2permutation( i, input );
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-174/luca-ferrari/raku/ch-1.p6 b/challenge-174/luca-ferrari/raku/ch-1.p6
new file mode 100755
index 0000000000..cbc285b279
--- /dev/null
+++ b/challenge-174/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,15 @@
+#!raku
+
+# Perl Weekly Challenge 174
+
+sub MAIN( Int $limit = 19 ) {
+
+    my @disarium-numbers = lazy gather {
+        for 10 .. Inf {
+            my $index = 0;
+            take $_ if $_.comb.map( * ** ++$index ).sum == $_;
+        }
+    };
+
+    @disarium-numbers[ 0 .. $limit ].join( "\n" ).say;
+}
diff --git a/challenge-174/luca-ferrari/raku/ch-2.p6 b/challenge-174/luca-ferrari/raku/ch-2.p6
new file mode 100755
index 0000000000..13e824148d
--- /dev/null
+++ b/challenge-174/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,23 @@
+#!raku
+
+# Perl Weekly Challenge 174
+
+sub permutation2rank( @a ) {
+    my $index = 0;
+    my @sorted = @a.permutations.sort;
+    for @sorted {
+        return $index if $_ ~~ @a;
+        $index++;
+    }
+}
+
+sub rank2permutation( @a, $offset ) {
+    return @a.permutations.sort[ $offset ];
+}
+
+
+sub MAIN( *@input where { @input.grep( * ~~ Int ).elems == @input.elems } ) {
+
+    say permutation2rank( @input);
+    say rank2permutation( @input, 1 );
+}