Add Perl solution

5 files changed, 138 insertions, 0 deletions

diff --git a/challenge-174/paulo-custodio/Makefile b/challenge-174/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-174/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-174/paulo-custodio/perl/ch-1.pl b/challenge-174/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..1b2ea1c24b
--- /dev/null
+++ b/challenge-174/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+# Challenge 174
+#
+# Task 1: Disarium Numbers
+# Submitted by: Mohammad S Anwar
+#
+# Write a script to generate first 19 Disarium Numbers.
+#
+#     A disarium number is an integer where the sum of each digit raised to the
+#     power of its position in the number, is equal to the number.
+#
+#
+# For example,
+#
+# 518 is a disarium number as (5 ** 1) + (1 ** 2) + (8 ** 3) => 5 + 1 + 512 => 518
+
+use Modern::Perl;
+use List::Util 'sum';
+
+sub is_disarium {
+    my($n) = @_;
+    my @digits = split //, $n;
+    for my $i (1..@digits) {
+        $digits[$i-1] = $digits[$i-1] ** $i;
+    }
+    return sum(@digits) == $n;
+}
+
+sub disarium_numbers {
+    my($N) = @_;
+    my $n = 1;
+    my @result;
+    while (@result < $N) {
+        push @result, $n if is_disarium($n);
+        $n++;
+    }
+    return @result;
+}
+
+@ARGV==1 or die "usage: ch-1.pl n\n";
+say join ", ", disarium_numbers(shift);
diff --git a/challenge-174/paulo-custodio/perl/ch-2.pl b/challenge-174/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..003d0c206b
--- /dev/null
+++ b/challenge-174/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+
+# Challenge 174
+#
+# Task 2: Permutation Ranking
+# Submitted by: Mohammad S Anwar
+#
+# You are given a list of integers with no duplicates, e.g. [0, 1, 2].
+#
+# Write two functions, permutation2rank() which will take the list and determine
+# its rank (starting at 0) in the set of possible permutations arranged in
+# lexicographic order, and rank2permutation() which will take the list and a rank
+# number and produce just that permutation.
+#
+# Please checkout this post for more informations and algorithm.
+#
+# Given the list [0, 1, 2] the ordered permutations are:
+#
+# 0: [0, 1, 2]
+# 1: [0, 2, 1]
+# 2: [1, 0, 2]
+# 3: [1, 2, 0]
+# 4: [2, 0, 1]
+# 5: [2, 1, 0]
+#
+# and therefore:
+#
+# permutation2rank([1, 0, 2]) = 2
+#
+# rank2permutation([0, 1, 2], 1) = [0, 2, 1]
+
+use Modern::Perl;
+use Test::More;
+
+sub fact {
+    my($n) = @_;
+    my $result = 1;
+    $result *= $_ for 2..$n;
+    return $result;
+}
+
+# https://tryalgo.org/en/permutations/2016/09/05/permutation-rank/
+sub permutation2rank {
+    my($p) = @_;
+    my $n = scalar(@$p);
+    my $fact = fact($n-1);              # (n-1)!
+    my $rank = 0;
+    my @digits = (0..$n-1);             # all unused digits
+    for my $i (0..$n-2) {
+        my($q) = map {$_->[0]}
+                 grep {$_->[1] == $p->[$i]}
+                 map {[$_, $digits[$_]]} 0..$#digits;
+        $rank += $fact * $q;
+        splice(@digits, $q, 1);         # remove digit p[i]
+        $fact = int($fact / ($n-1-$i)); # weight of next digit
+    }
+    return $rank;
+}
+
+# https://tryalgo.org/en/permutations/2016/09/05/permutation-rank/
+sub rank2permutation {
+    my($p, $rank) = @_;
+    my $n = scalar(@$p);
+    my $fact = fact($n-1);              # (n-1)!
+    my @digits = (0..$n-1);             # all unused digits
+    my @p;
+    for my $i (0..$n-1) {
+        my $q = int($rank / $fact);     # by decomposing rank = q * fact + rest
+        $rank %= $fact;
+        push @p, $digits[$q];
+        splice(@digits, $q, 1);         # remove digit at position q
+        if ($i != $n-1) {
+            $fact = int($fact / ($n-1-$i)); # weight of next digit
+        }
+    }
+    return \@p;
+}
+
+is permutation2rank([1, 0, 2]), 2;
+is_deeply rank2permutation([0, 1, 2], 1), [0, 2, 1];
+done_testing;
diff --git a/challenge-174/paulo-custodio/t/test-1.yaml b/challenge-174/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..e20629587c
--- /dev/null
+++ b/challenge-174/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:     18
+  input:
+  output:   1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798
diff --git a/challenge-174/paulo-custodio/t/test-2.yaml b/challenge-174/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..5c2d74364b
--- /dev/null
+++ b/challenge-174/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,8 @@
+- setup:
+  cleanup:
+  args:
+  input:
+  output:   |
+            |ok 1
+            |ok 2
+            |1..2