Merge pull request #6492 from mattneleigh/pwc174

	new file:   challenge-174/mattneleigh/perl/ch-1.pl

2 files changed, 210 insertions, 0 deletions

diff --git a/challenge-174/mattneleigh/perl/ch-1.pl b/challenge-174/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..5fc63024a4
--- /dev/null
+++ b/challenge-174/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my $q = 19;
+my $n = 0;
+my @disariums;
+
+while(scalar(@disariums) < $q){
+# print("Checking ", $n, "... found ", scalar(@disariums), "\n");
+    push(@disariums, $n)
+        if(is_disarium_number($n));
+    $n++;
+}
+
+printf(
+    "\nThe first %d Disarium numbers are:\n    %s\n\n",
+    $q,
+    join(", ", @disariums)
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether an integer N is a Disarium number- the sum of each digit
+# raised to the power of its position within the number is equal to the number
+# itself (e.g. 518 == (5 ** 1) + (1 ** 2) + (8 ** 3) )
+# Takes one argument:
+# * The integer to examine
+# Returns:
+# * 1 if N is a Disarium number
+# * 0 if N is not a Disarium number
+################################################################################
+sub is_disarium_number{
+    my $n = int(shift());
+
+    my $sum = 0;
+
+    # Loop over each digit, summing its value raised to
+    # the power of its position in the string
+    for my $i (1 .. length($n)){
+        $sum += substr($n, $i - 1, 1) ** $i;
+    }
+
+    # Indicate whether the sum is equal to the original
+    # number or not
+    return(
+        $sum == $n ? 1 : 0
+    );
+
+}
+
+
+
diff --git a/challenge-174/mattneleigh/perl/ch-2.pl b/challenge-174/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..9395e6a3f3
--- /dev/null
+++ b/challenge-174/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,145 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @lists = (
+    [ 1, 0, 2 ],
+    [ 0, 1, 2 ]
+);
+my $rank = 1;
+
+
+print("\n");
+printf(
+    "permutation2rank([%s]) = %d\n",
+    join(", ", @{$lists[0]}),
+    permutation2rank(@{$lists[0]})
+);
+print("\n");
+printf(
+    "rank2permutation([%s], %d) = [%s]\n",
+    join(", ", @{$lists[1]}),
+    $rank,
+    join(", ", rank2permutation($lists[1], $rank)),
+);
+print("\n");
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Calculate the rank of a permutation of unique consecutive integers starting
+# with 0, as specified in lexicographic order (e.g. ( 0, 1, 2 ), ( 0, 2, 1 ),
+# etc.)
+# Takes one argument:
+# * The permutation to examine, as a list of digits (e.g. ( 1, 0, 2 ) )
+# Returns:
+# * The lexicographic rank of the specified permutation, starting with 0 (e.g.
+#   2 )
+# Translated from the Python equivalent at:
+# https://tryalgo.org/en/permutations/2016/09/05/permutation-rank/
+################################################################################
+sub permutation2rank{
+    use POSIX;
+
+    my $i;
+    my $n = scalar(@ARG);
+    my $factorial = 1;
+
+    # A pool of all possible digits for a list
+    # of the given size
+    my @digits = (0 .. $n - 1);
+
+    my $rank = 0;
+
+    # Calculate ($n - 1)!
+    for $i (2 .. $n - 1){
+        $factorial *= $i;
+    }
+
+    # Loop over all digits but the last
+    for $i (0 .. $n - 2){
+        my $q = $digits[$ARG[$i]];
+
+        $rank += $factorial * $q;
+
+        # Remove the examined digit from the pool
+        splice(@digits, $q, 1);
+
+        # Calculate the weight of the next digit
+        $factorial = floor($factorial / ($n - 1 - $i));
+    }
+
+    return($rank);
+
+}
+
+
+
+################################################################################
+# Produce the permutation of specified rank from a series of permutations, in
+# lexicographic order, of a list of unique consecutive integers starting with 0
+# (e.g. ( 0, 1, 2 ), ( 0, 2, 1 ), etc.)
+# Takes two arguments:
+# * A ref to a list of integers- this is exclusively used to calculate the
+#   upper bound of values to be found within the list (e.g. [ 0, 1, 2 ] )
+# * The desired rank, with ranks beginning at 0 (e.g. 1 )
+# Returns:
+# * A list of digits corresponding to the permutation of the specified rank
+#   (e.g. ( 0, 2, 1 ) )
+# Translated from the Python equivalent at:
+# https://tryalgo.org/en/permutations/2016/09/05/permutation-rank/
+################################################################################
+sub rank2permutation{
+    use POSIX;
+
+    my $n = scalar(@{shift()});
+    my $rank = int(shift());
+
+    my $i;
+    my $factorial = 1;
+
+    # A pool of all possible digits for a list
+    # of the given size
+    my @digits = (0 .. $n - 1);
+
+    my @permutation;
+
+    # Calculate ($n - 1)!
+    for $i (2 .. $n - 1){
+        $factorial *= $i;
+    }
+
+
+    for $i (0 .. $n - 1){
+        my $q = floor($rank / $factorial);
+
+        $rank %= $factorial;
+
+        # Add the digit to the list and remove
+        # the used digit from the pool
+        push(@permutation, $digits[$q]);
+        splice(@digits, $q, 1);
+
+        if($i != ($n - 1)){
+            # Calculate the weight of the next digit
+            $factorial = floor($factorial / ($n - 1 - $i));
+        }
+    }
+
+    return(@permutation);
+
+}
+
+
+