RabbitFarm

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 20 Brilliant Numbers.

Solution

prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

brilliants(_) --> [].
brilliants(Seen) --> [X], {brilliant(X), \+ member(X, Seen)}, brilliants([X|Seen]).

brilliant(X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, X),
    prime_factors(X, Factors),
    length(Factors, 2),
    nth(1, Factors, First),
    nth(2, Factors, Second),
    number_chars(First, FirstChars),
    number_chars(Second, SecondChars),
    length(FirstChars, FirstCharsLength),
    length(SecondChars, SecondCharsLength),
    FirstCharsLength == SecondCharsLength.

n_brilliants(N, Brilliants):-
    length(Brilliants, N), 
    phrase(brilliants([]), Brilliants). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- n_brilliants(20, Brilliants).

Brilliants = [4,6,9,10,14,15,21,25,35,49,121,143,169,187,209,221,247,253,289,299] ? 

Notes

The use of a DCG here seems appropriate as we are generating a sequence of numbers of a DCG will allow us to reason on such lists. The logic for inclusion in the sequence is a bit complex and so it further seems natural to break that into its own predicate. That is not required, of course, but in terms of pure style it seems the DCG starts to look clunky or overstuffed when containing a lot of Prolog code in curly braces. Perhaps that is especially true here where we further need additional predicates for computing the prime factors.

Part 2

Write a script to generate the first 20 Achilles Numbers.

Solution

prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

powerful(N, X):-
    M is mod(N, X * X),
    M == 0.

imperfect(N):-
    Sqrt is round(sqrt(N)),
    S is Sqrt - 1,
    length(I, S),
    fd_domain(I, 2, Sqrt),
    fd_all_different(I),
    fd_labeling(I),!,
    maplist(imperfect(N), I).
imperfect(N, X):-
    D is log(N) / log(X),
    Check is abs(D - round(D)),
    \+ Check < 0.000001.

achilles(_) --> [].
achilles(Seen) --> [X], {current_prolog_flag(max_integer, MAX_INTEGER), 
                         between(2, MAX_INTEGER, X), \+ member(X, Seen), achilles(X)}, 
                   achilles([X|Seen]).

achilles(X):-
    prime_factors(X, Factors), 
    maplist(powerful(X), Factors),
    imperfect(X).

n_achilles(N, Achilles):-
    length(Achilles, N), 
    phrase(achilles([]), Achilles). 

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- n_achilles(20, Achilles).

Achilles = [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152,1323,1352,1372,1568,1800] ? 

Notes

The approach here for the second task is similar to that of the first. Somewhat surprisingly while the conditions of this sequence are more complex the code itself is represented in a cleaner way. I attribute that to the use of maplist/2 which streamlines the checking of lists for the two criteria of Achilles numbers: that they are powerful but imperfect.

References

Challenge 169

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 20 Brilliant Numbers.

Solution

use strict;
use warnings;
sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for(my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub is_brilliant{
    my($n) = @_;
    my @factors = prime_factor($n); 
    return @factors == 2 && length($factors[0]) == length($factors[1]);
}

sub n_brilliants{
    my($n) = @_;
    my @brilliants;
    my $i = 0;
    {
       push @brilliants, $i if is_brilliant($i);
       $i++;
       redo if @brilliants < $n;
    }
    return @brilliants;
}

MAIN:{
    print join(", ", n_brilliants(20)) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253, 289, 299

Notes

The solution here incorporated a lot of elements from previous weekly challenges. That is to say it is quite familiar, I continue to be a fan of redo!

Part 2

Write a script to generate the first 20 Achilles Numbers.

Solution

use strict;
use warnings;
use POSIX;
use boolean;

sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for (my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub is_achilles{
    my($n) = @_;
    my @factors = prime_factor($n); 
    for my $factor (@factors){
        return false if $n % ($factor * $factor) != 0;
    }
    for(my $i = 2; $i <= sqrt($n); $i++) {
        my $d = log($n) / log($i) . "";
        return false if ceil($d) == floor($d);  
    }
    return true;
}

sub n_achilles{
    my($n) = @_;
    my @achilles;
    my $i = 1;
    {
       $i++;
       push @achilles, $i if is_achilles($i);
       redo if @achilles < $n;
    }
    return @achilles;
}

MAIN:{
    print join(", ", n_achilles(20)) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, 1125, 1152, 1323, 1352, 1372, 1568, 1800

Notes

This problem revealed something interesting with how, apparently, certain functions will handle integer and floating point values. The issue arises when we are computing logarithms. We can see the issue in isolation in a one liner.

perl -MPOSIX -e '$d = log(9) / log(3); print ceil($d) . "\t" . floor($d) . "\t$d\n"'

which prints 3 2 2. Notice that log(9) / log(3) is exactly 2 but, ok, floating point issues maybe it is 2.0000000001 and ceil will give 3. But why does this work?

perl -MPOSIX -e '$d = sqrt(9); print ceil($d) . "\t" . floor($d) . "\t$d\n"'

which gives 3 3 3. I am not sure what sqrt is doing differently? I guess how it stores the result internally? By the way, I am doing this to check is the result is an integer. That is if ceil($x) == floor($x), but that isn't working here as expected but I have used that trick in the past. I guess only with sqrt in the past though so never encountered this.

The trick to work around this, in the solution to the challenge is like this:

perl -MPOSIX -e '$d = log(9) / log(3) . ""; print ceil($d) . "\t" . floor($d) . "\t$d\n"'

this does what I want and gives 2 2 2. I guess that drops the infinitesimally small decimal part when concatenating and converting to a string which stays gone when used numerically?

Of course, there are other ways to do this. For example abs($x - int(x)) < 1e-7 will ensure that, within a minuscule rounding error, $x is an integer.

References

Challenge 169