Merge pull request #6485 from Bhat-Gurunandan/my_task_174

Perl Solution to Challenge 174

3 files changed, 152 insertions, 0 deletions

diff --git a/challenge-174/bhat_gurunandan/README b/challenge-174/bhat_gurunandan/README
new file mode 100644
index 0000000000..b5f27d302f
--- /dev/null
+++ b/challenge-174/bhat_gurunandan/README
@@ -0,0 +1 @@
+Solution by Gurunandan Bhat
diff --git a/challenge-174/bhat_gurunandan/perl/ch-1.pl b/challenge-174/bhat_gurunandan/perl/ch-1.pl
new file mode 100755
index 0000000000..d3b047e5cc
--- /dev/null
+++ b/challenge-174/bhat_gurunandan/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+
+use 5.36.0;
+
+# The 20th number takes a huge amount of time and requires bigint
+# which sadly slows it down further. So since we want 19 only...
+use integer;
+
+#
+# power_cache ($d, $n)
+#
+# $d: number we want to exponentiate
+# $n: exponent
+#
+# returns $d^$n and caches the value. exponentiation is carried out by
+# repeated multiplication with the nearest exponent that is already
+# cached
+
+sub power_cache ($d, $n) {
+
+  state $cache = {};
+
+  if ($$cache {$d} [$n]) {
+
+    # cache hit
+    return $$cache {$d} [$n];
+  }
+  elsif (($n == 1) || ($d <= 1)) {
+
+    # trivial exponentiation
+    return ($$cache {$d} [$n] = $d);
+  }
+  else {
+
+    # recurse!
+    return ($$cache {$d} [$n] = $d * power_cache ($d, $n - 1));
+  }
+}
+
+my $MAX = 19;
+my $this = 0;
+my @d_numbers;
+
+while (@d_numbers < $MAX) {
+
+  my @digits = split //, $this;
+
+  my $d_sum = 0;
+  $d_sum += power_cache (int $digits [$_], int $_ + 1)
+    for (0 .. $#digits);
+
+  if ($this == $d_sum) {
+    push @d_numbers, $this;
+    say scalar (@d_numbers) . " Found $this";
+  }
+
+  ++$this;
+}
diff --git a/challenge-174/bhat_gurunandan/perl/ch-2.pl b/challenge-174/bhat_gurunandan/perl/ch-2.pl
new file mode 100755
index 0000000000..978270d464
--- /dev/null
+++ b/challenge-174/bhat_gurunandan/perl/ch-2.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/env perl
+
+use 5.36.0;
+
+use integer;
+
+sub factorials ($n) {
+
+	my $out = [1];
+	for (1 .. $n - 1) {
+		push @$out, $_ * $$out [-1];
+	}
+
+	return $out;
+}
+
+# _rank ($a, $n)
+#
+# $a = array reference to individual elements of the permutation
+# $n index of the element in the array 'a'
+#
+# Finds the rank of the elelemt at index $n in array 'a' wrt the
+# sorted array
+#
+
+sub _rank ($a, $n) {
+
+	my $rank = $$a [$n];
+	return $rank unless ($n > 0);
+
+	my $this = $$a [$n];
+	for (0 .. $n) {
+		-- $rank if $this > $$a [$_];
+	}
+
+	return $rank;
+}
+
+# perm2rank ($str)
+#
+# $str: A permutation of 0 .. n-1 as a concatenated string
+# returns the rank of $str
+#
+sub perm2rank ($str) {
+
+	my @perm = map { int $_ } split //, $str;
+
+	my $rank = 0;
+	my $fact = 1;
+	my $elems = scalar @perm;
+
+	# reverse the loop over elements for efficient factorials
+	for (reverse 0 .. $#perm) {
+
+		$rank += $fact * _rank (\@perm, $_);
+		$fact *= ($elems - $_);
+	}
+
+	return $rank;
+}
+
+# rank2perm ($rank, $dim)
+#
+# $rank - the rank whose permutation we want
+# $dim  - the dimension of the set that is permuted.
+#         Note that for $dim, the set is 0 - $dim -1
+#
+
+sub rank2perm ($rank, $dim) {
+
+	my $factorials = factorials ($dim);
+	my @_initial = 0 .. $dim - 1;
+
+	my $perm;
+	for (0 .. $dim - 1) {
+
+		my $fact = pop @$factorials;
+
+		my $pos  = $rank / ($fact);
+		   $rank = $rank % $fact;
+
+		$perm .= splice @_initial, $pos, 1;
+	}
+
+	return $perm;
+}
+
+my $str = $ARGV [0];
+my $rank = perm2rank ($str);
+my $perm = rank2perm ($rank, length ($str));
+
+say "The rank of $str is $rank and " .
+    "the permutation of rank $rank is $perm"