RabbitFarm

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

Part 1

Write a script to find the smallest integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

Solution

use strict;
use warnings;
use boolean;

sub is_permuted{
    my($x, $y) = @_;
    my(@x, @y); 
    map {$x[$_]++} split(//, $x);
    map {$y[$_]++} split(//, $y);
    return false if $#x != $#y;
    my @matched = grep {(!$x[$_] && !$y[$_]) || ($x[$_] && $y[$_] && $x[$_] == $y[$_])} 0 .. @y - 1;
    return true if @matched == @x;
    return false;
}

sub smallest_permuted{
    my $x = 0;
    {
        $x++;
        redo unless is_permuted($x, 2 * $x)     && is_permuted(2 * $x, 3 * $x) && 
                    is_permuted(3 * $x, 4 * $x) && is_permuted(4 * $x, 5 * $x) && 
                    is_permuted(5 * $x, 6 * $x);
    }
    return $x;
}

MAIN:{
    print smallest_permuted . "\n";
}

Sample Run

$ perl perl/ch-1.pl
142857

Notes

The approach here is to check if any two numbers are permutations of each other by counting up the digits for each and comparing the counts. A fun use of map and grep but I will admit it is a bit unnecessary. I implemented solutions to this problem in multiple languages and in doing so just sorted the lists of digits and compared them. Much easier, but less fun!

Part 2

Write a script to find out all Reversible Numbers below 100.

Solution

use strict;
use warnings;
sub is_reversible{
    my($x) = @_;
    my @even_digits = grep { $_ % 2 == 0 } split(//, ($x + reverse($x)));
    return @even_digits == 0;
}

sub reversibles_under_n{
    my($n) = @_;
    my @reversibles;
    do{
        $n--;
        unshift @reversibles, $n if is_reversible($n);

    }while($n > 0);
    return @reversibles;
}

MAIN:{
    print join(", ", reversibles_under_n(100)) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
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

Notes

My favorite use of Perl is to prototype algorithms. I'll get an idea for how to solve a problem and then quickly prove out the idea in Perl. Once demonstrated to be effective the same approach can be implemented in another language if required, usually for business reasons but also sometimes simply for performance.

The code here is concise, easy to read, and works well. It's also 3 times slower than a Fortran equivalent.

$ time perl perl/ch-2.pl
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

real    0m0.069s
user    0m0.048s
sys     0m0.020s
-bash-5.0$ time fortran/ch-2     
          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

real    0m0.021s
user    0m0.001s
sys     0m0.016s

That said, the Fortran took at least 3x longer to write. These are the tradeoffs that get considered on a daily basis!

References

Challenge 176

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

Part 1

Write a script to find the smallest integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

Solution

permuted(X, Y):-
    number_chars(X, XChars),
    number_chars(Y, YChars),
    msort(XChars, XCharsSorted),
    msort(YChars, YCharsSorted),
    XCharsSorted == YCharsSorted.

permuted_multiple(Permuted):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, X),
    X2 is 2 * X,
    X3 is 3 * X,
    X4 is 4 * X,
    X5 is 5 * X,
    X6 is 6 * X,
    permuted(X, X2), permuted(X2, X3), 
    permuted(X3, X4), permuted(X4, X5), permuted(X5, X6),
    Permuted = X.

Sample Run

| ?- permuted_multiple(Permuted).

Permuted = 142857 ? 

(2150 ms) yes

Notes

I implemented solutions for this problem in multiple languages and compared side by side on the same system this Prolog solution ran the fastest. I think that's because in Prolog the logic can be (naturally!) expressed very succinctly and so the underlying instructions getting executed are most efficient. Other implementations seem to require a bit more overhead, such as when deconstructing an integer into a list of digits for example.

The task here is for us to generate the smallest integer with this permutable property. Technically the code here will generate all such numbers, however in search of other solutions it seems there is just the one found before we exceed the bounds of MAX_INTEGER.

Part 2

Write a script to find out all Reversible Numbers below 100.

Solution

all_odd([]).
all_odd([H|T]):-
    number_chars(Digit, [H]),
    M is mod(Digit, 2),
    M == 1,
    all_odd(T).

reversible(X):-
    number_chars(X, XChars),
    reverse(XChars, XCharsReversed),
    number_chars(R, XCharsReversed),
    Sum is X + R, 
    number_chars(Sum, SumChars),
    all_odd(SumChars).

reversible_under_n(N, Reversible):-
    between(1, N, X),
    reversible(X),
    Reversible = X.

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- reversible_under_n(100, Reversibles).

Reversibles = 10 ? a

Reversibles = 12

Reversibles = 14

Reversibles = 16

Reversibles = 18

Reversibles = 21

Reversibles = 23

Reversibles = 25

Reversibles = 27

Reversibles = 30

Reversibles = 32

Reversibles = 34

Reversibles = 36

Reversibles = 41

Reversibles = 43

Reversibles = 45

Reversibles = 50

Reversibles = 52

Reversibles = 54

Reversibles = 61

Reversibles = 63

Reversibles = 70

Reversibles = 72

Reversibles = 81

Reversibles = 90

(10 ms) no

Notes

Here we also use Prolog's ability to identify multiple solutions to generate all solutions less than 100, as required.

References

Challenge 176