Perl Weekly Challenge: Week 174
Challenge 1:
Disarium Numbers
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
Many of the recent challenges have involved calculating sequences of numbers so I've settled on a standard way of dealing with them.
my @disariums;
my $n = 1;
First we define a list to hold our results. Another variable, $n will count up integers starting from 0.
while @disariums.elems < 19 {
if isDisarium($n) {
@disariums.push($n);
}
$n++;
}
Then for each number from 0 onwards, we check if it meets the critirion for the challenge. In this case, we want to know if it is a disarium number. If it is, it is added to our list of results. If it isn't or if we haven't collected the amount the challenge specifies yet (19 in this case,) we move on to the next consecutive integer.
@disariums.join(q{, }).say;
Once we have the results we want (i.e, 19 disarium numbers), we print them out separated by commas.
So in this case we want to know if a particular number is a Disarium number or not. That's what the aptly named, isDisarium() function does.
sub isDisarium(Int $n) {
my @digits = $n.comb;
my $total = 0;
It takes an integer as input and first splits it into its' component digits. A variable is also created to store a running total.
for 0 ..^ @digits.elems -> $i {
$total += @digits[$i] ** ($i + 1);
}
Then each digit is raised to the poer of its' position in the number. The result is added to the running total. At the last minute, I had an epiphany about a better way to write the above.
for @digits.kv -> $pos, $digit {
$total += $digit ** ($pos + 1);
}
The .kv() method is mostly used for iterating through a hash, getting each key and value (hence the name.) I remembered that it
can also be used on lists and arrays. In that case the "value" is a list item, and the "key" is the index of that item in the list. While this way is not noticably faster or anything like that, I feel it is more readable than my first version don't you agree?
return $total == $n;
When all the digits have been processed, the total is compared to the original number and if they are equal, we have a disarium
number so the function returns True. Otherwise it returns False.
}
This is isDisarium() in Perl. It is the same as the Raku version modulo the usual syntactic differences and each() is used in a while loop to iterate instead of .kv().
sub isDisarium {
my ($n) = @_;
my @digits = split //, $n;
my $total = 0;
while (my ($pos, $digit) = each @digits) {
$total += $digit ** ($pos + 1);
}
return $total == $n;
}
The first 19 disarium numbers are:
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798
Challenge 2:
Permutation Ranking
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, andrank2permutation()which will take the list and a rank number and produce just that permutation.Please checkout this post for more informations and algorithm.
Given the list
[0, 1, 2]the ordered permutations are:
0: [0, 1, 2]
1: [0, 2, 1]
2: [1, 0, 2]
3: [1, 2, 0]
4: [2, 0, 1]
5: [2, 1, 0]
and therefore:
permutation2rank([1, 0, 2]) = 2
rank2permutation([0, 1, 2], 1) = [0, 2, 1]
This was very easy to solve in Raku because there is a builtin .permutations() method that does all the heavy lifting for us.
This is permutations2rank() in Raku:
sub permutation2rank(@args) {
my @perms = @args.sort.permutations;
It takes a list of integers as input. Actually it doesn't check if the list consists only on unduplicated integers because I got a bit lazy but it really should.
The input is sorted in lexographical order as the spec demands and the result is assigned to another list ad function parameters are immutable by default in Raku.
for @perms.kv -> $index, $val {
if $val ~~ @args {
return $index;
}
}
Then each permutation is compared to the original and via smartmatching and if they are the same, the corresponding index is returned.
return Nil;
}
The spec didn't say what to do if the input is not found in the permutations. I don't think that could be possible but just in case,
if we manage to fall through the loop, Nil is returned.
And this is rank2permutation():
sub rank2permutation(@args, $rank) {
return @args.permutations[$rank];
}
Dead simple, a one-liner in fact. It even handles returning Nil if $rank is out of bounds.
Perl doesn't have .permutations() but I have been using the permute() function described in perlfaq4 in previous challenges and it came in handy once again.
This is permutation2rank():
sub permutation2rank {
my ($args) = @_;
my @perms;
permute { push @perms, \@_; } sort @{$args};
while (my ($index, $val) = each (@perms)) {
if ($val ~~ $args) {
return $index;
}
}
return undef;
}
An annoyance is that as of the version I am using, 5.30 which is not the latest and greatest but fairly recent, smart match is still marked as experimental so you get an unsightly warning if you don't use experimental qw/ smartmatch / in your script. Is the feature realisticly going to change or be removed at this point? It's high time the experimental designation was removed.
This is rank2permutation():
sub rank2permutation {
my ($args, $rank) = @_;
my @perms;
permute { push @perms, \@_; } @{$args};
return @{ $perms[$rank] };
}
It's a bit more awkward than the Raku version because there is no method chaining and permute() returns array references.