Merge pull request #6465 from wlmb/challenges

Solve PWC174

3 files changed, 58 insertions, 0 deletions

diff --git a/challenge-174/wlmb/blog.txt b/challenge-174/wlmb/blog.txt
new file mode 100644
index 0000000000..9708cd8598
--- /dev/null
+++ b/challenge-174/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/07/18/PWC174/
diff --git a/challenge-174/wlmb/perl/ch-1.pl b/challenge-174/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..dc84347487
--- /dev/null
+++ b/challenge-174/wlmb/perl/ch-1.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 174
+# Task 1: Disarium numbers
+#
+# See https://wlmb.github.io/2022/07/18/PWC174/#task-1-disarium-numbers
+use v5.12;
+use PDL;
+say("Usage: $0 N\nto obtain the first N Disarium numbers"), exit unless @ARGV;
+my $how_many=shift;
+die "Expected a positive number" unless $how_many>0;
+my ($counter, $test)=(0, 0);
+while($counter<$how_many){
+    my $exponents=(my $digits=long [split "", $test])->sequence+1;
+    ++$counter, say "$counter: $test"
+        if ($digits**$exponents)->sumover==$test;
+    ++$test
+}
diff --git a/challenge-174/wlmb/perl/ch-2.pl b/challenge-174/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..f77a7006ab
--- /dev/null
+++ b/challenge-174/wlmb/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 174
+# Task 2: Permutation ranking
+#
+# See https://wlmb.github.io/2022/07/18/PWC174/#task-2-permutation-ranking
+use v5.36;
+use PDL;
+use PDL::NiceSlice;
+my $usage=<<"END";
+Usage: $0 "P1 P2...Pn" R1 R2...
+to obtain rank of permutation P1 P2...Pn
+and the rank-Ri permutations. Note quotations.
+END
+say($usage), exit unless @ARGV>0;
+my $permutation=long "[".shift."]";
+my $size=$permutation->nelem;
+die "Elements should be distinct" unless $permutation->uniq->nelem==$size;
+my @ordered=$permutation->qsort->list;
+my %element2index = map { ($ordered[$_], $_) } (0..$size-1);
+my $permuted_indices=long [@element2index{$permutation->list}];
+my $factorials=factorials($size);
+say "permutation2rank($permutation)=", permutation2rank($permuted_indices);
+say "rank2permutation($permutation, $_)=", rank2permutation($_) for(@ARGV);
+
+sub permutation2rank($permutation){ # ranks a permutation of 0...N-1
+    return $factorials->inner(ranks($permutation));
+}
+sub ranks($permutation){
+    my $cmp=$permutation(*1)>$permutation; #P_i>P_j
+    $cmp->inner($cmp->xvals>=$cmp->yvals); #r_i=sum_{j>=i}(P_i>P_j)
+}
+sub factorials($size){
+     my $f=1;
+     (long [1, map {$f=$_*$f} (1..$size-1)])->(-1:0);
+}
+sub rank2permutation($rank){
+    my @indices=map {my $index=floor($rank/$_); $rank%=$_; $index} $factorials->list;
+    my @copy=@ordered;
+    long [ map {splice @copy, $_, 1} @indices];
+}