RabbitFarm

2022-05-15

The Weekly Challenge 164 (Prolog Solutions)

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

Part 1

Write a script to find all prime numbers less than 1000, which are also palindromes in base 10.

Solution


:-initialization(main).

palindrome(X):-
    fd_labeling(X),
    number_codes(X, C),
    reverse(C, CR),
    number_codes(X, CR).

palindrome_primes(N, PalindromePrimes, NumberPrimes):-
    fd_labeling(NumberPrimes),
    length(Primes, NumberPrimes),
    fd_domain(Primes, 1, N),
    fd_all_different(Primes),
    maplist(palindrome, Primes),
    maplist(fd_prime, Primes),
    fd_labeling(Primes),
    PalindromePrimes = Primes.

palindrome_primes(N, Primes):- 
    NP is N // 2,
    fd_domain(NumberPrimes, 1, NP),
    fd_maximize(palindrome_primes(N, Primes, NumberPrimes), NumberPrimes).

palindrome_prime(N, Prime):-
    between(1, N, Prime),
    palindrome(Prime),
    fd_prime(Prime).

pp(_, _) --> [].
pp(N, Seen) --> [X], {palindrome_prime(N, X), \+ member(X, Seen)}, pp(N, [X|Seen]).

main:-
    findall(Prime, palindrome_prime(1000, Prime), PalindromePrimes),
    write(PalindromePrimes), nl.

Sample Run


$ gprolog --consult-file prolog/ch-1.p 
[2,3,5,7,11,101,131,151,181,191,313,353,373,383,727,757,787,797,919,929]
| ?- phrase(pp(1000, []), PalindromePrimes).

PalindromePrimes = [] ? ;

PalindromePrimes = [2] ? ;

PalindromePrimes = [2,3] ? ;

PalindromePrimes = [2,3,5] ? ;

PalindromePrimes = [2,3,5,7] ? ;

PalindromePrimes = [2,3,5,7,11] ? ;

PalindromePrimes = [2,3,5,7,11,101] ? ;

PalindromePrimes = [2,3,5,7,11,101,131] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181,191] ? ;

PalindromePrimes = [2,3,5,7,11,101,131,151,181,191,313] ? 
.
.
.

Notes

I experimented with a few different ways to generate Palindrome Primes. The quickest and most efficient way is what is used in main/0. Now, suppose we wanted to reason about lists of such numbers versus just generating them there is also a DCG option as shown which will generate or validate all possible lists of Palindrome Primes. Finally, there is the extremely inefficient method using constraints to maximize the size of the list of Palindrome Primes under 1000. This works! Now, does it work "well"? Absolutely not! This is not a very good method for performing the task and is many orders of magnitude slower than the other two. I will admit to an odd satisfaction to getting this unusual approach work, however.

Part 2

Given a list of numbers, generate the skip summations.

Solution


:-initialization(main).

pdi(0, Total, Total). 
pdi(N, Total_, Total):-
    N_ is N // 10,
    Total__ is Total_ + round(mod(N, 10) ** 2), 
    pdi(N_, Total__, Total).
pdi(N, Total):-
    pdi(N, 0, Total).

happy(1, _).
happy(N, Seen):-
    \+ member(N, Seen),
    pdi(N, Total),!,
    N_ is Total,
    happy(N_, [N|Seen]).
happy(N):-
    happy(N, []).

happy(_) --> [].
happy(Seen) --> [X], {between(1, 100, X), \+ member(X, Seen), happy(X)}, happy([X|Seen]).

main:-
    length(Happy, 8),
    phrase(happy([]), Happy),
    write(Happy), nl.

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
[1,7,10,13,19,23,28,31]

Notes

As with the code in the first part I also implemented this as a DCG. Here a DCG is more practical since we are asked specifically to generate a list of the first 8 Happy Numbers. This is more of a "list reasoning" task than how the Palindrome Prime question was asked.

References

Challenge 164

posted at: 23:58 by: Adam Russell | path: /prolog | permanent link to this entry