pwc174 solution

2 files changed, 90 insertions, 0 deletions

diff --git a/challenge-174/pokgopun/perl/ch-1.pl b/challenge-174/pokgopun/perl/ch-1.pl
new file mode 100644
index 0000000000..8dd9852d2e
--- /dev/null
+++ b/challenge-174/pokgopun/perl/ch-1.pl
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+my $cntdwn = 19;
+my $i = 0;
+{
+	print "$i\n" if isDisarium($i) && $cntdwn--;
+	$i++;
+	redo if $cntdwn && $i < 5_000_000;
+}
+
+sub isDisarium{
+	### both sum and power retain their odd/even properties, we can use them to filter
+	return $i % 2 == sum(digit($i)) % 2 ? $i==sum(power(digit($i))) : 0;
+}
+### take 1st argument as a number and return an array of digits made from it
+sub digit{
+	my $n = shift;
+	{
+		unshift @_, $n % 10;
+		$n = int($n/10);
+		redo if $n;
+	}
+	return @_;
+}
+### takes all arguments as numbers and return summation of them
+sub sum{
+	my $sum;
+	$sum += $_ foreach @_;
+	return $sum
+}
+### take all arguments as numbers to power them to their orders and return them
+sub power{
+	foreach my $i (1..@_) {
+		$_[$i-1] **= $i;
+	}
+	return @_;
+}
diff --git a/challenge-174/pokgopun/perl/ch-2.pl b/challenge-174/pokgopun/perl/ch-2.pl
new file mode 100644
index 0000000000..c5313ff99c
--- /dev/null
+++ b/challenge-174/pokgopun/perl/ch-2.pl
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+
+foreach my $p ([1,0,2], [0,2,1], [@ARGV]){
+	my $n = @$p;
+	next unless $n;
+	printf "\npermuation_rank([%s]) = %d\n", join(",", @$p), my $r = &permutation_rank(@$p);
+	printf "rank_permutation([%s],%d) = [%s]\n\n", join(",",0..$n-1), $r, join(",",&rank_permutation($n, $r));
+}
+
+sub factorial{
+	my $n = shift;
+	return $n ? $n * factorial($n-1) : 1;
+}
+
+sub rank_permutation(){
+	my ($n,$r) = @_;
+	my $fact = &factorial($n-1);			# compute (n-1) factorial
+    	my @digits =  0..$n-1;				# all yet unused digits
+    	my @p;						# build permutation
+	my $q;
+	foreach my $i (0..$n-1){			# for all digits except last one
+		$q = int($r / $fact);			# by decomposing r = q * fact + rest
+		$r %= $fact;
+		push @p, $digits[$q];
+		$digits[$q] = undef;			# remove this digit p[i];
+		@digits = grep{defined} @digits;
+		$fact /= $n - 1 - $i if $i != $n - 1;	# weight of next digit
+	}
+	return @p;
+}
+
+sub permutation_rank{
+	my $p = \@_;
+	my $n = @_;
+	my $fact = &factorial($n-1);			# compute (n-1) factorial
+	my ($q, $r);
+    	my @digits =  0..$n-1;				# all yet unused digits
+	foreach my $i (0..$n-2){			# for all digits except last one
+		$q = 0;
+		{
+			last if $digits[$q]==$p->[$i];
+			$q++;
+			redo;
+		}
+		$r += $fact * $q;
+		$digits[$q] = undef;
+		@digits = grep{defined} @digits;	# remove this digit p[i]
+		$fact /= $n - 1 - $i;			# weight of next digit
+	}
+	return $r
+}