### Perl Weekly Challenge: Week 176

#### Challenge 1:

**Permuted Multiples**

Write a script to find the smallest positive integer

`x`

such that`x, 2x, 3x, 4x, 5x`

and`6x`

are permuted multiples of each other.For example, the integers

`125874`

and`251748`

are permutated multiples of each other as

```
251784 = 2 x 125874
```

and also both have the same digits but in different order.

##### Output

```
142857
```

My first attempt at a Raku solution looked like this:

```
for 1 .. ∞ -> $n {
```

We create an infinite loop that assigns consecutive integers to `$n`

.

```
my @perms = $n.comb.permutations.map({ @_.join; });
```

`$n`

is split into individual digits and the `.permutations()`

method is used to get
all the permutations of those digits. They are then recombined into numbers. So we
end up with an array of numbers which are permutations of `$n`

.

```
if @perms.grep(2 * $n) &&
@perms.grep(3 * $n) &&
@perms.grep(4 * $n) &&
@perms.grep(5 * $n) &&
@perms.grep(6 * $n) {
```

Now we look for all the multiples of `$n`

in the `@perms`

array.

```
say $n;
last;
```

If all the multiples are found in the array, we have our number. We can print it out and exit the loop.

```
}
}
```

This worked but it was dreadfully slow; taking almost 10 minutes on my machine. I tried
searching for multiples from 6 .. 2 to see if that would help eliminate wrong numbers faster
but it didn't make much difference. So I thought about it; I was using `grep()`

on a list a lot;
could that be the choke point? Perhaps a better data structure might help. This is my second attempt:

```
for 1 .. ∞ -> $n {
my %perms = $n.comb.permutations.map({ @_.join; }).antipairs;
```

This time I am creating a hash whose keys are permutations. (`.antipairs()`

transforms a list into this kind of hash.)

```
if (%perms{6 * $n}:exists) &&
(%perms{5 * $n}:exists) &&
(%perms{4 * $n}:exists) &&
(%perms{3 * $n}:exists) &&
(%perms{2 * $n}:exists) {
say $n;
last;
}
}
```

Now it is just a simple matter of testing for the existence of a key in the hash which matches a multiple which if I remember my data structures class in college is O(1) which should be much better. Well it did shave off about two minutes from the running time but that's still very slow. At this point I moved on to Perl.

```
my $n = 1;
while(1) {
my @perms;
permute { push @perms, \@_; } split //, $n;
my %perms = map { $_ => 1 } map { join q{}, @{$_}; } @perms;
if (exists $perms{6 * $n} &&
exists $perms{5 * $n} &&
exists $perms{4 * $n} &&
exists $perms{3 * $n} &&
exists $perms{2 * $n}) {
last;
}
$n++;
}
say $n;
```

This is a port of the second Raku version. Permute is the standard function I use for these purposes, lifted from perlfaq4.

Much to my surprise, this script finished in less than 10 seconds. Now as Raku is a fairly young language, I do not expect it to be as optimized as Perl but this difference was astounding. I knew there had to be something wrong with my Raku implementation.

So again I put on my thinking cap and I had an ephipany or two actually. One, I don't actually need all the permutations. And two, as all the multiples are permutions, they all have the same digits. So this is attempt number three:

```
number: for 1 .. ∞ -> $n {
```

The main loop is the same but it has a label for reasons explained below.

```
my $nn = $n.comb.sort.join;
```

This time I didn't bother with `.permutations()`

. I merely split `$n`

into digits, sorted them and joined them together again. This
number is assigned to `$nn`

because `$n`

is immutable.

```
for 2 .. 6 -> $i {
next number unless ($i * $n).comb.sort.join == $nn;
```

For each multiple we do the same thing. If this number is not equal to `$nn`

, we know this is not the number we want so we go the next iteration of the outer loop.

```
}
```

If all the sorted multiples were the same as `$nn`

, this is the number so we print it and break out of the loop.

```
say $n;
last;
}
```

Now the script gives the answer in about three seconds. I suppose if I had made the same changes to the Perl version it would have run even faster but I didn't try it.

#### Challenge 2:

**Perfect Totient Numbers**

Write a script to find out all

`Reversible Numbers`

below`100`

.A number is said to be a reversible if sum of the number and its reverse had only odd digits.

For example,

```
36 is reversible number as 36 + 63 = 99 i.e. all digits are odd.
17 is not reversible as 17 + 71 = 88, none of the digits are odd.
```

##### Output

```
10, 12, 14, 16, 18, 21, 23, 25, 27,
30, 32, 34, 36, 41, 43, 45, 50, 52,
54, 61, 63, 70, 72, 81, 90
```

This was thankfully much easier and follows a well-used structure.

```
my @reversibles;
for 1 ..^ 100 -> $n {
if isReversible($n) {
@reversibles.push($n);
}
}
@reversibles.join(q{, }).say;
```

The `isReversible()`

function looks like this:

```
sub isReversible(Int $n) {
return $n + $n.flip ~~ /^ <[13579]>+ $/;
}
```

It reverses the number being tested and adds it to the original. A regular expression checks that all the digits of this resulting
number add odd. If they are, it returns `True`

else `False`

.

The Perl version works the same.

```
sub isReversible {
my ($n) = @_;
return $n + (0 + reverse $n) ~~ /^ [13579]+ $/msx;
}
my @reversibles;
for my $n (1 .. 99) {
if (isReversible($n)) {
push @reversibles, $n;
}
}
say join q{, }, @reversibles;
```