# RabbitFarm

### 2022-07-24

The Weekly Challenge 174 (Prolog Solutions)

*The examples used here are from the weekly challenge problem statement and demonstrate
the working solution.*

## Part 1

*Write a script to generate the first 19 Disarium Numbers.*

### Solution

```
disariums(_) --> [].
disariums(Seen) --> [X], {disarium(X), \+ member(X, Seen)}, disariums([X|Seen]).
sum_power(Digits, Sum):-
sum_power(Digits, 0, 0, Sum).
sum_power([], _, Sum, Sum).
sum_power([H|T], I, PartialSum, Sum):-
succ(I, N),
number_chars(X, [H]),
Partial is PartialSum + round(X ** N),
sum_power(T, N, Partial, Sum).
disarium(X):-
current_prolog_flag(max_integer, MAX_INTEGER),
between(0, MAX_INTEGER, X),
number_chars(X, Chars),
sum_power(Chars, Sum),
Sum == X.
n_disariums(N, Disariums):-
length(Disariums, N),
phrase(disariums([]), Disariums).
```

### Sample Run

```
$ gprolog --consult-file prolog/ch-1.p
| ?- n_disariums(19, Diariums).
Diariums = [0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798] ?
```

## References

posted at: 19:34 by: Adam Russell | path: /prolog | permanent link to this entry

#### Permutations Ranked in Disarray on Mars

*The examples used here are from the weekly challenge problem statement and demonstrate
the working solution.*

## Part 1

*Write a script to generate the first 19 Disarium Numbers.*

### Solution

```
use strict;
use warnings;
use POSIX;
sub disarium_n{
my($n) = @_;
my @disariums;
map{
return @disariums if @disariums == $n;
my @digits = split(//, $_);
my $digit_sum = 0;
map{
$digit_sum += $digits[$_] ** ($_ + 1);
} 0 .. @digits - 1;
push @disariums, $digit_sum if $digit_sum == $_;
} 0 .. INT_MAX / 100;
}
MAIN:{
print join(", ", disarium_n(19)) . "\n";
}
```

### Sample Run

```
$ perl perl/ch-1.pl
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798
```

### Notes

I gave myself a *writing prompt* for this exercise: only use map. This turned out to
present a small issue and that is, how do we terminate out of a `map`

early? This comes up
because we do not need to examine all numbers in the large range of `0 .. INT_MAX / 100`

.
Once we find the 19 numbers we require we should just stop looking. `last`

will not work
from within a `map`

it turns out. In this case a `return`

works well. But suppose we did
not want to `return`

out of the subroutine entirely? Well, I have tested it out and it
turns out that `goto`

will work fine from within a `map`

block as well!

That code would look something like this, where the `CONTINUE`

block would have some more
code for doing whatever else was left to do.

```
sub disarium_n{
my($n) = @_;
my @disariums;
map{
goto CONTINUE if @disariums == $n;
my @digits = split(//, $_);
my $digit_sum = 0;
map{
$digit_sum += $digits[$_] ** ($_ + 1);
} 0 .. @digits - 1;
push @disariums, $digit_sum if $digit_sum == $_;
} 0 .. INT_MAX / 100;
CONTINUE:{
##
# more to do before we return
##
}
return @disariums;
}
```

## Part 2

*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.*

### Solution

```
use strict;
use warnings;
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";
}
```

### Sample Run

```
$ perl perl/ch-2.pl
[1, 0, 2] has rank 2
[0, 1, 2] has permutation at rank 1 --> [0, 2, 1]
```

### Notes

I've been enjoying trying out Al Newkirk's Mars OOP framework. When it comes to Object
Oriented code in Perl I've usually just gone with the default syntax or `Class::Struct`

.
I am far from a curmudgeon when it comes to OOP though, as I have a lot of experience
using Java and C++. What I like about Mars is that it reminds me of the best parts of
`Class::Struct`

as well as the best parts of how Java does OOP. The code above, by its
nature does not require all the features of Mars as here we don't need much in the way
of Roles or Interfaces.

Perhaps guided by my desire to try out Mars more I have taken a definitively OOP approach
to this problem. From the problem statement the intent may have been to have two
independent functions. This code has two methods which depend on the constructor (defined
within `sub BUILD`

) to have populated the internal class variables needed.

There is a small trick here that the sorting is to be by *lexicograohic order*, which
conveniently is the default for Perl's default `sort`

. That doesn't really buy us any
algorithmic improvement in performance, in fact it hurts it! Other approaches exist for
this problem which avoid producing all permutations of the list.

## References

posted at: 19:34 by: Adam Russell | path: /perl | permanent link to this entry