RabbitFarm

2022-02-06

The Weekly Challenge 150 (Prolog Solutions)

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

Part 1

You are given two strings having the same number of digits, $a and $b. Write a script to generate Fibonacci Words by concatenation of the previous two strings. Print the 51st
of the first term having at least 51 digits.

Solution


fibonacci_words(Size, A, B) --> {atom_concat(A, B, C), atom_chars(C, Chars), length(Chars, N), N < Size}, [A], fibonacci_words(Size, B, C).
fibonacci_words(Size, A, B) --> {atom_concat(A, B, C), atom_chars(C, Chars), length(Chars, N), N >= Size}, [C].

fibonacci_words_nth_character(A, B, N, NthChar) :-
    phrase(fibonacci_words(N, A, B), FibonacciWords),
    last(FibonacciWords, LongestTerm),
    atom_chars(LongestTerm, LongestTermChars),
    nth(N, LongestTermChars, NthChar).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- fibonacci_words_nth_character('1234', '5678', 51, N).

N = '7' ? 

(2 ms) yes
| ?- 

Notes

This little bit of code might be the thing I am proudest of in a while! You see, modern Prolog style generally promotes the use of DCGs for almost any list processing you might want to do. The reasons for this are that DCG code is usually easily bimodal and also testing of code is much easier. Furthermore, DCG code can be said to rely more on the Prolog engine itself backtracking versus more manual recursive style code. Of course these are general statements which are not always necessarily true. In any event I default to not using DCGs so generally, but have been making a conscious attempt to do so. This Fibonacci Words task is well suited for DCGs.

Size, A, and B are passed as extra arguments to the DCG. Some parts of the DCG might appear a little mysterious so here is what the DCG code looks like when expanded


fibonacci_words(A, B, C, D, E) :-
        atom_concat(B, C, F),
        atom_chars(F, G),
        length(G, H),
        H < A,
        D = [B|I],
        fibonacci_words(A, C, F, I, E).
fibonacci_words(A, B, C, D, E) :-
        atom_concat(B, C, F),
        atom_chars(F, G),
        length(G, H),
        H >= A,
        D = [F|E].

while the variable names are changed during the term expansion you can see the behavior which may at first seem odd. The first three variables for each predicate are the "extra" ones which carry the size information, and the most recent two terms of the sequence which are used to compute the next term. In the DCG when we have [A] you can see what happens, that it is expanded to unify with the first implicit argument. In the expanded version we see D = [B|I], and in this way we create the recursive relationship to build the sequence list. Well, of course the recursive call which follows is important too, but see how we've now passed as the first implicit argument I which represents the uninstantiated tail of a list and on the next call will recursively be added to.

Part 2

Write a script to generate all square-free integers <= 500.

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).

square_free(N, SquareFree):-
    findall(X,
        (between(1, N, X),
         prime_factors(X, PrimeFactors),
         sort(PrimeFactors, PrimeFactorsSorted),
         msort(PrimeFactors, PrimeFactorsMSorted),
         length(PrimeFactorsSorted, SortedLength),
         length(PrimeFactorsMSorted, MSortedLength),
         SortedLength == MSortedLength), SquareFree).

Sample Run


$ gprolog --consult-file prolog/ch-2.p 
| ?- square_free(500, SquareFree).

SquareFree = [1,2,3,5,6,7,10,11,13,14,15,17,19,21,22,23,26,29,30,31,33,34,35,37,38,39,41,42,43,46,47,51,53,55,57,58,59,61,62,65,66,67,69,70,71,73,74,77,78,79,82,83,85,86,87,89,91,93,94,95,97,101,102,103,105,106,107,109,110,111,113,114,115,118,119,122,123,127,129,130,131,133,134,137,138,139,141,142,143,145,146,149,151,154,155,157,158,159,161,163,165,166,167,170,173,174,177,178,179,181,182,183,185,186,187,190,191,193,194,195,197,199,201,202,203,205,206,209,210,211,213,214,215,217,218,219,221,222,223,226,227,229,230,231,233,235,237,238,239,241,246,247,249,251,253,254,255,257,258,259,262,263,265,266,267,269,271,273,274,277,278,281,282,283,285,286,287,290,291,293,295,298,299,301,302,303,305,307,309,310,311,313,314,317,318,319,321,322,323,326,327,329,330,331,334,335,337,339,341,345,346,347,349,353,354,355,357,358,359,362,365,366,367,370,371,373,374,377,379,381,382,383,385,386,389,390,391,393,394,395,397,398,399,401,402,403,406,407,409,410,411,413,415,417,418,419,421,422,426,427,429,430,431,433,434,435,437,438,439,442,443,445,446,447,449,451,453,454,455,457,458,461,462,463,465,466,467,469,470,471,473,474,478,479,481,482,483,485,487,489,491,493,494,497,498,499]

(26 ms) yes
| ?-

Notes

I am re-using the prime factorization code I have use din the past, most recently in Challenge 123. Getting the factors is really the hardest part. Once that is doine we need to only check to see if a number has duplicate prime factors indicating a square. To do that we sort using msort/2 and sort/2 and see if the resulting lists are the same length. Recall that sort/2 will remove duplicates whereas msort/2 does not. If the results of both are the same length then we can conclude there were no square factors.

References

Challenge 150

Squarefree Numbers

posted at: 16:44 by: Adam Russell | path: /prolog | permanent link to this entry