Week 174 - try again

5 files changed, 210 insertions, 144 deletions

diff --git a/challenge-154/peter-campbell-smith/perl/ch-1.pl b/challenge-154/peter-campbell-smith/perl/ch-1.pl
index 29466b9f56..4b520e241d 100755
--- a/challenge-154/peter-campbell-smith/perl/ch-1.pl
+++ b/challenge-154/peter-campbell-smith/perl/ch-1.pl
@@ -1,40 +1,29 @@
 #!/usr/bin/perl
 
-# Peter Campbell Smith - 2022-07-19
-# PWC 174 task 1
+# Peter Campbell Smith - 2022-02-28
+# PWC 154 task 1
 
 use v5.28;
 use strict;
-use warnings;
 use utf8;
-binmode(STDOUT, ':utf8');
-
-# 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.
-
-# Blog: https://pjcs-pwc.blogspot.com/2022/07/disarium-disaster-and-rank-permutations.html
-
-my ($j, $k, $sum, $count, $digit, $s1, $s2);
-
-# loop over everything
-NUMBER: for $j (0 .. 0xffffffff) {   # 2**64
-	
-	# calculate the Disarian sum
-	$sum = 0;
-	for ($k = length($j); $k >= 1; $k --) {
-		$sum += substr($j, $k - 1, 1) ** $k;
-		next NUMBER if $sum > $j;   # too big already - give up
-	}
-	next unless $sum == $j;
-	
-	# produce Mohammad's output
-	$s1 = $s2 = '';
-	for $k (1 .. length($j)) {
-		$digit = substr($j, $k - 1, 1);
-		$s1 .= qq[($digit ** $k) + ];
-		$s2 .= ($digit ** $k) . ' + ';
-	}
-	say substr($s1, 0, -3) . ' => ' . substr($s2, 0, -3) . ' => ' . $j;
-	last if ++$count == 19;
-}
+use Algorithm::Combinatorics qw(permutations);
 
+# You are given possible permutations of the string 'PERL'.
+# Write a script to find any permutations missing from the list.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/02/perming-perl-plus-padovan-primes.html
+
+my ($given, $iter, $perm, $word);
+
+$given = 'PELR, PREL, PERL, PRLE, PLER, PLRE, EPRL, EPLR, ERPL,
+ERLP, ELPR, ELRP, RPEL, RPLE, REPL, RELP, RLPE, RLEP,
+LPER, LPRE, LEPR, LRPE, LREP';
+
+# get all permutations
+$iter = permutations(['P', 'E', 'R', 'L']);
+
+# print the one(s) that don't match $given
+while ($perm = $iter->next) {
+	$word = join('', @$perm);
+	say $word unless $given =~ m|$word|;
+}	
diff --git a/challenge-154/peter-campbell-smith/perl/ch-2.pl b/challenge-154/peter-campbell-smith/perl/ch-2.pl
index e470929056..aeaada04b1 100755
--- a/challenge-154/peter-campbell-smith/perl/ch-2.pl
+++ b/challenge-154/peter-campbell-smith/perl/ch-2.pl
@@ -1,126 +1,36 @@
 #!/usr/bin/perl
 
-# Peter Campbell Smith - 2022-07-19
-# PWC 174 task 2
+# Peter Campbell Smith - 2022-02-28
+# PWC 154 task 2
 
 use v5.28;
 use strict;
-use warnings;
 use utf8;
-binmode(STDOUT, ':utf8');
+use Math::Prime::Util 'is_prime';
+use Math::BigInt lib => 'GMP';
 
-# 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.
+# In number theory, the Padovan sequence is the sequence of integers P(n) defined by the initial values
+# P(0) = P(1) = P(2) = 1 and then followed by P(n) = P(n-2) + P(n-3).
+# Write a script to compute first 10 distinct Padovan Primes.
 
-# Blog: https://pjcs-pwc.blogspot.com/2022/07/disarium-disaster-and-rank-permutations.html
+# Blog: https://pjcs-pwc.blogspot.com/2022/02/perming-perl-plus-padovan-primes.html
 
-my (@tests, $test, $rank, $max, $perm);
+my (@p, $n, $string, $count);
 
-# permutation must be some ordering of 0 .. $n - 1
-@tests = ([1, 0, 2], [0, 2, 3, 1], [7, 3, 1, 0, 2, 6, 4, 5],
-	[7, 14, 4, 11, 6, 0, 10, 1, 2, 3, 12, 5, 8, 13, 9],
-	[1, 2, 4]);   # invalid
-	
-say qq[\nPerm to rank];	
-
-for $test (@tests) {
-	$rank = permutation2rank(@$test);
-	say qq[perm: ] . join(', ', @$test) . qq[ => rank $rank];
-}
-
-say qq[\nRank to perm];
-
-@tests = ([2, 2], [3, 3], [7, 37564], [14, 693492952393], [14, 0]);
+# as in challenge text
+$p[0] = $p[1] = $p[2] = '1';
 
