( …continues from previous week. )
Welcome to the Perl review pages for Week 174 of The Weekly Challenge! Here we will take the time to discuss the submissions offered up by the team, factor out some common methodologies that came up in those solutions, and highlight some of the unique approaches and unusual code created.
●︎ Why do we do these challenges?
I suppose any reasonable answer to that question would come from a field as wide ranging and varied as the people who choose to join the team. One thing, though, is clear: it’s not a competition, and there are no judges, even if there is a “prize” of sorts. About that – I think of it more as an honorarium periodically awarded to acknowledge the efforts we make towards this strange goal. So there’s no determination to find the fastest, or the shortest, or even, in some abstract way, the best way to go about things, although I’m certain the participants have their own aspirations and personal drives. As Perl is such a wonderfully expressive language, this provides quite a bit of fodder to the core idea of TMTOWTDI, producing a gamut of varied techniques and solutions.
Even the tasks themselves are often open to a certain amount of discretionary interpretation. What we end up with is a situation where each participant is producing something in the manner they personally find the most interesting and satisfying. Some team members will focus on carefully crafted complete applications, thoroughly vetting input data and handling every use case they can think up. Others choose to apply themselves to the logic of the underlying puzzle and making it work in the most elegant way they can. Some eschew modules they would ordinarily reach for, others embrace them, bringing to light wheels perhaps invented years ago that happen to exactly solve the problem in front of them today.
I’ve been considering this question for some time and have found one binding commonality between all of us out solving these challenges each week, in that however we normally live our lives, the task in front of us more than likely has nothing to do with any of that. And I think this has great value. We all do what we do, in the real world, and hopefully we do it well. The Weekly Challenge provides us with an opportunity to do something germane to that life yet distinctly different; if we only do the things we already know how to do then we will only do the same things over and over. This is where the “challenge” aspect comes into play.
So we can consider The Weekly Challenge as providing a problem space outside of our comfort zone, as far out from that comfort as we wish to take things. From those reaches we can gather and learn things, pick and choose and bring what we want back into our lives. Personally, I think that’s what this whole thing is about. YMMV.
And that, my friends, is why I’m here: to try and figure out ways to do just that.
So that’s that… I’m ready now — let’s go in and see what we can find.
For Added Context
Before we begin, you may wish to revisit either the pages for the original tasks or the summary recap of the challenge. But don’t worry about it, the challenge text will be repeated and presented as we progress from task to task.
Oh, and one more thing before we finally get started:
Getting in Touch with Us
Email › Please feel free to email me (Colin) with any feedback, notes, clarifications or whatnot about this review.
GitHub › Submit a pull request to us for any issues you may find with this page.
Twitter › Join the discussion on Twitter!
I’m always curious as to what the people think of these efforts. Everyone here at the PWC would like to hear any feedback you’d like to give.
Enough? Fine. So without even further ado…
• Task 1 • Task 2 • BLOGS •
TASK 1
Disarium Numbers
Submitted by: Mohammad S Anwar
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.
For example,
518 is a disarium number
as (5 ** 1) + (1 ** 2) + (8 ** 3) => 5 + 1 + 512 => 518
about the solutions
Adam Russell, Athanasius, Cheok-Yin Fung, Colin Crain, Dario Mazzeo, Duncan C. White, E. Choroba, Flavio Poletti, Gurunandan Bhat, Jaldhar H. Vyas, James Smith, Jorg Sommrey, Kjetil Skotheim, Laurent Rosenfeld, Lubos Kolouch, Matthew Neleigh, Mohammad S Anwar, Nicolas Mendoza, Peter Campbell Smith, PokGoPun, Robert DiCicco, Roger Bell_West, Simon Green, Stephen G Lynn, Steven Wilson, Ulrich Rieke, and W. Luis Mochan
Let me begin with the statement that I, for one, would like very much to know what a ““disarium” is. Is this some person? If so I would wish to have some words. A place? Perhaps a medieval latinate city or the made-up capital of some far-off fantastic land?
I was able to find one solitary reference in the Russian chemical literature to a disarium trisulfate from 1955, but further investigation and Occam’s razor leads us to conclude a typographical error of some sort has occurred — one that has somehow substituted an “s” for a “b”. Perhaps the Cyrillic б broke its lower loop. We will likely never know.
We are not, to my knowledge, looking for di-barium, mono-barium, or for that matter any of the more complex barium compounds. The word remains a bothersome enigma to me, and bothersome because it robs this challenge of any possible explanatory context that might be gleaned from the knowledge. And any explanation of why someone decided these numbers were interesting escapes me. The mathematical relationship between digits in a positional numbering system and the value they express is rigorously defined, and although I find the operation of digit-summing in number theory a bit less-than illuminating I can see the value of exporing the unknown and its connection to base-10 arithmetic.
On the other hand what we have here is labeling the positions starting at 1 from the right-most digit, which is not nearly so rigorously defined, making a fundamental shift in value with each order of magnitude. Adding on top of this the operation of raising the digit to its positional power and the results are just a jumble of ideas. So after the fact I am overwhelmingly left with the question — “Why?".
The numbers do warrant a listing in the Online Encyclopedia of Integer Sequences, however the term “disarium” is nowhere to be found. However there is a clue, in the form of a link to a Wolfram MathWorld article on narcissistic numbers. Someone seems to have decided to group them together, and I am of the same mind.
Narcissistic numbers also raise their digits to a power and sum them, with the power derived from the total number of digits in the number. This comes off as similarly arbitrary, relating to the exponential process behind the Disarium numbers.
The mathematician D.H. Hardy writes of some narcissistic numbers:
These are odd… very suitable for puzzle columns and likely to amuse amateurs, but there is nothing in them which appeals to the mathematician.
The narcissistic numbers, it seems, are more interesting to themselves than to the people who make it their job to look at numbers, which is telling.
There were 27 submissions for the first task this past week.
A SELECTION of SUBMISSIONS
Duncan C. White, Mohammad S Anwar, Colin Crain, Simon Green, Nicolas Mendoza, Jaldhar H. Vyas, Matthew Neleigh, Laurent Rosenfeld, Peter Campbell Smith, Athanasius, and Roger Bell_West
There were two basic forms we saw to access the individual digits of a candidate number: splitting the string into an array of characters and adressing them by index, or by examining the string positions directly using substr. Ok, sure, and a third: using division. But we’ll get to that.
Ultimately the solutions were quite self-similar: get the digits, do the thing to the digits, check the value against the starting value, and then move on to the next candidate. But within this framework there were quite a few smaller variations, well enough to look at some different ways of going about the steps.
additional languages: C
Duncan will start us off with his disarium() function. Here he divides the number into an array of digits, and then iterates across them exponentiating and summing as we go. If the final tally of the sum equals the original number then we have found success and the meaning of life.
To find the first 19 numbers in the sequence he places his function in a loop testing increasing values. Why 19 you might ask? This is not explained but a quick look at the OEIS reveals the 20th value is 12,157,692,622,039,623,539. So that’s likely to take a while to find.
sub disarium
{
my( $x ) = @_;
my @dig = split( //, $x );
my $sum = 0;
for( my $pos=0; $pos < @dig; $pos++ )
{
$sum += $dig[$pos] ** ($pos+1);
}
say "debug: dis($x): sum=$sum" if $debug;
return $sum == $x ? 1 : 0;
}
additional languages: Python, Raku, Swift
Mohammad takes the same process and manages to break it down an simplify it further, resulting in a quite compact solution.
sub is_disarium_number($n) {
my @n = split //,$n;
my $s = 0;
$s += $n[$_] ** ($_ + 1) for (0 .. @n-1);
return ($s == $n);
}
Continuing the motif, I took it even further into a single line of logic.
I’ve also used substr, which obviates the need to create an array of digits. Internally, a Perl scalar can contain both a numeric value and as string value, which are for all practical purposes continually kept in sync. The string value, though, is itself held in a C-string, which is an array already. So really the string segmentation step can be viewed as redundant. It can be a quite useful abstraction, surely, but it isn’t strictly speaking necessary. The built-in Perl function substr is very fast.
I’m of two minds about declaring internal variables in a subroutine signature, getting around the warning about the number of parameters using a default value. On the one hand it cleanly predeclares everything that is going to be used within the block before we begin, which is very conceptually clean, but on the other seems like a hack when you need to trick the compiler into agreeing with you.
I think it may be fine for small functions such as these, as long as everything can be predeclared. As soon as you need to use my, or our, or state within the routine, though, you’ve gone and mixed your metaphors. Which of course has quite a bit of potential for comedic effect, but contextual confusion when coding should never be looked at as a goal amongst upstanding professionals.
And as for the others, well, you know who you are.
sub disarium ($num, $sum = 0) {
$sum += (substr $num, $_-1, 1) ** $_ for (1..length $num);
$sum;
}
additional languages: Python
blog writeup: Weekly Challenge 174
The reasoning behind this compact form is that the position count and the exponent are linked to a common value. Simon makes this a little clearer by giving the iteration variable a proper name, $count.
foreach my $count ( 1 .. length($n) ) {
$sum += substr( $n, $count - 1, 1 )**$count;
}
Stepping back and taking this in a different direction, member Nicolas firmly ascribes to the adage of one action per line, systematically looping through candidate numbers, splitting them and raising the digits to increasing powers, annotating as he goes. Clarity is action is a good thing.
Compactness is a virtue, but so is explaining what you are doing, should anyone ever need to revisit the logic.
for my $number (0..$limit) { # iterate thru all numbers
my $sum = 0; # store a temp sum
my @n = split //, $number; #
for (my $i = @n; $i > 0; $i--) { # iterate thru every digit
my $c = $n[$i-1]; # pick out digit
my $s = $c**$i;
$sum += $s;
if ($sum > $number) { # go to next number if sum has become bigger already
last;
}
}
if ($sum == $number) { # Add to found array if it's a Disarium number
push @found, $sum;
if (@found == 19) { # bail out when we found 19
say "@found";
exit;
}
}
}
additional languages: Raku
blog writeup: Perl Weekly Challenge: Week 174
I like how Jaldhar avoids the bookkeeping of a iterator variable entirely with a very Perlish technique — by calling each on his array of digits. On an array, this returns two values, the index position and the value at that position.
Now I wish I’d thought of that.
sub isDisarium {
my ($n) = @_;
my @digits = split //, $n;
my $total = 0;
while (my ($pos, $digit) = each @digits) {
$total += $digit ** ($pos + 1);
}
return $total == $n;
}
Matthew provides another substr solution for us to have a look at. As I’ve said before, for some reason I always assumed substr was slow. It’s not. Not at all.
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
);
}
additional languages: Awk, Bc, C, D, Dart, Dc, Go, Javascript, Julia, Kotlin, Nim, Python, Raku, Ring, Ruby, Rust, Scala, Tcl
blog writeup: Perl Weekly Challenge 174: Disarium Numbers and Permutation Rankings
Laurent constructs his logic using map to provide listwise processing of the digits, creating an anonymous intermediate list of increasing powers that are then summed using a for loop.
sub is_disarium {
my $num = shift;
my @digits = split '', $num;
my $i = 1;
my $sum = 0;
$sum += $_ for map { $_ ** $i++ } @digits;
return $num == $sum;
}
blog writeup: Disarium disaster and rank permutations
Peter throws in a short-circuit on the aggregate sum to bail out should the value get too large. There’s no point in continuing if we’re already greater than the original number.
# 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;
additional languages: Raku
The monk also incorporates this short-circuiting check, with the added twist of performing the power functions in reverse, from high to low. This way any overruns in the sum will be noticed quicker. Every little bit helps, you know? Unless, you know, it doesn’t.
They note they did try a lookup table for the exponentiation but it had negligible effect, so we just use the operator inline.
sub is_disarium
{
my ($n) = @_;
my @digits = split //, $n;
my $sum = 0;
for my $i (reverse 0 .. $#digits) # reverse() here saves ~1 second
{
$sum += $digits[ $i ] ** ($i + 1);
return 0 if $sum > $n;
}
return $sum == $n;
}
additional languages: Javascript, Kotlin, Postscript, Python, Raku, Ruby, Rust
blog writeup: RogerBW’s Blog: The Weekly Challenge 174: The Rank Smell of Disarium
Finally we have Roger. That lookup table of powers of values the monk was just referring to? Well Roger has gone and done it! I’ve been quietly trying to warn you folks, but to no avail. He may, I’m afraid, be veering wildly out of control. We will have to keep an eye.
There are a couple of interesting variations going on here as well, beyond the aforementioned lookup table. For instance, he dissects his numbers mathematically, using division, instead of string-wise. Oh, and that multi-dimensional table of digits raised to powers is auto-expanded when necessary, which is, to use a technical term, neat.
I will say though, that I’m with the monk in that the lookup code is probably more expensive than the savings. But seriously, who cares? Good stuff.
sub disarium($ct) {
my @o;
my @pows=([(1) x 10]);
my $c = 0;
while (1) {
my $disar = 0;
if ($c > 0) {
my $ca = $c;
my @cl;
my $tx = 0;
while ($ca > 0) {
$tx++;
push @cl,$ca % 10;
$ca = int($ca/10);
}
@cl = reverse @cl;
if ($tx >= scalar @pows) {
foreach my $power ((scalar @pows)..$tx) {
my @row;
foreach my $digit (0..9) {
push @row,$pows[$power-1][$digit] * $digit
}
push @pows,\@row;
}
}
foreach my $i (0..$#cl) {
$disar += $pows[$i+1][$cl[$i]];
}
}
if ($disar == $c) {
push @o,$c;
if (scalar @o >= $ct) {
last;
}
}
$c++;
}
return \@o;
}
Blogs and Additional Submissions in Guest Languages for Task 1:
additional languages: Prolog
blog writeup: Permutations Ranked in Disarray on Mars — Perl — RabbitFarm
blog writeup: Permutations Ranked in Disarray on Mars — Prolog — RabbitFarm
additional languages: Node
additional languages: Raku
blog writeup: PWC174 - Disarium Numbers - ETOOBUSY
blog writeup: Perl Weekly Challenge #174
additional languages: Dart, Go
additional languages: Julia, Raku
additional languages: Julia, Raku
blog writeup: PWC #174
additional languages: C++, Haskell, Raku
blog writeup: Perl Weekly Challenge 174 – W. Luis Mochán
TASK 2
Permutation Ranking
Submitted by: Mohammad S Anwar
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.
about the solutions
Adam Russell, Cheok-Yin Fung, Duncan C. White, E. Choroba, Flavio Poletti, Gurunandan Bhat, Jaldhar H. Vyas, James Smith, Jorg Sommrey, Kjetil Skotheim, Lubos Kolouch, Matthew Neleigh, Mohammad S Anwar, Peter Campbell Smith, Philippe Bricout, PokGoPun, Roger Bell_West, Stephen G Lynn, Ulrich Rieke, and W. Luis Mochan
When permutations are studied, they are usually referred to indirectly, substituting normalized data in for the position values; commonly an ordered list of numbers starting from either 1 or 0: {0,1,2,3,4,5}
This helps us to remember that we are permuting the positions within the list, or ordered set, and not the values. Of course in practice the values move with the positions, but mathematically this is just uninformative and confusing. And believe me, there is more than enough confusion with this challenge, and we don’t need more. So some submissions eschewed an arbitrary list of unique integers, solving instead for this normalized form. Converting into and out of a normalized form is interesting in itself, but seems a little unrelated to the essential mathematics behind the scenes. If people didn’t preform this step I decided I didn’t care.
Not every permutation algorithm is lexicographically consistent in its processing, but many are, such as Knuth’s Algorithm L. As this is quite efficient, most combinatorics packages provide a permutation function that preserves order this way. We’ll explore lexicographic ordering a bit more below.
There were 20 submissions for the second task this past week.
A SELECTION of SUBMISSIONS
Lubos Kolouch, E. Choroba, Jorg Sommrey, W. Luis Mochan, Gurunandan Bhat, Flavio Poletti, Ulrich Rieke, Stephen G Lynn, and Adam Russell
There were two ways (mostly) we saw in accomplishing the goal: the easy way, counting permutations, or the hard way, using some… complicated and strange math. We’ll look at both.
Oh, and Jorg. We’ll look at what he’s brought us too, which is kind of its own category offshoot from the mind-numbing math, but also right in the middle of it. Curious? Well so am I.
Still.
Lubos will serve as a fine start to our examination, as he nicely lays out a systematic approach to an exhaustive process.
Computers, you see, are very good at counting things. And so in this solution we calculate all the permutations in a lexicographically-sorted fashion, then start counting down the list looking for a match. When one is found, the rank is noted. To reverse the operation, we sort and construct the permutation list again, and proceed to the n-th element.
The experimental smartmatch operator, ~~, is used to make the match. Haven’t seen that one in a while.
Noted.
The number of premutations to be be calculated rises factorially, so things get out-of-hand quickly. But assuming we have the capability to produce and store the list, this solution will eventually find the rank, or, from the rank, the permutation it references.
use Algorithm::Combinatorics qw(permutations);
sub permutation2rank {
my ( $list, $what ) = @_;
my @all_permutations = permutations($list);
my $pos = 0;
for my $comb (@all_permutations) {
return $pos if $comb ~~ @$what;
$pos++;
}
return -1;
}
sub rank2permutation {
my ( $list, $what ) = @_;
my @all_permutations = permutations($list);
return $all_permutations[$what];
}
As I said, the number of permutations grows factorially. This is easiest to visualize in a descending manner: given permutations of 4 positions, for the first placement we have 4 values that can occupy that spot. For the second postion though, we only have 3 remaining values as one has already been used. At the next position we only have 2 values to choose from, and finally for the last place there is only one value and that placement is determined. Hence for total count of permutations we get 4 x 3 x 2 x 1 = 24, or 4!
So far so good. In a sequence of lexicographically ordered permutations, though, the rearrangements will proceed in a fixed, rigorously defined procession. In fact, the number of steps required to affect a given digit position is again determined by the factorial. We can capitalize on this and create a factorial numbering system to rapidly access an individual value in a permutation. The permutation list can be viewed as a number line, and the permutations themselves as values along that line. So to count permutations, we can use our factorial numbering system. And the way to do that is the same as any other base conversion: dividing our factorials out or multiplying them back in. The values at the positions of a permutation, numbered from 0, is the digit and the placement in the permutation the position. Sort of. The odd thing is that the zero-state of the permutation has the digits 012345… so we need to account for that.
Multiply the value by the factorial of the position — counting from 0 — to get a decimal component for that position. Recursively perform this for all positions and sum the results to get the ranking.
Reverse and repeat, using Euclidean division this time, to go the other way.
And yes, for the skeptical, it works. Choroba creates two recursive routines to handle arbitrary numbers of digits for the conversions. He also only works on permutations of (0,1,2,3,4…) to keep the process clearer, which I think is a good call on his part. Now you can more plainly see the relationship to normal base conversion.
sub factorial ($n) {
my $f = 1;
$f *= $_ for 2 .. $n;
return $f
}
sub permutation2rank ($arr) {
my $step = factorial(@$arr - 1);
my %position;
@position{sort @$arr} = 0 .. $#$arr;
my $rank = $step * $position{ $arr->[0] };
$rank += permutation2rank([@$arr[1 .. $#$arr]])
if @$arr > 1;
return $rank
}
sub rank2permutation($arr, $index) {
my @sorted = sort @$arr;
return _rank2permutation(\@sorted, $index)
}
sub _rank2permutation ($arr, $index) {
return $arr if 1 == @$arr;
my $step = factorial(@$arr - 1);
my $i = int($index / $step);
my @permutation = (
$arr->[$i],
@{ _rank2permutation([@$arr[grep $_ != $i, 0 .. $#$arr]],
$index % $step) });
return \@permutation
}
To handle a more general case Jorg builds a translation table between the sorted input values and the indices they fall at. Then he does something completely different.
I believe this weird tie-in to a factorial-based number system is why this particular task has the notoriety it has. I don’t think there is a tremendous call for finding particular permutations out in the real world, and certainly not enough to warrant the inclusion of a pair of functions into the venerable number theory module Math::Prime::Util. But here we are, and there they are. I conject that the real reasoning behind their inclusion is that this is perhaps the only legitimate, practical application of converting back and forth from a factorial number system and we needed to call them something.
And functions for factorial-base numbering totally belong in a number theory module. They’re called permtonum and numtoperm().
In any case that’s how Jorg solves the task. Good comments, too.
use Math::Prime::Util qw(permtonum numtoperm);
use experimental qw(signatures postderef);
# The task states: "You are given a list of integers with no
# duplicates."
# This is clearly different from a permutation of the numbers from 0 to
# N. Thus the list *as is* must not be interpreted as a permutation.
# Take the given list as a permutation of sortable "items" (here:
# integers). Build a map from each item to its position in the sorted
# list and transform the list of items into a list of the corresponding
# indices. The resulting list represents a valid permutation having a
# rank as provided by "permtonum".
sub perm2rank ($n) {
(\my %s)->@{sort {$a <=> $b} @$n} = (0 .. $#$n);
permtonum([@s{@$n}]);
}
# For the reverse operation the order of the given items is irrelevant
# as rank k=0 always represents the ordered list and all other ranks are
# derived from this starting point. Find the permutation
# corresponding to rank k and use it as array indices in the sorted
# list.
sub rank2perm ($k, $n) {
[(sort {$a <=> $b} @$n)[numtoperm(@$n, $k)]];
}
blog writeup: Perl Weekly Challenge 174 – W. Luis Mochán
Can we keep getting weirder? Sure we can. We can bring in the Perl Data Language to hold our permutations in vectors. Actually this makes quite a bit of sense, because the positions can be lined up with a parallel vector filled with factorials. This is done in his factorials method.
To translate from permutations to ranks, Luis uses a variation on the same algorithm Chorba introduced earlier.
use PDL;
use PDL::NiceSlice;
my $permutation=long "[".shift."]";
my $size=$permutation->nelem;
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];
}
I would not be terribly surprised if, having gotten this far, someone not already familiar with the algorithm was still confused by the conversion between a ranking and the permutation found at that rank. Leading with terms like “factorial numbering system” may not have been the best choice but I’m not going to go back and start over.
Fortuantely for me, Gurunandan has provided an exceptionally well-laid-out solution we can use to display the method behind the transformation. He provides four functions: perm2rank(), rand2perm(), and two helper functions _rank() and factorials().
factorials() provides a list of n factorials, from low to high.
_rank() is the ranking of a digit at its position. This is not just the vslue of the digit found there, but rather is complicated by the fact that the base value for the position does not start at 0, as say in a decimal expansion. Instead the base values are of the form (012345…). So what we are looking for here is the amount a given position value is above its base value, which is then used as a multiplier for a selected factorial. The factorial used here is a stand-in for the basepower term in a normal positional expansion.
When translating a ranking to a particular permutation, it’s easier to see the relationship between the factorial values used here and a standard positional expansion.
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;
}
Some clevernaess is involved as the quotient of the Euclidean division designates the position of the digit to be used in the base permutation: (12345…)
Once a value is used it is removed from the pool of possibilities.
additional languages: Raku
blog writeup: PWC174 - Permutation Ranking
blog writeup: PWC174 - Permutation Ranking — Raku
Flavio has brought us a porting of the algorithm presented on the referenced page, which seemed to be a common strategy to obtain a solution. The underlying mathematics, as you may have noticed, are a bit weird. Don’t get me wrong: Awesome, but weird.
use List::Util qw< reduce sum >;
say permutation2rank([qw< a b c d >]);
say permutation2rank([qw< 111 22 3 >]);
say join ' ', rank2permutation([qw< 0 1 2 >], 1)->@*;
sub permutation2rank ($permutation) {
my $n = $permutation->@*;
my @baseline = sort { $a cmp $b } $permutation->@*;
my $factor = reduce { $a * $b } 1 .. $n;
return sum map {
my $target = $permutation->[$_];
my $index = 0;
++$index while $baseline[$index] ne $target;
splice @baseline, $index, 1;
my $term = ($factor /= $n - $_) * $index;
} 0 .. $n - 2;
}
sub rank2permutation ($baseline, $r) {
my $n = $baseline->@*;
my $factor = reduce { $a * $b } 1 .. $n - 1;
return [
map {
my $index = int($r / $factor);
$r %= $factor;
$factor /= ($n - 1 - $_) if $factor > 1;
splice $baseline->@*, $index, 1;
} 0 .. $n - 1
];
}
He does make a comment on the designated lexicographical sorting, though, and others have brought tihis up as well. The problem I’m seeming is with the definition of the term, or rather the definition with respect ot numbers. In lexicographical sorting of strings, “app” falls before “apple” and both come before “be”. However in numbers we most definitly do not want to arrive at a the ordering (123,12345,23). So we don’t do that. On one side of the decimal point we use straight numeric ordering, and on the other a dictionary sort and everything works out right: 1.23, 1.2345, 2.3. This is a hack, but gets us the results we require, providing we have a decimal point. And this hand-waving skips over what we mean by bringing in numeric ordering.
In combinatorics, which permutations are obviously a part of, there are no decimal points to be seen and another varaint is employed. In this interpretation shorter strings are always placed before larger. So now we get (23, 123, 12345) and the numbers are properly ordered. This version of lexicoraphic ordering is commonly known as shortlex.
As integers are prescribed, I’m going to consider the terms numeric and lexicographic ordering interchangable, because we are working with permutations. I find the requirement, on close inspection, unnecessarily unclear. Lexicographic ordering is well-defined, but also practically, so if we make well-defined changes to the rules to accommodate numbers we what we must to make the mathematics work right. That’s the only important part. We are told the numbers are integers and any talk of sting sorting is a red herring.
CY brings us another porting of the O(n2) solution from the referenced article. There are two algorithms on the page and all mathematical submissions used one or the other.
use List::Util qw/first/;
sub factorial {
my $ans = 1;
for (1..$_[0]) {
$ans *= $_;
}
return $ans;
}
sub permutation2rank {
my @list = $_[0]->@*;
my $n = scalar @list;
my $fact = factorial($n-1);
my $r = 0;
my @unused_list = sort {$a<=>$b} @list;
for my $i (0..$n-2) {
my $q = first { $unused_list[$_] == $list[$i] } 0..$#unused_list;
$r += $q*$fact;
splice @unused_list, $q, 1;
$fact = int $fact / ($n-$i-1);
}
return $r;
}
sub rank2permutation {
my @list = $_[0]->@*;
my $r = $_[1];
my $n = scalar @list;
my $fact = factorial($n-1);
my @unused_list = sort {$a<=>$b} @list;
my @p = ();
for my $i (0..$n-1) {
my $q = int $r / $fact;
$r %= $fact;
push @p, $unused_list[$q];
splice @unused_list, $q, 1;
$fact = int $fact / ($n-1-$i) if $i != $n-1;
}
return [@p];
}
additional languages: C++, Haskell
Let’s get away from this mathematical messiness for a moment into more-easily comprehensible realms. Ulrich returns us to counting actual permutations made using Algorithm::Combinatorics. A fine choice that completely avoids thinking about factorially-based numbering systems built from descending positions. Which, weirdly enough somehow relates back to the reverse position labeling in the Disarium numbers, now that I think about it.
Not really, as here it’s a side-effect to be compensated for and over there its a feature.
Whatever.
My brain hurts a bit, and this is soothing.
sub arrayToString {
my $array = shift ;
my @numbers = @$array ;
return reduce { $a . $b } @numbers ;
}
sub permutation2rank {
my $array = shift ;
my @numbers = @$array ;
my @permutations = permutations( \@numbers ) ;
my @strings = map { arrayToString( $_ ) } @permutations ;
my @sorted = sort { $a cmp $b } @strings ;
my $str = arrayToString( \@numbers ) ;
my $i = 0 ;
while ( $sorted[ $i ] ne $str ) {
$i++ ;
}
return $i ;
}
additional languages: Julia, Raku
blog writeup: PWC #174
One of the biggest obstacles in a brute-force attack on the problem, counting permutations until we find the right one, is identifying equality in an array. A deep examinination of comparable elements is what is the only way to create a test that is generalizable to all cases, but looping through indexes sounds terribly tedious and computationally intensive.
Stringifying the data brings its own problems with it, which although hardly insurmountable both add computational overhead and require a carefully chosen delimiter. Thinking it through reveals other questions outstanding that must be decided on as well.
Stephen addresses the issue by inviting Array::Compare to the party. This handy package provides an assortment of options in stringification, such as selection of a separator character, ignoring whitespace, or flattening case comparisons.
use List::Permutor;
use Array::Compare;
print &permutation2rank([1,0,2]),"\n"; # 2
print &rank2permutation([0,1,2],1),"\n"; # 021
sub permutation2rank {
my ($rarry) = @_;
my $comp = Array::Compare -> new;
my $ctr=0;
my $p = new List::Permutor (sort @$rarry);
while (my @set = $p->next) {
last if $comp->compare($rarry,\@set);
$ctr++;
}
return $ctr;
}
sub rank2permutation {
my ($rarry, $rank) = @_; my $ctr=0;
my $p = new List::Permutor (sort @$rarry);
my @set=();
while (@set = $p->next) {
last if $ctr==$rank;
$ctr++;
}
return @set;
}
blog writeup: Permutations Ranked in Disarray on Mars — Perl — RabbitFarm
blog writeup: Permutations Ranked in Disarray on Mars — Prolog — RabbitFarm
Finally, Adam has been playing with the new lightwieght Mars::Class object framework and has some results for us. I’m going to assume it works. The creator of the framework makes a reasonable case for going through the effort even with the existence of all of the Moose/Moo/Mouse varients already in place. Considering a core Perl object model has yet to be settled, I welcome the research. The options available each have their strong points and blindspots.
package PermutationRanking{
use Mars::Class;
use List::Permutor;
attr q/list/;
attr q/permutations/;
attr q/permutations_sorted/;
attr q/permutations_ranked/;
sub BUILD{
my $self = shift;
my @permutations;
my %permutations_ranked;
my $permutor = new List::Permutor(@{$self->list()});
while(my @set = $permutor->next()) {
push @permutations, join(":", @set);
}
my @permutations_sorted = sort @permutations;
my $rank = 0;
for my $p (@permutations_sorted){
$permutations_ranked{$p} = $rank;
$rank++;
}
@permutations_sorted = map {[split(/:/, $_)]} @permutations_sorted;
$self->permutations_sorted(\@permutations_sorted);
$self->permutations_ranked(\%permutations_ranked);
}
sub permutation2rank{
my($self, $list) = @_;
return $self->permutations_ranked()->{join(":", @{$list})};
}
sub rank2permutation{
my($self, $n) = @_;
return "[" . join(", ", @{$self->permutations_sorted()->[$n]}) . "]";
}
}
package main{
my $ranker = new PermutationRanking(list => [0, 1, 2]);
print "[1, 0, 2] has rank " . $ranker->permutation2rank([1, 0, 2]) . "\n";
print "[" . join(", ", @{$ranker->list()}) . "]" . " has permutation at rank 1 --> " . $ranker->rank2permutation(1) . "\n";
}
Blogs and Additional Submissions in Guest Languages for Task 2:
additional languages: Raku
blog writeup: Perl Weekly Challenge: Week 174
blog writeup: Perl Weekly Challenge #174
additional languages: Python, Raku, Swift
blog writeup: Disarium disaster and rank permutations
additional languages: Dart, Go
additional languages: Javascript, Kotlin, Postscript, Python, Raku, Ruby, Rust
blog writeup: RogerBW’s Blog: The Weekly Challenge 174: The Rank Smell of Disarium
_________ THE BLOG PAGES _________
That’s it for me this week, people! Warped by the rain, driven by the snow, resolute and unbroken by the torrential influx, by some miracle I somehow continue to maintain my bearings.
Looking forward to next wave, the perfect wave, I am: your humble servant.
But if Your Unquenchable THIRST for KNOWLEDGE is not SLAKED,
then RUN (dont walk!) to the WATERING HOLE
and FOLLOW these BLOG LINKS:
( …don’t think, trust your training, you’re in the zone, just do it … )
Adam Russell
- Permutations Ranked in Disarray on Mars — Perl — RabbitFarm ( Perl )
- Permutations Ranked in Disarray on Mars — Prolog — RabbitFarm ( Prolog )
Arne Sommer
Flavio Poletti
- PWC174 - Disarium Numbers - ETOOBUSY ( Perl & Raku )
- PWC174 - Permutation Ranking ( Perl )
- PWC174 - Permutation Ranking — Raku ( Raku )
Jaldhar H. Vyas
- Perl Weekly Challenge: Week 174 ( Perl & Raku )
James Smith
- Perl Weekly Challenge #174 ( Perl )
Laurent Rosenfeld
Luca Ferrari
- Perl Weekly Challenge 174: the power of permutations – Luca Ferrari – Open Source advocate, human being ( Raku )
- Perl Weekly Challenge 174: the power of permutations – Luca Ferrari – Open Source advocate, human being ( PL/Perl )
- Perl Weekly Challenge 174: the power of permutations – Luca Ferrari – Open Source advocate, human being ( PL/PostgreSQL )
Peter Campbell Smith
Roger Bell_West
Simon Green
- Weekly Challenge 174 ( Perl )
Stephen G Lynn
- PWC #174 ( Perl & Raku )
W. Luis Mochan