RabbitFarm

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

Part 1

Write a script to generate first 20 left-truncatable prime numbers in base 10.

Solution

:-initialization(main).

left_truncatable(X):-
    fd_labeling(X),
    number_codes(X, C),
    \+ member(48, C),
    length(C, L),
    findall(Truncatable, (
        between(1, L, N),
        length(T, N),
        append(_, T, C),
        number_codes(Truncatable, T),
        fd_prime(Truncatable)), Truncatables),
     length(Truncatables, NumberTruncatable),   
     L == NumberTruncatable.  

first_twenty_left_truncatable(FirstTwenty):-
    length(FirstTwenty, 20),
    fd_domain(FirstTwenty, 1, 200),
    fd_all_different(FirstTwenty),
    maplist(left_truncatable, FirstTwenty), 
    fd_labeling(FirstTwenty). 

main:-
    first_twenty_left_truncatable(FirstTwenty),
    write(FirstTwenty), nl,
    halt.

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
[2,3,5,7,13,17,23,37,43,47,53,67,73,83,97,113,137,167,173,197]

Notes

I thought quite a while on how to best approach this problem in Prolog. The code here works well. Some knowledge of the size of the left truncatable primes lets us set the upper bound of the domain pretty tightly, but at best that is a very small optimization, if we can even really claim it as such. The change which might most effect performance is to start with a pre-generated list of primes. Especially since the density of primes is much more sparse as the numbers increase the number of unnecessary checks would be greatly reduced.

Part 2

Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Solution

n_pentagon_numbers(0, []).
n_pentagon_numbers(N, [H|T]):-
    H #= N * (3 * N - 1) / 2,
    Next #= N - 1,
    n_pentagon_numbers(Next, T).

first_pair_pentagon(FirstPair):-
    n_pentagon_numbers(10000, Pentagons),
    fd_domain([X, Y, Sum, AbsoluteDifference], Pentagons),
    Sum #= X + Y,
    Difference #= X - Y,
    ((
        Difference #< 0, 
        AbsoluteDifference #= -1 * Difference
    ); AbsoluteDifference #= Difference),
    fd_labeling([X, Y]),
    FirstPair = [X, Y].  

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- first_pair_pentagon(FirstPair).
FirstPair = [7042750,1560090] ?

Notes

Apparently GNU Prolog does not define an absolute value function for FD vars. Perhaps because of some theoretical limitation I am unaware of? No matter, some extra code takes care of that. Frankly, the bigger issue is that in this case the use of an FD solver doesn't really help much beyond a pure Prolog one. Again, I may be unaware of what is happening under the hood, but performance wise it doesn't seem any better to constrain the domains of the variables versus an outright "generate and test".

References

Challenge 147

Left Truncatable Primes

Pentagonal Numbers