-for $test (@tests) {
-	($max, $rank) = @$test;
-	$perm = rank2permutation($max, $rank);
-	say qq[terms: $max, rank: $rank => perm: $perm]; 
-}
-	
-
-sub permutation2rank {
+# make successive Padovan numbers
+for ($n = 3; $count <= 10; $n ++) {
+	$p[$n] = Math::BigInt->new($p[$n - 2]);
+	$p[$n]->badd($p[$n - 3]);
 	
-	my (@p, $n, @fac, @ranks, $i, $rank, $this_rank, $k, $j, $digit, @seen);
-		
-	# input permutation and count no of elements
-	@p = @_;
-	$n = scalar @p;
-	
-	# calculate factorials up to $n - 1 and initialise @ranks
-	# see blog for definition of @ranks
-	$fac[0] = 1;
-	$ranks[0] = 0;
-	for $i (1 .. $n) {
-		$k = $p[$i - 1];
-		$fac[$i] = $fac[$i - 1] * $i;
-		$ranks[$i] = $i;
-		
-		# check valid perm with 1 occurrence of 0 .. $n - 1
-		return 'invalid permutation' if ($k < 0 or $k >= $n or $seen[$k]);
-		$seen[$k] = 1;
+	# but is it prime?
+	if (is_prime($p[$n])) {
+		$string .= qq[$p[$n], ];
+		$count ++;
 	}
-	
-	# loop over the components of the permutation and calculate how each contributes to the rank
-	$rank = 0;
-	for $i (0 .. $n - 1) {
-		
-		# $ranks[$digit] is the contribution to the ranking of this digit given that 
-		# some digits have already been seen and can't be in this ranking position
-		$digit = $p[$i];
-		
-		# so this digit is in $ranks[$digit] block and the block occupies [$n - 1 - $i]! rows
-		$this_rank = $ranks[$digit];
-		$rank += $this_rank * $fac[$n - 1 - $i];
-
-		# now we mark this digit as having been seen, so can't occur in subsequent positions
-		$ranks[$digit] = -1;
-		
-		# and re-jig @ranks ready for the next digit (see blog)
-		$k = 0;
-		for $j (0 .. $n - 1) {
-			next if $ranks[$j] < 0;
-			$ranks[$j] = $k;
-			$k ++;
-		}		
-	}
-	return $rank;
 }
 
-sub rank2permutation {
-	
-	my ($n, $rank, @fac, @ranks, @rranks, $k, $perm, $i, $j);
-	
-	($n, $rank) = @_;
-	$n ++;
-	
-	# calculate factorials up to $n - 1 and initialise @ranks
-	$fac[0] = 1;
-	$ranks[0] = 0;
-	for $i (1 .. $n - 1) {
-		$fac[$i] = $fac[$i - 1] * $i;
-		$ranks[$i] = $i;
-	}
-	
-	# loop over the components of the permutation and calculate how each contributes to the rank
-	$perm = '';
-	for $i (0 .. $n - 1) {
-		
-		# calc $j = no of blocks, and subtract those from $rank
-		$j = int($rank / $fac[$n - 1 - $i]);
-		$rank -= $j * $fac[$n - 1 - $i];
-		$perm .= qq[$ranks[$j], ];
-		$ranks[$j] = -1;
-		
-		# and re-jig @ranks ready for the next digit
-		$k = 0;
-		for $j (0 .. $n - 1) {
-			next if $ranks[$j] < 0;
-			$ranks[$k] = $ranks[$j];
-			$k ++;
-		}	
-	}
-	return substr($perm, 0, -2);
-}
+# eliminate the repeated '2' and the final ', '
+say substr($string, 3, -2);	
diff --git a/challenge-174/peter-campbell-smith/blog.txt b/challenge-174/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..e852a12266
--- /dev/null
+++ b/challenge-174/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/07/disarium-disaster-and-rank-permutations.html
diff --git a/challenge-174/peter-campbell-smith/perl/ch-1.pl b/challenge-174/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..29466b9f56
--- /dev/null
+++ b/challenge-174/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-07-19
+# PWC 174 task 1
+
+use v5.28;
+use strict;
+use warnings;
+use utf8;
+binmode(STDOUT, ':utf8');
+
+# 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.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/07/disarium-disaster-and-rank-permutations.html
+
+my ($j, $k, $sum, $count, $digit, $s1, $s2);
+
+# loop over everything
+NUMBER: for $j (0 .. 0xffffffff) {   # 2**64
+	
+	# calculate the Disarian sum
+	$sum = 0;
+	for ($k = length($j); $k >= 1; $k --) {
+		$sum += substr($j, $k - 1, 1) ** $k;
+		next NUMBER if $sum > $j;   # too big already - give up
+	}
+	next unless $sum == $j;
+	
+	# produce Mohammad's output
+	$s1 = $s2 = '';
+	for $k (1 .. length($j)) {
+		$digit = substr($j, $k - 1, 1);
+		$s1 .= qq[($digit ** $k) + ];
+		$s2 .= ($digit ** $k) . ' + ';
+	}
+	say substr($s1, 0, -3) . ' => ' . substr($s2, 0, -3) . ' => ' . $j;
+	last if ++$count == 19;
+}
+
diff --git a/challenge-174/peter-campbell-smith/perl/ch-2.pl b/challenge-174/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..e470929056
--- /dev/null
+++ b/challenge-174/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-07-19
+# PWC 174 task 2
+
+use v5.28;
+use strict;
+use warnings;
+use utf8;
+binmode(STDOUT, ':utf8');
+
+# 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.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/07/disarium-disaster-and-rank-permutations.html
+
+my (@tests, $test, $rank, $max, $perm);
+
+# permutation must be some ordering of 0 .. $n - 1
+@tests = ([1, 0, 2], [0, 2, 3, 1], [7, 3, 1, 0, 2, 6, 4, 5],
+	[7, 14, 4, 11, 6, 0, 10, 1, 2, 3, 12, 5, 8, 13, 9],
+	[1, 2, 4]);   # invalid
+	
+say qq[\nPerm to rank];	
+
+for $test (@tests) {
+	$rank = permutation2rank(@$test);
+	say qq[perm: ] . join(', ', @$test) . qq[ => rank $rank];
+}
+
+say qq[\nRank to perm];
+
+@tests = ([2, 2], [3, 3], [7, 37564], [14, 693492952393], [14, 0]);
+
+for $test (@tests) {
+	($max, $rank) = @$test;
+	$perm = rank2permutation($max, $rank);
+	say qq[terms: $max, rank: $rank => perm: $perm]; 
+}
+	
+
+sub permutation2rank {
+	
+	my (@p, $n, @fac, @ranks, $i, $rank, $this_rank, $k, $j, $digit, @seen);
+		
+	# input permutation and count no of elements
+	@p = @_;
+	$n = scalar @p;
+	
+	# calculate factorials up to $n - 1 and initialise @ranks
+	# see blog for definition of @ranks
+	$fac[0] = 1;
+	$ranks[0] = 0;
+	for $i (1 .. $n) {
+		$k = $p[$i - 1];
+		$fac[$i] = $fac[$i - 1] * $i;
+		$ranks[$i] = $i;
+		
+		# check valid perm with 1 occurrence of 0 .. $n - 1
+		return 'invalid permutation' if ($k < 0 or $k >= $n or $seen[$k]);
+		$seen[$k] = 1;
+	}
+	
+	# loop over the components of the permutation and calculate how each contributes to the rank
+	$rank = 0;
+	for $i (0 .. $n - 1) {
+		
+		# $ranks[$digit] is the contribution to the ranking of this digit given that 
+		# some digits have already been seen and can't be in this ranking position
+		$digit = $p[$i];
+		
+		# so this digit is in $ranks[$digit] block and the block occupies [$n - 1 - $i]! rows
+		$this_rank = $ranks[$digit];
+		$rank += $this_rank * $fac[$n - 1 - $i];
+
+		# now we mark this digit as having been seen, so can't occur in subsequent positions
+		$ranks[$digit] = -1;
+		
+		# and re-jig @ranks ready for the next digit (see blog)
+		$k = 0;
+		for $j (0 .. $n - 1) {
+			next if $ranks[$j] < 0;
+			$ranks[$j] = $k;
+			$k ++;
+		}		
+	}
+	return $rank;
+}
+
+sub rank2permutation {
+	
+	my ($n, $rank, @fac, @ranks, @rranks, $k, $perm, $i, $j);
+	
+	($n, $rank) = @_;
+	$n ++;
+	
+	# calculate factorials up to $n - 1 and initialise @ranks
+	$fac[0] = 1;
+	$ranks[0] = 0;
+	for $i (1 .. $n - 1) {
+		$fac[$i] = $fac[$i - 1] * $i;
+		$ranks[$i] = $i;
+	}
+	
+	# loop over the components of the permutation and calculate how each contributes to the rank
+	$perm = '';
+	for $i (0 .. $n - 1) {
+		
+		# calc $j = no of blocks, and subtract those from $rank
+		$j = int($rank / $fac[$n - 1 - $i]);
+		$rank -= $j * $fac[$n - 1 - $i];
+		$perm .= qq[$ranks[$j], ];
+		$ranks[$j] = -1;
+		
+		# and re-jig @ranks ready for the next digit
+		$k = 0;
+		for $j (0 .. $n - 1) {
+			next if $ranks[$j] < 0;
+			$ranks[$k] = $ranks[$j];
+			$k ++;
+		}	
+	}
+	return substr($perm, 0, -2);
+}