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