RabbitFarm

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

Part 1

You are given an array of unique numbers. Write a script to find out all missing numbers in the range 0..$n where $n is the array size.

Solution

missing_number(Numbers, Missing):-
    length(Numbers, NumbersLength),
    between(0, NumbersLength, Missing),
    \+ member(Missing, Numbers). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- missing_number([0, 1, 3], Missing).

Missing = 2 ? 

(1 ms) yes
| ?- missing_number([0, 1], Missing).   

Missing = 2

yes
| ?- 

Notes

missing_number/2 will only find one missing number at a time. In the examples that come with the original problem statement there is only ever one missing number. If multiple missing numbers are required backtracking with findall/3 is all you need!

Part 2

You are given an integer, $n > 0. Write a script to determine the number of ways of putting $n pennies in a row of piles of ascending heights from left to right.

Solution

sum(Coins):-
    sum([], Coins, 0).

sum(Coins, Coins, 5). 

sum(Partial, Coins, Sum):-   
    Sum < 5, 
    between(1, 5, X),
    S is Sum + X,
    sum([X | Partial], Coins, S).  

main:-
    findall(Coins, sum(Coins), C),
    maplist(msort, C, CS),
    sort(CS, CoinsSorted),
    write(CoinsSorted), nl,
    halt.  

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- main.
[[1,1,1,1,1],[1,1,1,2],[1,1,3],[1,2,2],[1,4],[2,3],[5]]

Notes

The approach here is the same that I used for the Coins Sum problem from TWC 075. The same as for the Perl solution to the same problem.

References

Challenge 201

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

Part 1

You are given a list of integers, @list. Write a script to find the total count of Good airs.

Solution

good_pair(Numbers, Pair):-
    length(Numbers, L),
    fd_domain(I, 1, L),
    fd_domain(J, 1, L),
    I #<# J,
    fd_labeling([I, J]), 
    fd_element(I, Numbers, Ith),  
    fd_element(J, Numbers, Jth), 
    Ith #= Jth,
    Pair = [I, J].   

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- good_pair([1, 2, 3, 1, 1, 3], Pair).

Pair = [1,4] ? a

Pair = [1,5]

Pair = [3,6]

Pair = [4,5]

no
| ?- good_pair([1, 2, 3], Pair).         

no
| ?- good_pair([1, 1, 1, 1], Pair).

Pair = [1,2] ? a

Pair = [1,3]

Pair = [1,4]

Pair = [2,3]

Pair = [2,4]

Pair = [3,4]

yes
| ?- 

Notes

I take a clpfd approach to this problem and the next. This allows a pretty concise solution. Here we get the length of the list of numbers, constrain the indices for the pair and then specify the additional conditions of a Good Pair.

Part 2

You are given an array of integers, @array and three integers $x,$y,$z. Write a script to find out total Good Triplets in the given array.

Solution

good_triplet(Numbers, X, Y, Z, Triplet):-
    length(Numbers, I),
    fd_domain(S, 1, I),
    fd_domain(T, 1, I),
    fd_domain(U, 1, I),
    S #<# T, T #<# U,   
    fd_labeling([S, T, U]),   
    fd_element(S, Numbers, Sth),  
    fd_element(T, Numbers, Tth),  
    fd_element(U, Numbers, Uth), 
    Ast is abs(Sth - Tth), Ast #=<# X,     
    Atu is abs(Tth - Uth), Atu #=<# Y,     
    Asu is abs(Sth - Uth), Asu #=<# Z, 
    Triplet = [Sth, Tth, Uth].   

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- good_triplet([3, 0, 1, 1, 9, 7], 7, 2, 3, Triplet).

Triplet = [3,0,1] ? a

Triplet = [3,0,1]

Triplet = [3,1,1]

Triplet = [0,1,1]

no
| ?- good_triplet([1, 1, 2, 2, 3], 0, 0, 1, Triplet).   

no
| ?-

Notes

Again for part 2 a clpfd solution ends up being fairly concise. In fact, the approach here is virtually identical to part 1. The differences are only that we are looking for a triple, not a pair, and slightly different criteria.

References

Challenge 199

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

Part 1

You are given a list of integers, @list. Write a script to find the total pairs in the sorted list where 2 consecutive elements has the max gap. If the list contains less then 2 elements then return 0.

Solution

largest_gap(Numbers, LargestGap):-
    largest_gap(Numbers, -1, LargestGap).  
largest_gap([], LargestGap, LargestGap).  
largest_gap([_|[]], LargestGap, LargestGap).  
largest_gap([A, B|Numbers], Gap, LargestGap):-
    G is B - A,
    (G > Gap, largest_gap([B|Numbers], G, LargestGap));
    largest_gap([B|Numbers], Gap, LargestGap).

gap_pairs(Numbers, GapPairs):-
    length(Numbers, L),
    L =< 2,
    GapPairs = 0.
gap_pairs(Numbers, GapPairs):-
    length(Numbers, L),
    L > 2, 
    largest_gap(Numbers, LargestGap),
    gap_pairs(Numbers, LargestGap, 0, GapPairs).
gap_pairs([], _, GapPairs, GapPairs).
gap_pairs([_|[]], _, GapPairs, GapPairs).
gap_pairs([A, B|Numbers], LargestGap, Pairs, GapPairs):-
    LargestGap #= B - A,
    succ(Pairs, P),
    gap_pairs([B|Numbers], LargestGap, P, GapPairs).
gap_pairs([A, B|Numbers], LargestGap, Pairs, GapPairs):-
    LargestGap #\= B - A,
    gap_pairs([B|Numbers], LargestGap, Pairs, GapPairs). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- gap_pairs([3], Pairs).

Pairs = 0 ? 

(1 ms) yes
| ?- gap_pairs([2, 5, 8, 1], Pairs).

Pairs = 2 ? 

yes
| ?- 

Notes

At first glance this code may look more complex than it really is. All we are doing is , first, computing the largest gap between any two adjacent numbers. Then, second, seeing which pairs have exactly this gap.

Part 2

You are given an integer $n > 0. Write a script to print the count of primes less than $n.

Solution

primes_under_n(N, NumberPrimes):-
    findall(Prime, (between(2, N, I), fd_prime(I), Prime = I), Primes),
    length(Primes, NumberPrimes).  

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- primes_under_n(10, Primes).

Primes = 4

yes
| ?- primes_under_n(15, Primes).

Primes = 6

yes
| ?- primes_under_n(1, Primes). 

Primes = 0

yes
| ?- primes_under_n(25, Primes).

Primes = 9

yes

Notes

This solution is short and sweet! No reason or the writeup to be longer than the code itself, right?

References

Challenge 198

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

Part 1

You are given a positive integer, $n > 0. Write a script to print the count of all special integers between 1 and $n.

Solution

code2digit(C, D):-
    number_codes(D, [C]).

special(N):-
    number_codes(N, NCodes),
    maplist(code2digit, NCodes, Digits),
    sort(Digits, DigitsSorted),
    length(Digits, NumberDigits),
    length(DigitsSorted, NumberDigits).

number_special(N, NumberSpecial):-
    findall(I, (between(1, N, I), special(I)), Specials),
    length(Specials, NumberSpecial). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- number_special(15, NumberSpecial).

NumberSpecial = 14

(1 ms) yes
| ?- number_special(35, NumberSpecial).

NumberSpecial = 32

(1 ms) yes
| ?- 

Notes

The definition of a special integer for this problem is an integer whose digits are unique. To determine this specialness we split the number into its digits using number_codes/2 and a maplist/3 which uses a small helper predicate to convert the codes back to the corresponding digit.

After getting set with identifying special integers all the is left is to count up all the ones found in the given range.

Part 2

You are given a list of numbers, @list. Write a script to find most frequent even numbers in the list. In case you get more than one even numbers then return the smallest even integer. For all other case, return -1.

Solution

even(N, Even):-
    (0 is mod(N, 2), Even = N);
    (Even = nil).

frequency(ListNumbers, N, Frequency):-
    delete(ListNumbers, N, ListDeleted),
    length(ListNumbers, L),
    length(ListDeleted, LD),
    Frequency is L - LD. 

most_frequent_even(ListNumbers, MostFrequentEven):-
    maplist(even, ListNumbers, EN),
    delete(EN, nil, EvenNumbers), 
    length(EvenNumbers, LengthEvens),
    LengthEvens > 0,
    maplist(frequency(ListNumbers), EvenNumbers, Frequencies),      
    msort(Frequencies, FS), 
    reverse(FS, FrequenciesSorted), 
    ((
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 \== F2,
         nth(N, Frequencies, F1),  
         nth(N, EvenNumbers, MostFrequentEven)  
     );
     (
         nth(1, FrequenciesSorted, F1),
         nth(2, FrequenciesSorted, F2), 
         F1 == F2,
         findall(MFE, (member(FX, FrequenciesSorted), FX == F1, nth(N, Frequencies, FX), nth(N, EvenNumbers, MFE)), MostFrequentEvens),   
         sort(MostFrequentEvens, MostFrequentEvensSorted), 
         nth(1, MostFrequentEvensSorted, MostFrequentEven)
     ) 
    ), !.

most_frequent_even(_, MostFrequentEven):-
    MostFrequentEven = -1, !. 

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- most_frequent_even([1, 1, 2, 6, 2], MostFrequentEven).

MostFrequentEven = 2

yes
| ?- most_frequent_even([1, 3, 5, 7], MostFrequentEven).   

MostFrequentEven = -1

yes
| ?- most_frequent_even([6, 4, 4, 6, 1], MostFrequentEven).

MostFrequentEven = 4

yes
| ?- 

Notes

The code here may look a bit more convoluted than it really is. Well my use of the disjunction in most_frequent/2 may only be against my own personal sense of aesthetics! Also, in balance the use of maplist/3 cleans things up a bit.

The main ideas here are:

1. Remove all odd numbers and check to see if any numbers remain.

2. Compute the frequency of each remaining even number.

3. Sort and see if there is a tie for most frequent.

4. If there is no tie in (3) then we're done in the first part of the disjunction. Otherwise, in the second part of the disjunction, find the smallest of the numbers tied for most frequent.

References

Challenge 195

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

Part 1

You are given an integer, $n > 0. Write a script to find all possible binary numbers of size $n.

Solution

binary --> [].
binary --> digit, binary.
digit  --> [0]; [1].

binary_numbers_size_n(N, BinaryNumbers):-
    length(Binary, N), 
    findall(Binary, phrase(binary, Binary), BinaryNumbers).

main:-
    binary_numbers_size_n(2, BinaryNumbers),
    write(BinaryNumbers), nl.

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- main.
[[0,0],[0,1],[1,0],[1,1]]

(1 ms) yes
| ?- binary_numbers_size_n(3, BinaryNumbers).            

BinaryNumbers = [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

yes
| ?- binary_numbers_size_n(4, BinaryNumbers).

BinaryNumbers = [[0,0,0,0],[0,0,0,1],[0,0,1,0],[0,0,1,1],[0,1,0,0],[0,1,0,1],[0,1,1,0],[0,1,1,1],[1,0,0,0],[1,0,0,1],[1,0,1,0],[1,0,1,1],[1,1,0,0],[1,1,0,1],[1,1,1,0],[1,1,1,1]]

yes

Notes

This challenge presented a perfect use for a DCG, right!?!? For convenience we wrap the DCG in a predicate binary_numbers_size_n/2 to make sure we set a list of the correct size.

Part 2

You are given a list of strings of same length, @s. Write a script to find the odd string in the given list. Use positional alphabet values starting with 0, i.e. a = 0, b = 1, ... z = 25.

Solution

string_differences(String, Differences):-
    atom_codes(String, Codes),
    string_differences(Codes, [], Differences).
string_differences([_|[]], Differences, Differences).   
string_differences([C0, C1|T], DifferenceAccum, Differences):-
    Difference is C1 - C0,
    string_differences([C1|T], [Difference|DifferenceAccum], Differences).

odd_string(Strings, OddString):-
    maplist(string_differences, Strings, Differences),
    member(Difference, Differences),
    delete(Differences, Difference, UpdatedDifferences),
    length(UpdatedDifferences, UpdatedDifferencesLength),
    UpdatedDifferencesLength > 1,
    nth(N, Differences, Difference),
    nth(N, Strings, OddString).

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- odd_string([adc, wzy, abc], OddString).

OddString = abc ? 

yes
| ?- odd_string([aaa, bob, ccc, ddd], OddString).

OddString = bob ? 

(1 ms) yes
| ?- odd_string([aaaa, bbob, cccc, dddd], OddString).

OddString = bbob ? 

yes

Notes

The approach here is:

1) Compute all the differences for each string using maplist/3 with string_differences/2, a helper predicate I wrote.

2) Once done we use member/2 identify a difference from the list

3) Delete the difference and see if the list has been reduced to size one.

4) If the list has not been reduced to one element then we know we have found the uniquely odd string!

5) By position, determine the OddString from the original list.

References

Challenge 193

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

Part 1

You are given a positive integer, $n. Write a script to find the binary flip.

Solution

bits(N, Bits):-
    bits(N, [], Bits).    
bits(0, Bits, Bits):-!.
bits(N, BitsAccum, Bits):-
    B is N /\ 1,
    N0 is N >> 1,
    bits(N0, [B|BitsAccum], Bits).

bits_reverse(B, RB):-
    Flipped is xor(B, 1),
    number_chars(Flipped, [RB]).

binary_flip(N, NBitsReversed):-
    bits(N, Bits), 
    maplist(bits_reverse, Bits, BitsReversed),
    number_chars(NBitsReversed, ['0','b'|BitsReversed]).

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- binary_flip(5, BinaryFlip).

BinaryFlip = 2

yes
| ?- binary_flip(4, BinaryFlip).

BinaryFlip = 3

yes
| ?- binary_flip(6, BinaryFlip).

BinaryFlip = 1

yes

Notes

I learned a slightly obscure bit (no pun intended!) of information about Prolog's handling of binary numbers this week. If you prepend '0','b' to a list of characters, or the ascii code equivalents to a list of codes, representing binary digits then number_chars/2 (or number_codes/2) will automatically convert to decimal.

The solution to the whole problem is:

• Convert the number to a list of bits (bits/2).

• Flip the bits with an xor

• Convert the list of flipped bits to decimal using the number_chars/2 method.

Part 2

You are given a list of integers greater than or equal to zero, @list. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print -1.

Solution

:-dynamic(moves/1).
moves(0).

equal_distribution(ListIntegers, _):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F \== C,
    fail.
equal_distribution(ListIntegers, ListEqualDistribution):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F == C,
    length(ListEqualDistribution, L),
    equal_distribution(ListIntegers, F, ListEqual),
    delete(ListEqual, F, ListEqualAverageDeleted),
    length(ListEqualAverageDeleted, ListEqualAverageDeletedLength),
    ((ListEqualAverageDeletedLength == 0,
      ListEqualDistribution = ListEqual);
    equal_distribution(ListEqual, ListEqualDistribution)), !.

distribute(Average, [X, Y], [S, T]):-
    X < Average,
    X < Y,
    S is X + 1,
    T is Y - 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    X > Average,
    X > Y,
    S is X - 1,
    T is Y + 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    ((X == Average; X == Y);
     (X < Average, X > Y)
    ),
    S = X,
    T = Y.    

equal_distribution([A, B|[]], Average, [X, Y|[]]):-
    maplist(distribute(Average),[[A, B]], [[X, Y]]).
equal_distribution(ListIntegers, Average, [X|T]):-
    append([A, B], RestIntegers, ListIntegers),
    maplist(distribute(Average),[[A, B]], [[X, Y]]),
    equal_distribution([Y|RestIntegers], Average, T).

main(ListIntegers, Moves):-
    retract(moves(_)),
    asserta(moves(0)),
    (equal_distribution(ListIntegers, _), moves(Moves), !);
    Moves = -1.

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- main([1, 0, 5], Moves).

Moves = 4

(1 ms) yes
| ?- main([0, 2, 0], Moves).

Moves = -1

yes
| ?- main([0, 3, 0], Moves).

Moves = 2

yes

Notes

The rules that must be followed are:

1) You can only move a value of '1' per move

2) You are only allowed to move a value of '1' to a direct neighbor/adjacent cell.

This code ended up being a little more complex than I had originally thought it would be. At the heart of the solution is what I consider a pretty nice application of maplist/3 to drive the distribution/3, which is the implementation of the given rules.

We need to track the number of moves taken, not just the final resulting list. Rather than track the moves using a variable passed to the various predicates handling the re-distribution it seemed a bit cleaner to me to instead not have so many variables and asserta/1 and retract/1 the updated number of moves.

I generally try and avoid the use of the disjunction (;)/2 with the exception of small cases where to use it would unnaturally increase the amount of code. In this problem there are several such small cases such as whether we set the number of Moves to -1 in the case of an impossible re-distribution or the condition for detecting that we are done re-distributing.

References

Challenge 192

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

Part 1

You are given an encoded string consisting of a sequence $s of numeric characters: 0..9. Write a script to find the all valid different decodings in sorted order.

Solution

twice_greater(X, Y, TwiceGreater):-
    X \== Y,
    TwiceY is 2 * Y,
    X >= TwiceY,
    TwiceGreater = -1.
twice_greater(X, Y, TwiceGreater):-
    TwiceY is 2 * Y,
    X < TwiceY,
    TwiceGreater = 1.

twice_largest(List):-
    max_list(List, Max),
    maplist(twice_greater(Max), List, TwiceGreater),
    delete(TwiceGreater, -1, TwiceGreaterOneDeleted), 
    length(TwiceGreaterOneDeleted, TwiceGreaterOneDeletedLength),
    TwiceGreaterOneDeletedLength == 1, !.

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- twice_largest([1, 2, 3, 4]).

no
| ?- twice_largest([1, 2, 0, 5]).

yes
| ?- twice_largest([2, 6, 3, 1]).

yes
| ?- twice_largest([4, 5, 2, 3]).

no

Notes

There are a few ways one could approach this problem. I thought this implementation was nice and concise, albeit unconventional. maplist/3 is used to generate a list with entries corresponding to whether or not the respective element, times two, in the original List was more or less than the List Max. If we find only one element fails this, the List Max itself, then twice_largest/1 is true.

Part 2

You are given an integer, 0 < $n <= 15. Write a script to find the number of orderings of numbers that form a cute list.

Solution

cute(_, _) --> [].
cute(N, CuteList) --> [X], {between(1, N, X), \+ member(X, CuteList), 
                            length(CuteList, CuteListLength),
                            succ(CuteListLength, I),
                            (0 is mod(X, I); 0 is mod(I, X)),
                            append(CuteList, [X], CuteListUpdated)}, 
                            cute(N, CuteListUpdated).

main:-
    N = 15, 
    findall(Cute, (length(Cute, N), phrase(cute(N, []), Cute)), C), 
    sort(C, CuteList), 
    length(CuteList, NumberCuteList),
    write(NumberCuteList), nl.         

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- main.
24679

Notes

This is a somewhat convoluted use of a DCG and, in turn, the DCG code itself might be a bit convoluted. Here the DCG will generate all lists which conform to the given rules. There ends up being some duplication which is natural given the condition. To remove the duplicates I sort/2 the results.

References

Challenge 191

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

Part 1

You are given a string with alphabetic characters only: A..Z and a..z. Write a script to find out if the usage of Capital is appropriate if it satisfies at least one of the rules.

Solution

all_small([]).
all_small([H|T]):-
    H >= 97,
    H =< 122,   
    all_small(T).

all_capitals([]).
all_capitals([H|T]):-
    H >= 65,
    H =< 90,   
    all_capitals(T).

capital_detection([]).
capital_detection([H|T]):-
    H >= 65,
    H =< 90,
    all_capitals(T).
capital_detection([H|T]):-
    H >= 65,
    H =< 90,
    all_small(T).    
capital_detection([H|T]):-
    H >= 97,
    H =< 122,
    all_small(T).    

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- capital_detection("Perl").

true ? 

yes
| ?- capital_detection("TPF"). 

true ? 

(1 ms) yes
| ?- capital_detection("PyThon").

no
| ?- capital_detection("raku").  

yes

Notes

The rules to be satisfied are:

1) Only first letter is capital and all others are small.

2) Every letter is small.

3) Every letter is capital.

While I know it is not everyone's favorite way of handling strings in Prolog, I prefer to stick with the codes representation of double quotes strings. Here the solution is pretty straightforward, with the code being in most ways a direct translation of the rules.

Part 2

You are given an encoded string consisting of a sequence $s of numeric characters: 0..9. Write a script to find the all valid different decodings in sorted order.

Solution

digits([1, 2]).

alphabet(1, 'A').
alphabet(2, 'B').
alphabet(3, 'C').
alphabet(4, 'D').
alphabet(5, 'E').
alphabet(6, 'F').
alphabet(7, 'G').
alphabet(8, 'H').
alphabet(9, 'I').
alphabet(10,'J').
alphabet(11, 'K').
alphabet(12, 'L').
alphabet(13, 'M').
alphabet(14, 'N').
alphabet(15, 'O').
alphabet(16, 'P').
alphabet(17, 'Q').
alphabet(18, 'R').
alphabet(19, 'S').
alphabet(20, 'T').
alphabet(21, 'U').
alphabet(22, 'V').
alphabet(23, 'W').
alphabet(24, 'X').
alphabet(25, 'Y').
alphabet(26, 'Z').

list_chunks(_, [], []).
list_chunks(List, [H|T], [PrefixNumber|RestNumbers]):-
    length(Prefix, H),
    prefix(Prefix, List),
    append(Prefix, Rest, List),
    number_codes(PrefixNumber, Prefix),
    list_chunks(Rest, T, RestNumbers).

sum(Digits, Length):-
    sum([], Digits, Length, 0).

sum(Digits, Digits, _, _). 
sum(Partial, Digits, Length, Sum):-   
    Sum < Length, 
    digits(L),
    member(X, L),
    S is Sum + X,
    sum([X | Partial], Digits, Length, S). 

decode(Encoded, Decoded):-
    number_codes(Encoded, EncodedCodes),
    length(EncodedCodes, EncodedLength),
    findall(Digits,(
        sum(Digits, EncodedLength), 
        sum_list(Digits, EncodedLength)), DigitList),
    findall(Chunks, (
        member(ChunkSizes, DigitList),
        list_chunks(EncodedCodes, ChunkSizes, Chunks)), ChunkList),
    findall(DecodedChunk,(
        member(C, ChunkList),
        maplist(alphabet, C, DecodedChunkChars),
        atom_chars(DecodedChunk, DecodedChunkChars)), Decoded).  

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- decode(11, Decoded).

Decoded = ['AA','K']

yes
| ?- decode(1115, Decoded).

Decoded = ['AAAE','KAE','AKE','AAO','KO']

(1 ms) yes
| ?- decode(127, Decoded). 

Decoded = ['ABG','LG']

yes

Notes

There is an element of this task which reminded me of a much older problem presented back in TWC 075. In brief, the question was how many ways could coins be used in combination to form a target sum. My solution used a mix of Prolog and Perl since Prolog is especially well suited for elegant solutions to these sorts of combinatorial problems.

I recognized that this week we have a similar problem in how we may separate the given encoded string into different possible chunks for decoding. Here we know that no chunk may have value greater than 26 and so we can only choose one or two digits at a time. How many ways we can make these one or two digit chunks is the exact same problem, somewhat in hiding, as in TWC 075!

For the Perl Solutions to this problem I re-used much of that older code mentioned above. Also, that Prolog code which was embedded in the Perl code was used as the basis for this pure Prolog solution.

decode/2 is the main predicate. We need to work across all possible splits of the list of the number and it's easiest to use findall/3 to cover the splitting of the number, the chunking, and the final decoding of all possible combinations.

References

Challenge 190

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

Part 1

You are given an array of characters (a..z) and a target character. Write a script to find out the smallest character in the given array lexicographically greater than the target character.

Solution

greater_than_character(Target, C0, C1):-
    C0 > Target,
    C1 = C0.   
greater_than_character(Target, C0, C1):-
    \+ C0 > Target,
    C1 = nil.  

greater_character(Characters, Target, Greater):-
    maplist(greater_than_character(Target), Characters, GreaterCharacters),
    delete(GreaterCharacters, nil, GreaterCharactersNonNil),
    length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
    GreaterCharactersNonNilLength > 0,
    min_list(GreaterCharactersNonNil, GreaterChar),
    char_code(Greater, GreaterChar), !.    
greater_character(Characters, [Target], Greater):-
    maplist(greater_than_character(Target), Characters, GreaterCharacters),
    delete(GreaterCharacters, nil, GreaterCharactersNonNil),
    length(GreaterCharactersNonNil, GreaterCharactersNonNilLength),
    GreaterCharactersNonNilLength == 0,
    char_code(Greater, Target), !.    

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- greater_character("emug", "b", LeastGreaterCharacter).

LeastGreaterCharacter = e

(1 ms) yes
| ?- greater_character("dcef", "a", LeastGreaterCharacter).

LeastGreaterCharacter = c

yes
| ?- greater_character("jar", "o", LeastGreaterCharacter). 

LeastGreaterCharacter = r

(1 ms) yes
| ?- greater_character("dcaf", "a", LeastGreaterCharacter).

LeastGreaterCharacter = c

(1 ms) yes
| ?- greater_character("tgal", "v", LeastGreaterCharacter).

LeastGreaterCharacter = v

yes

Notes

First off, I should note that the use of double quoted strings here might confuse some people. To clarify, in GNU Prolog what look like double quoted strings are handled as lists of character codes. Character codes, not characters! So the use of Character in some variable names may seem a little distracting. They are accurate in intent, but if you are unaware of what's going on it may seem a little strange.

For the solution itself I use a trick with maplist/3 that I have used previously. greater_than_character/3 will either return the character greater than the target or nil otherwise. min_list/2 is then used to get the smallest character which is greater than the target, as required. Also, note that in the case no character is found to be greater than the target we instead supply the target itself.

Part 2

You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.

Solution

array_degree(Array, Degree):-
    array_degree(Array, Array, 0, Degree), !.
array_degree([], _, Degree, Degree).    
array_degree([H|T], Array, DegreeAccum, Degree):-
    length(Array, ArrayLength),
    delete(Array, H, ArrayWithout),    
    length(ArrayWithout,ArrayWithoutLength),
    CurrentDegree is ArrayLength - ArrayWithoutLength,
    CurrentDegree > DegreeAccum,
    array_degree(T, Array, CurrentDegree, Degree).
array_degree([H|T], Array, DegreeAccum, Degree):-
    length(Array, ArrayLength),
    delete(Array, H, ArrayWithout),    
    length(ArrayWithout,ArrayWithoutLength),
    CurrentDegree is ArrayLength - ArrayWithoutLength,
    \+ CurrentDegree > DegreeAccum,
    array_degree(T, Array, DegreeAccum, Degree).    

least_slice_degree(Array, LeastDegreeSlice):-
    array_degree(Array, ArrayDegree),
    findall(Sublist, (prefix(Prefix, Array), suffix(Suffix, Array), 
                      sublist(Sublist, Array), length(Sublist, SublistLength), 
                      SublistLength >= 2, flatten([Prefix, Sublist, Suffix], Array)), Sublists),
    sort(Sublists, Slices),                  
    findall(DegreeSlice, (member(Slice, Slices), array_degree(Slice, Degree), DegreeSlice = Degree-Slice), DegreeSlices),
    findall(MatchingSlice, (member(DegreeSlice, DegreeSlices), ArrayDegree-MatchingSlice = DegreeSlice), MatchingSlices),
    findall(LengthSlice, (member(MatchingDegreeSlice, MatchingSlices), length(MatchingDegreeSlice, MatchingDegreeSliceLength), LengthSlice = MatchingDegreeSliceLength-MatchingDegreeSlice), LengthSlices),
    keysort(LengthSlices),
    [_-LeastDegreeSlice|_] = LengthSlices. 

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- least_slice_degree([1, 3, 3, 2], LeastDegreeSlice).   

LeastDegreeSlice = [3,3]

(6 ms) yes
| ?- least_slice_degree([1, 2, 1, 3], LeastDegreeSlice). 

LeastDegreeSlice = [1,2,1]

(6 ms) yes
| ?- least_slice_degree([1, 3, 2, 1, 2], LeastDegreeSlice). 

LeastDegreeSlice = [2,1,2]

(19 ms) yes
| ?- least_slice_degree([1, 1, 2, 3, 2], LeastDegreeSlice). 

LeastDegreeSlice = [1,1]

(19 ms) yes
| ?- least_slice_degree([2, 1, 2, 1, 1], LeastDegreeSlice).       

LeastDegreeSlice = [1,2,1,1]

(20 ms) yes

Notes

This is the most I've used findall/3 in a long time! The main complexity here, I feel, is in that we must compute all contiguous slices of the original list. sublist/2 is not useful by itself here as it returns sublists which are not contiguous, only ordered. With the help of prefix/2 and suffix/2 we are able to identify contiguous sublists.

findall/3 is used, then, to obtain and then process all of these contiguous slices to ultimately identify the one that meets all criteria. First we identify all slices, then we obtain all degree/slice pairs, and then finally we examine the lengths.

References

Challenge 189

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

Part 1

You are given list of integers @list of size $n and divisor $k. Write a script to find out count of pairs in the given list that satisfies a set of rules.

Solution

divisible_pair(Numbers, K, Pair):-
    length(Numbers, NumbersLength),
    between(1, NumbersLength, I),
    succ(I, INext),
    between(INext, NumbersLength, J),
    nth(I, Numbers, Ith),
    nth(J, Numbers, Jth),
    IJModK is (Ith + Jth) mod K,
    IJModK == 0,
    Pair = [I, J].

divisible_pairs(Numbers, K, Pairs):-
    findall(Pair, divisible_pair(Numbers, K, Pair), Pairs).    

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- divisible_pairs([4, 5, 1, 6], 2, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[2,3]]

(1 ms) yes
| ?- divisible_pairs([1, 2, 3, 4], 2, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,3],[2,4]]

(1 ms) yes
| ?- divisible_pairs([1, 3, 4, 5], 3, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[3,4]]

yes
| ?- divisible_pairs([5, 1, 2, 3], 4, Pairs), length(Pairs, NumberPairs).

NumberPairs = 2
Pairs = [[1,4],[2,4]]

yes
| ?- divisible_pairs([7, 2, 4, 5], 4, Pairs), length(Pairs, NumberPairs).

NumberPairs = 1
Pairs = [[1,4]]

yes

Notes

The rules, if not clear from the above code are : the pair (i, j) is eligible if and only if

• 0 <= i < j < len(list)

• list[i] + list[j] is divisible by k

There really is not too much here beyond translating the rules into Prolog. The first condition on i and j are handled by default using between/3. Once we define how to find one such pair we use findall/3 to obtain them all.

Part 2

You are given two positive integers $x and $y. Write a script to find out the number of operations needed to make both ZERO.

Solution

count_zero(X, Y, Count):-
    count_zero(X, Y, 0, Count), !.
count_zero(0, 0, Count, Count).    
count_zero(X, Y, CountAccum, Count):-
    X > Y,
    XNew is X - Y,
    succ(CountAccum, CountAccumSucc), 
    count_zero(XNew, Y, CountAccumSucc, Count).
count_zero(X, Y, CountAccum, Count):-
    Y > X,
    YNew is Y - X,
    succ(CountAccum, CountAccumSucc), 
    count_zero(X, YNew, CountAccumSucc, Count).    
count_zero(X, Y, CountAccum, Count):-
    X == Y,
    XNew is X - Y,
    YNew is Y - X,
    succ(CountAccum, CountAccumSucc), 
    count_zero(XNew, YNew, CountAccumSucc, Count).   

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- count_zero(5, 4, Count).

Count = 5

(1 ms) yes
| ?- count_zero(4, 6, Count).

Count = 3

yes
| ?- count_zero(2, 5, Count).

Count = 4

yes
| ?- count_zero(3, 1, Count).

Count = 3

yes
| ?- count_zero(7, 4, Count).

Count = 5

yes

Notes

The operations are dictated by these rules:

• $x = $x - $y if $x >= $y

or

• $y = $y - $x if $y >= $x (using the original value of $x)

Be carefully examining the rules we can see that we can arrange count_zero/4 predicates in a somewhat concise way. I find this preferable to Prolog's if/else syntax which absolutely could have been used here. I would argue that the slightly longer form here is worthwhile in that it is much more readable.

One thing I found especially convenient was that due to the immutable nature of Prolog variables we don;t have to do any extra accounting for the possibly changed value of X when computing an updated Y. The Perl solution to this requires a temporary variable, for example.

References

Challenge 188

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

Part 2

You are given a list of positive numbers, @n, having at least 3 numbers. Write a script to find the triplets (a, b, c) from the given list that satisfies a set of rules.

Solution

magical_triple_sum(Numbers, Triple, TripleSum):-
    sublist([A, B, C], Numbers),
    A + B > C,
    B + C > A,
    A + C > B,
    Triple = [A, B, C],
    sum_list(Triple, TripleSum).

magical_triple(Numbers, Triple):-
    fd_maximize(magical_triple_sum(Numbers, Triple, TripleSum), TripleSum). 

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- magical_triple([4, 2, 3], Triple).

Triple = [4,2,3] ? 

(1 ms) yes
| ?- magical_triple([1, 3, 2], Triple). 

no
| ?- magical_triple([1, 1, 3, 2], Triple).

no
| ?- magical_triple([1, 2, 3, 2], Triple).

Triple = [2,3,2] ? 

yes

Notes

The "magical" rules, if not clear from the above code are:

• a + b > c

• b + c > a

• a + c > b

• a + b + c is maximum.

I don't routinely do a lot of constraint programming, but I don't think a smaller solution for this can be written! Indeed, the code here is largely a rewriting of the given rules in slightly modified Prolog form.

References

Challenge 187

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

Part 1

You are given two lists of the same size. Write a predicate that merges the two lists.

Solution

zip([], [], []).
zip([Ha|Ta], [Hb|Tb], [Ha, Hb|Tc]):-
    zip(Ta, Tb, Tc).

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- zip([1,2,3],[a,b,c],C).

C = [1,a,2,b,3,c]

Notes

This is a great simple example of recursion in Prolog. If there is any doubt about what is happening here is what trace/0 shows:

| ?- trace.
The debugger will first creep -- showing everything (trace)

yes
{trace}
| ?- zip([1,2,3],[a,b,c],C).
      1    1  Call: zip([1,2,3],[a,b,c],_38) ? 
      2    2  Call: zip([2,3],[b,c],_73) ? 
      3    3  Call: zip([3],[c],_102) ? 
      4    4  Call: zip([],[],_131) ? 
      4    4  Exit: zip([],[],[]) ? 
      3    3  Exit: zip([3],[c],[3,c]) ? 
      2    2  Exit: zip([2,3],[b,c],[2,b,3,c]) ? 
      1    1  Exit: zip([1,2,3],[a,b,c],[1,a,2,b,3,c]) ? 

Given that we know the lists are of the same size we have an extremely elegant solution. That is, we state that the first argument is an element, followed by the rest of the list, and the same goes for the second argument. For the third argument we state that its head is the combined initial two elements from the first and second lists and this unifies our uninstantiated variable.

References

Challenge 186

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

Part 1

You are given a string. Write a script to find out the first unique character in the given string and print its index (0-based).

Solution

index_first_unique(Words, IndexUnique):-
    index_first_unique(Words, 0, IndexUnique).
index_first_unique(String, I, IndexUnique):-
    succ(I, Index),
    length(String, Length),
    nth(Index, String, Character),
    delete(String, Character, Deleted),
    length(Deleted, LengthDeleted),
    LengthDifference is Length - LengthDeleted,
    LengthDifference == 1, !, 
    IndexUnique = I.
index_first_unique(String, I, IndexUnique):-
    succ(I, Index),
    length(String, Length),
    nth(Index, String, Character),
    delete(String, Character, Deleted),
    length(Deleted, LengthDeleted),
    LengthDifference is Length - LengthDeleted,
    \+ LengthDifference == 1,
    succ(I, X),
    index_first_unique(String, X, IndexUnique).

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- index_first_unique("Long Live Perl", IndexUnique). 

IndexUnique = 1

yes
| ?- index_first_unique("Perl Weekly Challenge", IndexUnique).

IndexUnique = 0

yes
| ?- index_first_unique("aabbcc", IndexUnique).

no
| ?- index_first_unique("Prolog Solution to Perl Weekly Challenge", IndexUnique). 

IndexUnique = 7

yes

Notes

The main steps here are to check to see if after a character is deleted from the list if the new list length only varies from the original by 1. If so, then we are done. In the case the list is exhausted without finding a unique character the predicate simply fails.

Also note that GNU Prolog's nth/3 assumes 1 indexing and so to get the correct 0 based answer we do an extra succ/2.

Part 2

You are given list of numbers and an integer. Write a script to trim the given list when an element is less than or equal to the given integer.

Solution

trimmer(X, Y, Z):-
    X < Y,
    Z = Y.
trimmer(X, Y, Z):-
    X >= Y,
    Z = 'trimmed'.

trim_list(Numbers, I, TrimmedList):-
    maplist(trimmer(I), Numbers, PartialTrimmedList),
    delete(PartialTrimmedList, 'trimmed', TrimmedList).

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- trim_list([1, 4, 2, 3, 5], 3, TrimmedList).

TrimmedList = [4,5] ? 

yes
| ?- trim_list([9, 0, 6, 2, 3, 8, 5], 4, TrimmedList).

TrimmedList = [9,6,8,5] ? 

yes

Notes

maplist/3 is always tempting to use when required to process a list. In order to get the effect that we want, however, requires that the predicate used in the maplist succeed for each value of the list to be processed. Here trimmer/3 will either succeed with the numerical value that passes that comparison or succeed and provide the atom trimmed for values in the list that fail the comparison. The resulting list is then used with delete/3 to get the final list containing only the numerical values required.

References

Challenge 180

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

Part 1

You are given a positive number, $n. Write a script to validate the given number against the included check digit.

Solution

damm_matrix(0, [0, 7, 4, 1, 6, 3, 5, 8, 9, 2]).
damm_matrix(1, [3, 0, 2, 7, 1, 6, 8, 9, 4, 5]).
damm_matrix(2, [1, 9, 0, 5, 2, 7, 6, 4, 3, 8]).
damm_matrix(3, [7, 2, 6, 0, 3, 4, 9, 5, 8, 1]).
damm_matrix(4, [5, 1, 8, 9, 0, 2, 7, 3, 6, 4]).
damm_matrix(5, [9, 5 ,7, 8, 4, 0, 2, 6, 1, 3]).
damm_matrix(6, [8, 4, 1, 3, 5, 9, 0, 2, 7, 6]).
damm_matrix(7, [6, 8, 3, 4, 9, 5, 1, 0, 2, 7]).
damm_matrix(8, [4, 6, 5, 2, 7, 8, 3, 1, 0, 9]).
damm_matrix(9, [2, 3, 9, 6, 8, 1, 4, 7, 5, 0]).

damm_validate(N):-
    number_chars(N, NChars),
    damm_validate(NChars, 0).
damm_validate([], InterimDigit):-
    InterimDigit == 0.    
damm_validate([H|T], InterimDigit):-
    number_chars(N, [H]),
    damm_matrix(N, DammRow),
    succ(InterimDigit, I),
    nth(I, DammRow, NextInterimDigit),
    damm_validate(T, NextInterimDigit). 

Sample Run

| ?- damm_validate(5727).

(1 ms) no
| ?- damm_validate(5724).

yes

Notes

The beauty of Prolog is when it's implicit features such as backtracking and unification are exclusively leveraged to obtain a beautiful solution. This is not one of those cases! This is pure recursion, more functional than logical. I can't think of a more elegant way to express this Damm Validation process, however. Essentially we are performing a series of lookups from a table. I could see this being done with a DCG, perhaps. But in that case we wouldn't really be making anything more elegant, I would argue, just removing the explicit recursion while still having to do the same sort of lookups. It would probably end up being more code than this!

Anyway, Damm Validation is pretty succinctly expressed, it's just that the algorithm doesn't seem to really lend itself to being made much more logically implemented.

Part 2

Write a script to generate first 20 Palindromic Prime Cyclops Numbers.

Solution

cyclops(X):-
    number_chars(X, XChars),
    length(XChars, XCharsLength),
    XCharsLengthMinusOne is XCharsLength - 1,
    delete(XChars, '0', XCharsNoZero),
    length(XCharsNoZero, NoZeroLength),
    NoZeroLength == XCharsLengthMinusOne,
    append(Beginning, ['0'|End], XChars),
    length(Beginning, BeginningLength),
    length(End, EndLength),
    BeginningLength == EndLength.

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

palindrome_prime(Prime):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(100, MAX_INTEGER, Prime),
    palindrome(Prime),
    fd_prime(Prime).

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

main:-
    length(PalindromicPrimeCyclops, 5),
    phrase(palindromic_prime_cyclops([]), PalindromicPrimeCyclops),
    write(PalindromicPrimeCyclops), nl.

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- length(PalindromicPrimeCyclops, 20), phrase(palindromic_prime_cyclops([]), PalindromicPrimeCyclops).

PalindromicPrimeCyclops = [101,16061,31013,35053,38083,73037,74047,91019,94049,1120211,1150511,1160611,1180811,1190911,1250521,1280821,1360631,1390931,1490941,1520251] ? 

Notes

This borrows a quite a bit of code from previous challenges! Probably the newest thing here is the checking of the cyclops condition. In cyclops/1 we first check to see if there is a single zero. This is done by removing all zeroes with delete/3 and then confirming, by checking lengths, that only one was removed. After that we split the list around the '0' using append/3 and if the sublists before and after the '0' are of the same size we know we have a cyclops number. Notice that it only matters that they are equal. Whether they are of even length or odd length doesn't matter since we know we have just a single '0' and so the length of the entire list is necessarily of odd length, as required.

References

Challenge 177

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

permuted(X, Y):-
    number_chars(X, XChars),
    number_chars(Y, YChars),
    msort(XChars, XCharsSorted),
    msort(YChars, YCharsSorted),
    XCharsSorted == YCharsSorted.

permuted_multiple(Permuted):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, X),
    X2 is 2 * X,
    X3 is 3 * X,
    X4 is 4 * X,
    X5 is 5 * X,
    X6 is 6 * X,
    permuted(X, X2), permuted(X2, X3), 
    permuted(X3, X4), permuted(X4, X5), permuted(X5, X6),
    Permuted = X.

Sample Run

| ?- permuted_multiple(Permuted).

Permuted = 142857 ? 

(2150 ms) yes

Notes

I implemented solutions for this problem in multiple languages and compared side by side on the same system this Prolog solution ran the fastest. I think that's because in Prolog the logic can be (naturally!) expressed very succinctly and so the underlying instructions getting executed are most efficient. Other implementations seem to require a bit more overhead, such as when deconstructing an integer into a list of digits for example.

The task here is for us to generate the smallest integer with this permutable property. Technically the code here will generate all such numbers, however in search of other solutions it seems there is just the one found before we exceed the bounds of MAX_INTEGER.

Part 2

Write a script to find out all Reversible Numbers below 100.

Solution

all_odd([]).
all_odd([H|T]):-
    number_chars(Digit, [H]),
    M is mod(Digit, 2),
    M == 1,
    all_odd(T).

reversible(X):-
    number_chars(X, XChars),
    reverse(XChars, XCharsReversed),
    number_chars(R, XCharsReversed),
    Sum is X + R, 
    number_chars(Sum, SumChars),
    all_odd(SumChars).

reversible_under_n(N, Reversible):-
    between(1, N, X),
    reversible(X),
    Reversible = X.

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- reversible_under_n(100, Reversibles).

Reversibles = 10 ? a

Reversibles = 12

Reversibles = 14

Reversibles = 16

Reversibles = 18

Reversibles = 21

Reversibles = 23

Reversibles = 25

Reversibles = 27

Reversibles = 30

Reversibles = 32

Reversibles = 34

Reversibles = 36

Reversibles = 41

Reversibles = 43

Reversibles = 45

Reversibles = 50

Reversibles = 52

Reversibles = 54

Reversibles = 61

Reversibles = 63

Reversibles = 70

Reversibles = 72

Reversibles = 81

Reversibles = 90

(10 ms) no

Notes

Here we also use Prolog's ability to identify multiple solutions to generate all solutions less than 100, as required.

References

Challenge 176

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 19 Disarium Numbers.

Solution

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

sum_power(Digits, Sum):-
    sum_power(Digits, 0, 0, Sum).
sum_power([], _, Sum, Sum).
sum_power([H|T], I, PartialSum, Sum):-   
    succ(I, N),
    number_chars(X, [H]),
    Partial is PartialSum + round(X ** N),
    sum_power(T, N, Partial, Sum).

disarium(X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(0, MAX_INTEGER, X),
    number_chars(X, Chars),
    sum_power(Chars, Sum),
    Sum == X.

n_disariums(N, Disariums):-
    length(Disariums, N), 
    phrase(disariums([]), Disariums). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- n_disariums(19, Diariums).

Diariums = [0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798] ? 

References

Challenge 174

Disarium Numbers

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 twenty Abundant Odd Numbers.

Solution

proper_divisors(X, Divisors):-
    Half is X // 2,
    findall(Divisor,(
        between(1, Half, Divisor),
        M is mod(X, Divisor),
        M == 0
    ), Divisors).

abundants_odd(_) --> [].
abundants_odd(Previous) --> [X], {abundant_odd(Previous, X)}, abundants_odd(X).

abundant_odd(Previous, X):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(Previous, MAX_INTEGER, X),
    X > Previous,
    M is mod(X, 2),
    M == 1,
    proper_divisors(X, Divisors),
    sum_list(Divisors, DivisorsSum),
    DivisorsSum > X.

n_abundants(N, Abundants):-
    length(Abundants, N), 
    phrase(abundants_odd(-1), Abundants). 

Sample Run

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

Abundants = [945,1575,2205,2835,3465,4095,4725,5355,5775,5985,6435,6615,6825,7245,7425,7875,8085,8415,8505,8925] ? 

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.

Part 2

Create sub compose($f, $g) which takes in two parameters $f and $g as subroutine refs and returns subroutine ref i.e. compose($f, $g)->($x) = $f->($g->($x)).

Solution

f(S, T):-
    T is S + S.

g(S, T):-
    T is S * S.

compose(F, G, H):-
    asserta((h(X, Y) :- call(G, X, X0), call(F, X0, Y))),
    H = h.

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- compose(f, g, H), A =.. [H, 7, X], A.

A = h(7,98)
H = h
X = 98

yes
| ?- 

Notes

This challenge is posed as being Perl specific and while most any language is able to do more or less what is asked for, this is a bit of a strange thing to do in Prolog.

In general, Prolog would dicate the use of a meta-interpreter for this sort of thing, instead of this sort of Functional Programming practice. Sticking to the letter of the challenge I was able to cobble something together with asserta/1 and the univ operator (=..)/2.

An assumption made in my code is that we know ahead of time the number of arguments to predicates F and G and that we also know which variables are instantiated or not. Those assumptions greatly simplify things and we can compose the two predicates in this way. Without that assumption the code would explode in complexity as we would need to examine whether variables are instantiated or not and then make possibly incorrect new assumptions that they, in fact, should have been or not.

References

Challenge 171

A Couple of Meta-interpreters in Prolog

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

Calculate the first 13 Perrin Primes.

Solution

perrin_primes(A, B, C) --> {D is B + A, fd_not_prime(D)}, 
                           perrin_primes(B, C, D).
perrin_primes(A, B, C) --> {D is B + A, fd_prime(D), D \== C}, 
                           [D], perrin_primes(B, C, D).
perrin_primes(A, B, C) --> {D is B + A, fd_prime(D), D == C}, 
                           [], perrin_primes(B, C, D).                           
perrin_primes(_, _, _) --> [], !.

n_perrin_primes(N, PerrinPrimes):-
    length(PerrinPrimes, N), 
    phrase(perrin_primes(3, 0, 2), PerrinPrimes). 

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- n_perrin_primes(13, PerrinPrimes).

PerrinPrimes = [3,2,5,7,17,29,277,367,853,14197,43721,1442968193,792606555396977] ? 

Notes

This is a pretty cut and dry use of a DCG to generate this interesting mathematical sequence. A couple of things that stand out are (1) the condition that D \== C which is to remove the duplicate 5 which occurs naturally at the beginning of the sequence. Afterwards all of the terms strictly increase. Also, (2) although the first two terms are indeed 3, 2 it is a convention to sort these and present them as 2, 3 although I did not happen to do so here.

Part 2

You are given an integer greater than 1. Write a script to find the home prime of the given number.

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

factor_concat(Factors, Atom):-
    factor_concat(Factors, '', Atom).
factor_concat([], Atom, Atom).
factor_concat([H|T], AtomAccum, Atom):-
    number_atom(H, A),
    atom_concat(AtomAccum, A, UpdatedAtomAccum),
    factor_concat(T, UpdatedAtomAccum, Atom).

home_prime(N, HomePrime):-
    prime_factors(N, Factors),
    factor_concat(Factors, A),
    number_atom(Number, A),
    fd_not_prime(Number),
    home_prime(Number, HomePrime).    
home_prime(N, HomePrime):-
    prime_factors(N, Factors),
    factor_concat(Factors, A),
    number_atom(Number, A),
    fd_prime(Number),
    HomePrime = Number. 

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- home_prime(16, HomePrime).

HomePrime = 31636373 ? 

(4 ms) yes
| ?- home_prime(54, HomePrime). 

HomePrime = 2333 ? 

(1 ms) yes
| ?- home_prime(108, HomePrime).

HomePrime = 23971 ? 

yes

Notes

Here we are asked to compute the Home Prime of any given number. The process for doing so is, given N to take the prime factors for N and concatenate them together. If the result is prime then we are done, that is the Home Prime of N, typically written HP(N). This is an easy process to repeat, and in many cases the computation is a very quick one. However, in some cases, the size of the interim numbers on the path to HP(N) grow extremely large and the computation bogs down. I have used the prime factorization code here in several other weekly challenges and it is quite performant but even this runs rather slowly as we are faced with extremely large numbers.

References

Challenge 168

Home Prime

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

Part 1

Plot lines and points in SVG format.

Solution

svg-->svg_begin, svg_body, svg_end.
svg_body-->[].
svg_body-->svg_line(_, _, _, _), svg_body.
svg_body-->svg_point(_, _), svg_body.
svg_begin-->['<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">'].
svg_point(X, Y)-->['<circle cx="', X,'" cy="', Y, '" r="1" />'].
svg_line(X1, Y1, X2, Y2)-->['<line x1="', X1, '" x2="', X2, '" y1="', Y1, '" y2="', Y2, '" style="stroke:#006600;" />'].
svg_end-->[''].

plot([], SVGAccum, SVG):-
    phrase(svg_begin, Begin),
    flatten([Begin|SVGAccum], SVG).
plot([H|T], SVGAccum, SVG):-
    length(H, 2),
    [X, Y] = H,
    phrase(svg_point(X, Y), Point),
    plot(T, [Point|SVGAccum], SVG).
plot([H|T], SVGAccum, SVG):-
    length(H, 4),
    [X1, Y1, X2, Y2] = H,
    phrase(svg_line(X1, Y1, X2, Y2), Line),
    plot(T, [Line|SVGAccum], SVG).
plot(Lines, SVG):-
    phrase(svg_end, End),
    plot(Lines, [End], SVG).

main:-
     plot([[53,10], [53, 10, 23, 30], [23, 30]], SVG),
     maplist(write, SVG), nl,
     halt.

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"><circle cx="23" cy="30" r="1" /><line x1="53" x2="23" y1="10" y2="30" /><circle cx="53" cy="10" r="1" /></svg>

Notes

SVG is an XML based format, and so the use of a DCG like this may be unexpected. After all, the "grammar" is really dictated by a known XML schema. Still, the DCG is helpful in that we can describe the sequence and formatting of the statements we expect. From this we can generate the required SVG and even do some basic validation.

Part 2

Given a list of numbers, generate the skip summations.

Solution

avg_difference(Avg, V, Difference):-
    Difference is V - Avg.

square(X, XSquared):-
    XSquared is X * X.

xy(X, Y, XY):-
    XY is X * Y.

linear_regression(Points, RegressionLineEndpoints):-
    length(Points, NumberPoints),
    % 1. Calculate average of your X variable.
    maplist(nth(1), Points, Xs),
    msort(Xs, XSorted),
    nth(NumberPoints, XSorted, XMax),
    sum_list(Xs, XSum),
    XAvg is XSum / NumberPoints,
    % 2. Calculate the difference between each X and the average X.
    maplist(avg_difference(XAvg), Xs, XDifferences),
    % 3. Square the differences and add it all up. This is Sx.
    maplist(square, XDifferences, XDifferencesSquared),
    sum_list(XDifferencesSquared, Sx), 
    % 4. Calculate average of your Y variable.
    maplist(nth(2), Points, Ys),
    sum_list(Ys, YSum),
    YAvg is YSum / NumberPoints,
    % 5. Multiply the differences (of X and Y from their respective averages) and add them all together.  This is Sxy.
    maplist(avg_difference(YAvg), Ys, YDifferences),
    maplist(xy, XDifferences, YDifferences, XY),
    sum_list(XY, Sxy),
    % 6. Using Sx and Sxy, you calculate the intercept by subtracting Sx / Sxy * AVG(X) from AVG(Y).
    M is Sxy / Sx,
    B is YAvg - (Sxy / Sx * XAvg),
    EndX is XMax + 10,
    EndY is M * EndX + B,
    RegressionLineEndpoints = [0, B, EndX, EndY].

main:-
     Points = [[333,129], [39, 189], [140, 156], [292, 134], [393, 52], [160, 166], [362, 122], [13, 193], [341, 104], [320, 113], [109, 177], [203, 152], [343, 100], [225, 110], [23, 186], [282, 102], [284, 98], [205, 133], [297, 114], [292, 126], [339, 112], [327, 79], [253, 136], [61, 169], [128, 176], [346, 72], [316, 103], [124, 162], [65, 181], [159, 137], [212, 116], [337, 86], [215, 136], [153, 137], [390, 104], [100, 180], [76, 188], [77, 181], [69, 195], [92, 186], [275, 96], [250, 147], [34, 174], [213, 134], [186, 129], [189, 154], [361, 82], [363, 89]],
     linear_regression(Points, RegressionLine),
     write(RegressionLine), nl.

Sample Run

$ gprolog --consult-file prolog/ch-1.p --consult-file prolog/ch-2.p
| ?- Points = [[333,129], [39, 189], [140, 156], [292, 134], [393, 52], [160, 166], [362, 122], [13, 193], [341, 104], [320, 113], [109, 177], [203, 152], [343, 100], [225, 110], [23, 186], [282, 102], [284, 98], [205, 133], [297, 114], [292, 126], [339, 112], [327, 79], [253, 136], [61, 169], [128, 176], [346, 72], [316, 103], [124, 162], [65, 181], [159, 137], [212, 116], [337, 86], [215, 136], [153, 137], [390, 104], [100, 180], [76, 188], [77, 181], [69, 195], [92, 186], [275, 96], [250, 147], [34, 174], [213, 134], [186, 129], [189, 154], [361, 82], [363, 89]],
     linear_regression(Points, RegressionLine), append(Points, [RegressionLine], PointsLine), plot(PointsLine, SVG), maplist(write, SVG), nl. 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?><!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"><svg height="100%" width="100%" xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"><line x1="0" x2="403" y1="200.13227253558171" y2="79.249802930305563" style="stroke:#006600;" /><circle cx="363" cy="89" r="1" /><circle cx="361" cy="82" r="1" /><circle cx="189" cy="154" r="1" /><circle cx="186" cy="129" r="1" /><circle cx="213" cy="134" r="1" /><circle cx="34" cy="174" r="1" /><circle cx="250" cy="147" r="1" /><circle cx="275" cy="96" r="1" /><circle cx="92" cy="186" r="1" /><circle cx="69" cy="195" r="1" /><circle cx="77" cy="181" r="1" /><circle cx="76" cy="188" r="1" /><circle cx="100" cy="180" r="1" /><circle cx="390" cy="104" r="1" /><circle cx="153" cy="137" r="1" /><circle cx="215" cy="136" r="1" /><circle cx="337" cy="86" r="1" /><circle cx="212" cy="116" r="1" /><circle cx="159" cy="137" r="1" /><circle cx="65" cy="181" r="1" /><circle cx="124" cy="162" r="1" /><circle cx="316" cy="103" r="1" /><circle cx="346" cy="72" r="1" /><circle cx="128" cy="176" r="1" /><circle cx="61" cy="169" r="1" /><circle cx="253" cy="136" r="1" /><circle cx="327" cy="79" r="1" /><circle cx="339" cy="112" r="1" /><circle cx="292" cy="126" r="1" /><circle cx="297" cy="114" r="1" /><circle cx="205" cy="133" r="1" /><circle cx="284" cy="98" r="1" /><circle cx="282" cy="102" r="1" /><circle cx="23" cy="186" r="1" /><circle cx="225" cy="110" r="1" /><circle cx="343" cy="100" r="1" /><circle cx="203" cy="152" r="1" /><circle cx="109" cy="177" r="1" /><circle cx="320" cy="113" r="1" /><circle cx="341" cy="104" r="1" /><circle cx="13" cy="193" r="1" /><circle cx="362" cy="122" r="1" /><circle cx="160" cy="166" r="1" /><circle cx="393" cy="52" r="1" /><circle cx="292" cy="134" r="1" /><circle cx="140" cy="156" r="1" /><circle cx="39" cy="189" r="1" /><circle cx="333" cy="129" r="1" /></svg>

Notes

This is mainly an implementation of the same linear regression procedure as used in the Perl solution to the same problem. By consulting the solution to the first problem we can then re-use the same plotting code.

References

Challenge 165

Linear Regression Calculation

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

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

Part 1

You are given a list of numbers. Write a script to calculate the sum of the bitwise & operator for all unique pairs.

Solution

and(N, X, And):-
    And is N /\ X.
sum_and([], 0).
sum_and([H|T], SumAnd):-
    sum_and(T, Sum),
    maplist(and(H), T, Ands),
    sum_list(Ands, AndSum),
    SumAnd is Sum + AndSum.

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- sum_and([1, 2, 3], SumAnd).

SumAnd = 3

yes
| ?- sum_and([2, 3, 4], SumAnd).   

SumAnd = 2

yes
| ?- sum_and([1, 2, 3], 99).    

no
| ?- sum_and([1, 2, 3], 3). 

yes

Notes

It is not too often you see the bitwise operators used in Prolog code! I am kind of a fan of the /\ operator, I mean, it even looks like an upper case 'A', right?

Other than the novelty of the bitwise and I found this task to be well suited for the use of maplist/3 for computing the pairwise and operations across the list of numbers. This is something of a "nested loop" in the sense that recursively the head of the list of numbers is removed and upon each recursive step the maplist is re-performed on the increasingly shorter list.

Part 2

Given a list of numbers, generate the skip summations.

Solution

skip_sum(Numbers, N, Sum):-
    append(Left, [N|_], Numbers),
    sum_list(Left, SumLeft),
    Sum is N + SumLeft.

skip_summations(Numbers, Summations):-
    skip_summations(Numbers, [Numbers], Summations).
skip_summations([], Summations, Summations).
skip_summations([_|T], SummationsAccum, Summations):-
    maplist(skip_sum(T), T, Sums),
    skip_summations(Sums, [Sums|SummationsAccum], Summations).

print_summation(S):-
    write(S),
    write(' ').
print_summations([]).
print_summations([H|T]):-
    print_summations(T),
    maplist(print_summation, H), nl.

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- skip_summations([1, 2, 3, 4, 5], Summations), print_summations(Summations).
1 2 3 4 5 
2 5 9 14 
5 14 28 
14 42 
42 


Summations = [[],[42],[14,42],[5,14,28],[2,5,9,14],[1,2,3,4,5]] ? 

yes
| ?- skip_summations([1, 3, 5, 7, 9], Summations), print_summations(Summations).      
1 3 5 7 9 
3 8 15 24 
8 23 47 
23 70 
70 


Summations = [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,7,9]] ? 

yes
| ?- skip_summations([1, 3, 5, 7, 9], [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,27,9]]).

no
| ?- skip_summations([1, 3, 5, 7, 9], [[],[70],[23,70],[8,23,47],[3,8,15,24],[1,3,5,7,9]]). 

true ? 

yes

Notes

Much like the task above we use a maplist/3 within a recursive step. Here the maplist/3 is used to do the partial sums for each "line" of the output. There is also a maplist/2 used to print the output lines with a space between each element.

Satisfyingly, as shown above, the same code not only generates the skip summations but also validates them as well. This sort of intrinsic Prolog behavior brings joy!

References

Challenge 163

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

Part 1

Write a script to generate the check digit of a given ISBN-13 code.

Solution

weight(-1, 1).
weight(1, 3).

check_sum([], _, 0).
check_sum([H|T], I, CheckSum):-
    N is I * -1,
    check_sum(T, N, C),
    weight(I, Weight),
    CheckSum is H * Weight + C.
isbn_check_digit(ISBN, CheckDigit):-
    check_sum(ISBN, -1, CheckSum),
    Check is mod(CheckSum, 10),
    CheckDigit is 10 - Check.

Sample Run

$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], CheckDigit).

CheckDigit = 7

(1 ms) yes

$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], 3).    

(1 ms) no

$ gprolog --consult-file prolog/ch-1.p 
| ?- isbn_check_digit([9, 7, 8, 0, 3, 0, 6, 4, 0, 6, 1, 5], 7).         

yes

Notes

Sometimes when writing this sort of code I feel the urge to really unleash the power of Prolog and make the most general solution. What would that mean here though? Generate ISBNs for which a given check digit would be valid? While possible it seems like a kind of weird thing to do. Is it interesting to reason about ISBNs in this way? I seem to think that is unlikely.

This code does what seems to reasonable: generate a check digit given an ISBN, or, given both an ISBN and a check digit confirm that the given check digit is the correct one.

References

Challenge 162

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

Part 1

Output or return a list of all abecedarian words in the dictionary, sorted in decreasing order of length.

Solution

check_and_read(10, [] ,_):-
    !.
check_and_read(13, [], _):-
    !.
check_and_read(32, [], _):-
    !.
check_and_read(44, [], _):-
    !.
check_and_read(end_of_file, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

abecedarian(Words, Abecedarian):-
    member(Word, Words),
    atom_chars(Word, Chars),
    sort(Chars, SortedChars),
    atom_chars(W, SortedChars),
    W = Word,
    Abecedarian = Word.

word_length(Word, LengthWord):-
    atom_chars(Word, Chars),
    length(Chars, Length),
    LengthWord = Length-Word. 

abecedarians(Words, Abecedarians):-
    findall(Abecedarian, abecedarian(Words, Abecedarian), A),
    maplist(word_length, A, AL), 
    keysort(AL, ALSorted),
    reverse(ALSorted, Abecedarians).

main:-
    open('dictionary', read, Stream),
    read_data(Stream, Dictionary),
    close(Stream),
    abecedarians(Dictionary, Abecedarians),
    write(Abecedarians), nl, 
    halt.

Sample Run

$ gprolog --consult-file prolog/ch-1.p --entry-goal main
[6-chintz,6-chimps,6-begins,6-almost,6-abhors,5-glory,5-ghost,5-forty,5-flops,5-first,5-filmy,5-films,5-empty,5-dirty,5-deity,5-chops,5-chips,5-chins,5-chimp,5-below,5-begin,5-befit,5-aglow,5-adopt,5-adept,5-abort,5-abhor,4-nosy,4-most,4-mops,4-lost,4-lops,4-know,4-knot,4-imps,4-host,4-hops,4-hips,4-hint,4-hims,4-hilt,4-gory,4-glow,4-gist,4-gins,4-gilt,4-foxy,4-fort,4-flux,4-flow,4-flop,4-fist,4-firs,4-fins,4-film,4-envy,4-elms,4-egos,4-dirt,4-dips,4-dins,4-dims,4-deny,4-dent,4-dens,4-defy,4-deft,4-crux,4-cost,4-copy,4-cops,4-clot,4-city,4-chow,4-chop,4-chip,4-chin,4-cent,4-blow,4-blot,4-bins,4-best,4-bent,4-belt,4-begs,4-amps,4-alms,4-airy,4-airs,4-aims,4-ails,4-ahoy,4-aces,4-ably,4-abet,3-pry,3-opt,3-now,3-not,3-nor,3-mow,3-mop,3-low,3-lot,3-lop,3-joy,3-jot,3-ivy,3-ins,3-imp,3-how,3-hot,3-hop,3-hit,3-his,3-hip,3-him,3-guy,3-got,3-gnu,3-gin,3-fry,3-fox,3-for,3-fly,3-flu,3-fix,3-fit,3-fir,3-fin,3-elm,3-ego,3-dry,3-dot,3-dos,3-dip,3-din,3-dim,3-dew,3-den,3-cry,3-coy,3-cox,3-cow,3-cot,3-cop,3-chi,3-buy,3-boy,3-box,3-bow,3-bop,3-bit,3-bin,3-bet,3-beg,3-art,3-apt,3-any,3-ant,3-amp,3-air,3-aim,3-ail,3-ago,3-ads,3-ado,3-act,3-ace,2-qt,2-ox,2-or,2-no,2-my,2-mu,2-ms,2-ix,2-iv,2-it,2-(is),2-in,2-ho,2-hi,2-go,2-em,2-eh,2-do,2-cs,2-by,2-be,2-ax,2-at,2-as,2-an,2-am,2-ah,2-ad,1-x,1-m,1-a]

Notes

Most of the code here is just for reading the provided dictionary of words. Once that is complete Prolog really shines. abecedarian/2 is the majority of the logic: if a word's characters when sorted and re-assembled are the original word then it is an Abecedarian.

abecedarians/2 is necessary only to fulfill the requirements of the problem specification which is that all Abecedarians be sorted by length and returned in descending order.

References

Challenge 161

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

Part 1

You are given a positive number, $n < 10. Write a script to generate english text sequence starting with the English cardinal representation of the given number, the word "is" and then the English cardinal representation of the count of characters that made up the first word, followed by a comma. Continue until you reach four.

Solution

cardinal(1, one).
cardinal(2, two).
cardinal(3, three).
cardinal(4, four).
cardinal(5, five).
cardinal(6, six).
cardinal(7, seven).
cardinal(8, eight).
cardinal(9, nine).
cardinal(10, ten).

four_is_magic(N) --> {between(1, 9, N), \+N == 4, 
                      cardinal(N, Cardinal), 
                      atom_codes(Cardinal, Codes), 
                      length(Codes, Count)}, 
                      [N-Count], four_is_magic(Count).
four_is_magic(N) -->  {between(1, 9, N), N == 4}, [N-magic].

print_magic([]):-
    nl.
print_magic([H|T]):-
    N-Count = H,
    \+ N == 4,
    cardinal(N, Cardinal),
    cardinal(Count, CountCardinal), 
    format("~a is ~a, ", [Cardinal, CountCardinal]), 
    print_magic(T).
print_magic([H|T]):-
    N-_ = H,
    N == 4,
    cardinal(N, Cardinal),
    format("~a is ~a", [Cardinal, magic]), 
    print_magic(T).

main(N) :-
    phrase(four_is_magic(N), FourIsMagic), 
    print_magic(FourIsMagic).    

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- main(6).
six is three, three is five, five is four, four is magic

true ? 

(1 ms) yes
| ?- main(_).
one is three, three is five, five is four, four is magic

true ? ;
two is three, three is five, five is four, four is magic

true ? ;
three is five, five is four, four is magic

true ? ;
five is four, four is magic

true ? ;
six is three, three is five, five is four, four is magic

true ? ;
seven is five, five is four, four is magic

true ? ;
eight is five, five is four, four is magic

true ? 

(1 ms) yes

Notes

Prolog has an interesting history of generating text. This is one of the more simple applications I will admit. Here I use a DCG to generate the sequence and then a recursive set of predicates to print the associated text.

In typical Prolog fashion, as shown in the sample output, we can not only generate a sequence with a specified starting point, but all such sequences.

Part 2

You are give an array of integers, @n. Write a script to find out the Equilibrium Index of the given array, if found.

Solution

equilibrium_index(Numbers, I):-
    member(N, Numbers),
    append(Left, [N|Right], Numbers),
    sum_list(Left, SumLeft),
    sum_list(Right, SumRight),
    SumLeft == SumRight,
    nth(I, Numbers, N).

main:-
    (equilibrium_index([1, 3, 5, 7, 9], I), format("~d~n", [I]); format("-1~n", _)),
    (equilibrium_index([1, 2, 3, 4, 5], J), format("~d~n", [J]); format("-1~n", _)),
    (equilibrium_index([2, 4, 2], K), format("~d~n", [K]); format("-1~n", _)), halt.   

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- main.
4
-1
2

Notes

This problem was very "Prolog shaped" in my opinion! Just from reading the problem statement I could picture the standard Prolog predicates that could be used here. Prolog is not a language which naturally lends itself to code golf contests but in terms of simple elegance this is quite a compact solution!

References

Challenge 160

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 10 Pernicious Numbers.

Solution

pernicious(_) --> [].
pernicious(Seen) --> [X], x(Seen, X), {set_bits(X, Bits), fd_prime(Bits)}, pernicious([X|Seen]).
x(Seen, X) --> {between(1, 100, X), \+ member(X, Seen)}. 

set_bits(N, X):-
    set_bits(N, 0, X).
set_bits(0, X, X).
set_bits(N, X_Acc, X):-
    B is N /\ 1,
    X0 is X_Acc + B,
    N0 is N >> 1,
    set_bits(N0, X0, X), !.

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- length(Pernicious, 10), phrase(pernicious([]), Pernicious).

Pernicious = [3,5,6,7,9,10,11,12,13,14] ? 

(115 ms) yes
| ?- phrase(pernicious([]), [3, 5, 6]).

true ? 

(95 ms) yes

Notes

DCGs are great aren't they? The ability to have two modes, one to test and the other to create is a joy! The logic here is pretty straightforward and more or less follows straight fromt he definition.

Part 2

Write a script to compute the first 10 distinct Padovan Primes.

Solution

weird(_) --> [].
weird(Seen) --> [X], x(Seen, X), {
    findall(F, factor(X, F), Factors), flatten([1, Factors], FlatFactors),
    sum_list(FlatFactors, FactorSum), 
    FactorSum > X, 
    powerset(FlatFactors, FactorSets),
    maplist(sum_list, FactorSets, FactorSetSums),
    \+ member(X, FactorSetSums)
    }, 
    weird([X|Seen]).
x(Seen, X) --> {between(1, 1000, X), \+ member(X, Seen)}. 

powerset(X,Y):- bagof(S, subseq(S,X), Y).
subseq([], []).
subseq([], [_|_]).
subseq([X|Xs], [X|Ys] ):- subseq(Xs, Ys).
subseq([X|Xs], [_|Ys] ):- append(_, [X|Zs], Ys), subseq(Xs, Zs).

factor(N, Factors):-
    S is round(sqrt(N)),
    fd_domain(X, 2, S),
    R #= N rem X,
    R #= 0,
    Q #= N // X,
    Q #\= X,
    fd_labeling([Q, X]),
    Factors = [Q, X].
factor(N, Factors):-
    S is round(sqrt(N)),
    fd_domain(X, 2, S),
    R #= N rem X,
    R #= 0,
    Q #= N // X,
    Q #= X,
    fd_labeling([Q]),
    Factors = [Q].   

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- phrase(weird([]), [70]).               

true ? 

yes
| ?- length(Weird, 1), phrase(weird([]), Weird).

Weird = [70] ? 

(4 ms) yes

Notes

This solution follows the same generate and test approach I used in the Perl Solution, as far as the testing of the powerset of divisors is concerned anyway. (I'll admit I was too lazy to write my own powerset code so I grabbed someone else's. See the references for a link to the source.)

In my ongoing attempts to improve my DCG skills I implemented this as a DCG which is a bit of overkill for this problem, but it is always nice to be able to generate the sequence as well as validate.

References

Challenge 156

Pernicious Number

Weird Number

Power Set

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

Part 1

Write a script to compute the first 10 distinct Padovan Primes.

Solution

:-initialization(main).

make_lists([], []).
make_lists([Word|Words], [List|Rest]):-
    atom_chars(Word, List),
    make_lists(Words, Rest).

missing_permutation(Word, Permutations, Missing):-
    atom_chars(Word, Chars),
    permutation(Chars, Permutation),
    \+ member(Permutation, Permutations),
    atom_chars(Missing, Permutation).

main:-
    make_lists(['PELR', 'PREL', 'PERL', 'PRLE', 'PLER', 'PLRE', 'EPRL', 'EPLR', 'ERPL',
                'ERLP', 'ELPR', 'ELRP', 'RPEL', 'RPLE', 'REPL', 'RELP', 'RLPE', 'RLEP',
                'LPER', 'LPRE', 'LEPR', 'LRPE', 'LREP'], Permutations),
    missing_permutation('PERL', Permutations, Missing),
    write(Missing), nl,
    halt.

Sample Run

$ gprolog --consult-file prolog/ch-1.p
LERP

Notes

This is a nice place where Prolog really shines compared to the Perl solution to the same problem. That approach requires a good deal of care to properly generalize. The Prolog solution is completely general without any extra work! Here we need only split the starting word into characters and then backtrack through any possible missing permutations with permutation/2 and member/2. Elegant!

Part 2

Write a script to compute the first 10 distinct Padovan Primes.

Solution

padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_not_prime(D)}, [A], padovan_primes(Size, Primes, PrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L < Size}, [A], padovan_primes(Size, Primes, NewPrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, _) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L >= Size, Primes = NewPrimesAccum}, [D].

n_padovan_primes(N, Primes):-
    succ(N, X),
    phrase(padovan_primes(X, PadovanPrimes, [], 1, 1, 1), _),
    [_|Primes] = PadovanPrimes.

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- n_padovan_primes(7, Primes).

Primes = [2,3,5,7,37,151,3329] ? 

(113 ms) yes
| ?-

Notes

If you watch any of the videos on The Power of Prolog YouTube channel you'll learn from Markus Triska that a DCG is the preferable way to handle this sort of problem. Not just because DCGs are a convenient way to process a list in Prolog, but because they can be used to both generate and test solutions. Excellent advice! This code above shows this for a somewhat complicated problem. We must generate the sequence and also determine which of the sequence terms are prime. Primality testing is performed by GNU Prolog's fd_prime/1 and fd_not_prime/1. As the primes are found they are added, along with the most recently computed three sequence terms, as extra arguments.

This solution is very similar to a previous bit of code for Fibonacci Strings.

References

Challenge 154

Padovan Sequence

The Power of Prolog: YouTube Channel

The Power of Prolog

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

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

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

Part 1

_You are given a string, $s, containing mathematical expression. Write a script to print the result of the mathematical expression. To keep it simple, please only accept + - * ().

Solution

:-initialization(main). 

expression(Answer) --> term(Answer).
expression(Answer) --> term(Answer0), [(+)], expression(Answer1), {Answer is Answer0 + Answer1}.
expression(Answer) --> term(Answer0), [(-)], expression(Answer1), {Answer is Answer0 - Answer1}.

term(Answer) --> operand(Answer).
term(Answer) --> operand(Answer0), [(*)], term(Answer1), {Answer is Answer0 * Answer1}.
term(Answer) --> operand(Answer0), [(/)], term(Answer1), {Answer is Answer0 / Answer1}.

operand(X) --> [X], {number(X)}.
operand(Answer) --> ['('],  expression(Answer), [')'].

calculator(Expression, Answer):-
    phrase(expression(Answer), Expression). 

main:-
    calculator([10, (+), 20, (-), 5], AnswerA),
    write(AnswerA), nl,
    calculator(['(', 10, (+), 20, (-), 5, ')', (*), 2], AnswerB),
    write(AnswerB), nl,
    halt.  

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
25
50

Notes

This is the sort of problem which is just so clean and straightforward to implement in Prolog. A DCG is used to describe the expected infix notation of the calculator and that pretty much takes care of it.

Part 2

You are given a positive number, $n. Write a script to find out if the given number is a Stealthy Number.

Solution

:-initialization(main). 

stealthy(N):-
    fd_domain(S, 2, N),
    fd_domain(T, 2, N),
    fd_domain(U, 2, N),
    fd_domain(V, 2, N),
    S * T #= N,
    U * V #= N,
    S + T #= U + V + 1,
    fd_labeling([S, T, U, V]).

main:-
    (stealthy(36), format("~d~n", [1]);format("~d~n", [0])),
    (stealthy(12), format("~d~n", [1]);format("~d~n", [0])),
    (stealthy(6), format("~d~n", [1]);format("~d~n", [0])),
    halt. 

Sample Run

$ gplc prolog/ch-2.p 
$ prolog/ch-2  
1
1
0

Notes

Much like Part 1 of this weeks challenge Prolog really shines in terms of providing a short clean solution. Here we describe the desired property in terms of finite domain variables and Prolog let's us know if any values exist which match those constraints.

References

Challenge 143

Part 1

Advent of Code 2021 Day 13, in summary, involves the simulation of folding a transparent piece of paper. When "folded" properly a correct solution yields points which when plotted reveal a code which is the solution to a puzzle!

Not wanting to spend too much time on plotting I first considered dumping the points to a file and then using a plotting program like gnuplot directly. In the spirit of having a complete self-contained solution, however, I explored what could be done be interfacing with gnuplot using GNU Prolog's popen/3. This worked very well!

Solution

:-dynamic(dots/1).

:-initialization(main).

check_and_read(10, [] ,_):-
    !.
check_and_read(13, [], _):-
    !.
check_and_read(32, [], _):-
    !.
check_and_read(44, [], _):-
    !.
check_and_read(end_of_file, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

gnuplot_command(Command, PlotStream):-
    repeat,                           % START REPEAT
    length(Command, CommandLength),
    between(1, CommandLength, N),
    nth(N, Command, CommandCode),
    put_code(PlotStream, CommandCode),
    N  == CommandLength,              % END REPEAT
    nl(PlotStream).

plot_configuration(PlotStream):-
    popen('/usr/pkg/bin/gnuplot', 'write', PlotStream),
    gnuplot_command("set terminal postscript eps size 9, 2 enhanced color font 'Courier, 11'", PlotStream),
    gnuplot_command("set output '13.eps'", PlotStream),
    gnuplot_command("set yrange [:] reverse", PlotStream),
    gnuplot_command("plot '-' u 1:2 t 'Code' with points pointtype 7 pointsize 2", PlotStream).

plot_dots(PlotStream):-
    findall(_,(
        dots(X-Y),
        atom_codes(X, CodesA),
        atom_codes(Y, CodesY),
        append(CodesA, [32|CodesY], DataCodes),
        length(DataCodes, CodesLength),
        findall(_,(
            between(1, CodesLength, N),
            nth(N, DataCodes, DataCode),
            put_code(PlotStream, DataCode)
        ),_),
        nl(PlotStream)
    ), _).        

plot:-
    plot_configuration(PlotStream),
    plot_dots(PlotStream),
    [Exit] = "e",
    put_code(PlotStream, Exit),
    nl(PlotStream),
    close(PlotStream).    

make_transparency(Records, Folds):-
    make_transparency(Records, [], Folds). 
make_transparency([], Folds, Folds). 
make_transparency([fold, along, Fold|Records], FoldAccum, Folds):-
    make_transparency(Records, [Fold|FoldAccum], Folds). 
make_transparency([H|Records], FoldAccum, Folds):-
    atom_codes(H, C),
    C \== [],
    append([Y], Rest, Records),  
    asserta(dots(H-Y)),  
    make_transparency(Rest, FoldAccum, Folds). 
make_transparency([H|Records], FoldAccum, Folds):-
    atom_codes(H, C),
    C == [],
    make_transparency(Records, FoldAccum, Folds).

fold_up(Line):-
    findall(Yn, (dots(X-Y), number_atom(Yn, Y)), Yns), 
    max_list(Yns, MaxY),
    Half is div(MaxY, 2), 
    number_atom(LineN, Line), 
    findall(_,( 
        dots(X-Y),
        number_atom(Yn, Y),
        Yn > LineN,
        Y0 is LineN - Yn + Half,  
        number_atom(Y0, Ya),  
        retract(dots(X-Y)),
        retractall(dots(X-Ya)),
        asserta(dots(X-Ya))
    ), _).  

fold_left(Line):-
    findall(Xn, (dots(X-Y), number_atom(Xn, X)), Xns), 
    max_list(Xns, MaxX),
    Half is div(MaxX, 2), 
    number_atom(LineN, Line), 
    findall(_,( 
        dots(X-Y),
        number_atom(Xn, X),
        Xn > LineN,
        X0 is LineN - Xn + Half,  
        number_atom(X0, Xa),  
        retract(dots(X-Y)),
        retractall(dots(Xa-Y)),
        asserta(dots(Xa-Y))
    ), _).  

fold_transparency([], _).
fold_transparency(Folds, Count):-
    append(F, [Fold], Folds),
    atom_codes(Fold, [Axis, 61|Location]),
    atom_codes(Direction, [Axis]),
    atom_codes(Line, Location),
    ((Direction == x, fold_left(Line))
     ;
     (Direction == y, fold_up(Line))), 
    findall(X-Y,dots(X-Y), Dots),
    length(Dots, Count),
    fold_transparency(F, _).   

transparency(Records, Count):-
    make_transparency(Records, Folds),
    fold_transparency(Folds, Count),
    plot. 

main:-
    open('data', read, Stream),
    read_data(Stream, Records),
    close(Stream),
    transparency(Records, _), 
    halt.

The results

Notes

When first plotted the data I did not set the image size and so the default resulted in a squared image which obscured the characters which are supposed to be visible. The size 9, 2 part of the terminal configuration is to set an aspect ratio for easy reading of the resulting characters. set yrange [:] reverse is necessary to re-orient the gnuplot axis to match the axis of the puzzle data.

Anyway, I've never used popen/3 before and was very happy to find that it was so easy to use to come up quickly with fully working solution. Especially when rushing to complete a coding puzzle as quickly as I could. Another testament to GNU Prolog's clean design!

References

Advent of Code Day 13

popen/3

GNU Prolog

gnuplot

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

Part 1

You are given two decimal-coded binary numbers, $a and $b. Write a script to simulate the addition of the given binary numbers.

Solution

:-initialization(main).

sum_carry(0, 0, 1, 1, 1).  
sum_carry(1, 0, 1, 0, 0).  
sum_carry(0, 1, 1, 1, 0). 
sum_carry(0, 1, 0, 1, 1). 
sum_carry(0, 0, 0, 0, 0). 
sum_carry(1, 0, 0, 0, 1).  
sum_carry(0, 1, 1, 0, 1). 
sum_carry(1, 0, 0, 1, 0). 
sum_carry(0, 1, 1, 1).   
sum_carry(1, 0, 0, 1). 
sum_carry(0, 0, 0, 0). 
sum_carry(1, 0, 1, 0).    

add_binary(A, B, Sum):-
    number_chars(A, AChars),   
    number_chars(B, BChars),        
    reverse(AChars, ACharsReverse),  
    reverse(BChars, BCharsReverse),  
    add_binary(ACharsReverse, BCharsReverse, 0, [], Sum).  
add_binary([], [], 0, SumAccum, Sum):-
    number_chars(Sum, SumAccum).  
add_binary([], [], 1, SumAccum, Sum):-   
    number_chars(Sum, ['1'|SumAccum]).  
add_binary([H|T], [], Carry, SumAccum, Sum):-
    number_chars(D, [H]), 
    sum_carry(S, C, D, Carry), 
    number_chars(S, [N]),  
    add_binary(T, [], C, [N | SumAccum], Sum).  
add_binary([H0|T0], [H1|T1], Carry, SumAccum, Sum):-
    number_chars(D0, [H0]), 
    number_chars(D1, [H1]), 
    sum_carry(S, C, D0, D1, Carry), 
    number_chars(S, [N]),  
    add_binary(T0, T1, C, [N | SumAccum], Sum).  

main:-
    add_binary(11, 1, X0),
    write(X0), nl, 
    add_binary(101, 1, X1),
    write(X1), nl, 
    add_binary(100, 11, X2),
    write(X2), nl, 
    halt. 

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
100
110
111

Notes

The approach here may seem just a little strange for "simulating a binary addition", but it seemed like a fun idea, given the small number of combinations, to just store all the intermediate results and then retrieve them as needed. This all seems to work ok, except that maybe going back and forth between numbers and chars is a little clunky.

Part 2

You are given 3 positive integers, $i, $j and $k. Write a script to print the $kth element in the sorted multiplication table of $i and $j.

Solution

:-initialization(main).

multiply(I, J, N):-
    between(1, I, Ith),
    between(1, J, Jth),
    N is Ith * Jth.

multiplication_table(I, J, Table):-
    bagof(N, multiply(I, J, N), Table).   

nth_from_table(I, J, K, N):-
    multiplication_table(I, J, Table),  
    msort(Table, SortedTable),   
    nth(K, SortedTable, N).  

main:-
    nth_from_table(2, 3, 4, N0),
    write(N0), nl, 
    nth_from_table(3, 3, 6, N1),
    write(N1), nl, 
    halt.   

Sample Run

$ gplc prolog/ch-2.p 
$ prolog/ch-2  
3
4

Notes

It's maybe a little confusing, to me anyway, that GNU Prolog's msort/2 does not merge duplicates but sort/2 does. Other than that I have to say that I really like this bit of Prolog. It seems very clean to me in that no recursion was required, everything is handled via Prolog itself.

References

Challenge 140

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

Part 1

You are given a list of numbers. Write a script to implement JortSort. It should return true/false depending if the given list of numbers are already sorted.

Solution

:-initialization(main).

jort([]).
jort([H0, H1|[]]):-
    H1 >= H0.
jort([H0, H1|T]):-
    H1 >= H0,
    jort([H1|T]).

main:-
    (jort([1, 2, 3, 4, 5]), format("1~n", _); format("0~n", _)),
    (jort([1, 3, 2, 4, 5]), format("1~n", _); format("0~n", _)),
    (jort([1, 2, 3, 4, 5, 6]), format("1~n", _); format("0~n", _)),
    halt.

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
1
0
1

Notes

I had never heard of a Jort Sort before this week. Once I understand what it was, a joke function which just returns true or false based on whether a given list is already sorted, I am still not sure I really get it. Or, at least, I don't really get the "joke". Apparently it started as a JavaScript thing so maybe there is something inherently funny about the JavaScript code for it.

Anyway, this is pretty easily done in Prolog especially in this case where we only are to be given a list of numbers. The code as written only goes in one direction in that it only verifies a list as requested. This could go in the other direction with a little use of between/3 and generate a sorted list too. But would that ruin the joke? Make it funnier? I found the whole exercise so unamusing I didn't bother!

Maybe the amusing part of this whole "joke" sort was, ironically, just how stupid I found the whole thing.

References

Jort Sort

Challenge 139

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

Part 1

You are given 2 positive numbers, $m and $n. Write a script to find out if the given two numbers are Two Friendly.

Solution

:-initialization(main).

two_friendly(M, N):-
    current_prolog_flag(max_integer, MAX_INTEGER),
    between(1, MAX_INTEGER, M),
    between(1, MAX_INTEGER, N),
    GCD is gcd(M, N), 
    P is log(2, GCD), 
    P0 is ceiling(P), 
    P1 is floor(P), 
    P0 == P1. 

main:-
    (two_friendly(8, 24), format("1~n", _); format("0~n", _)),
    (two_friendly(26, 39), format("1~n", _); format("0~n", _)),
    (two_friendly(4, 10), format("1~n", _); format("0~n", _)),
    halt.

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
1
0
1

Notes

Evn after years of writing Prolog I still get quite a kick out of its inherent power. Here the two_friendly/2 predicate not only verifies for any M and N but also is multi-modal and can generate pairs for any M and N as well!

Part 2

You are given a positive number $n. Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.

Solution

fibonaccis_below_n(N, Fibonaccis):-
    fibonaccis_below_n(N, Fibonaccis, 0, [1, 1]).
fibonaccis_below_n(-1, Fibonaccis, _, Fibonaccis):- !.    
fibonaccis_below_n(N, Fibonaccis, Sum, PartialFibonaccis):-
    [H0, H1 | _] = PartialFibonaccis,
    F is H0 + H1,
    F < N,
    fibonaccis_below_n(N, Fibonaccis, Sum, [F|PartialFibonaccis]).
fibonaccis_below_n(N, Fibonaccis, Sum, PartialFibonaccis):-
    [H0, H1 | _] = PartialFibonaccis,
    F is H0 + H1,
    F > N, 
    fibonaccis_below_n(-1, Fibonaccis, Sum, PartialFibonaccis).

sum_x([], 0).
sum_x([X|Xs], X+Xse):-
    sum_x(Xs, Xse).

sum_lists(X, N, Xsub):-
    sublist(Xsub, X),
    sum_x(Xsub, Xe),
    N #= Xe.

fibonacci_sum_clp(N, Summands):-
    fibonaccis_below_n(N, Fibonaccis),
    sum_lists(Fibonaccis, N, Summands).

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- setof(Summands, fibonacci_sum_clp(16, Summands), S).

S = [[8,5,2,1],[8,5,3],[13,2,1],[13,3]]

(1 ms) yes

Notes

Instead of using a pre-computed list of Fibonacci numbers we generate them as needed. No particular reason other than it's a little more fun, and also it allows us to flexibly allow for virtually any value for N.

I just realized as I am looking at the code that I may have slightly misnamed the fibonacci_sum_clp/2 predicate! I was experimenting with different approaches including a clpfd one. This is clearly not really using clpfd though! Instead sublist/2 is used to generate and test all possible sublists of the Fibonacci subsequence with values less than N.

References

Challenge 136

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

Part 1

You are given an integer. Write a script find out the middle 3-digits of the given integer, if possible, otherwise show a sensible error message.

Solution

:-initialization(main).

middle_three(N, Middle3):-
    number_chars(N, Chars),
    N > 0,
    length(Chars, Length),  
    Length > 2,
    IsOdd is Length mod 2, IsOdd == 1,
    length(M3, 3),
    PrefixLength is ceiling(Length / 2) - 2,
    length(Prefix, PrefixLength),
    append(Prefix, Middle, Chars),
    append(M3, _, Middle),
    number_chars(Middle3, M3). 

middle_three(N, Middle3):-
    (N < 0, N0 is abs(N), middle_three(N0, Middle3));
    (number_chars(N, Chars), length(Chars, Length), Length < 3, format("too short~n", _));  
    (number_chars(N, Chars), length(Chars, Length), IsOdd is Length mod 2, IsOdd == 0, format("even number of digits~n", _));
    middle_three(N, Middle3). 

main:-
    middle_three(1234567, Middle3),
    ((nonvar(Middle3), format("~d~n", [Middle3]), halt);
    halt).

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
345

Notes

Interestingly this is one of the rare cases where a Prolog solution follows a fairly similar approach a [Perl solution to the same problem0(http://www.rabbitfarm.com/cgi-bin/blosxom/2021/10/24/perl).

Part 2

You are given 7-characters alphanumeric SEDOL. Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL otherwise 0.

Solution

:-initialization(main).

weight(1, 1).
weight(2, 3).
weight(3, 1).
weight(4, 7).
weight(5, 3).
weight(6, 9).

base --> alphanumeric, alphanumeric, alphanumeric, alphanumeric, alphanumeric, alphanumeric.
alphanumeric --> [AlphaNumeric], {letter_or_digit(AlphaNumeric)}.

sedol(Sedol):-
    var(Sedol),
    sedol(_, Sedol).
sedol(Sedol):-
    nonvar(Sedol),
    length(Base, 6),
    append(Base, [CheckDigit], Sedol),
    phrase(base, Base),
    compute_check(Base, ComputedCheckDigit),
    CheckDigit == ComputedCheckDigit.

sedol(Base, Sedol):-
    phrase(base, Base),
    check_digit(Base, Sedol).

letter_or_digit(A):-
    nonvar(A),
    atom_codes(A, C),
    ((C >= 66, C =< 90);
     (C >= 48, C =< 57)).

letter_or_digit(A):-
    var(A),
    ((between(66, 90, C));  %B through Z
     (between(48, 57, C))), %0-9
    atom_codes(A, [C]).

compute_check(Base, CheckSum):-
    compute_check(Base, 1, CheckSum, 0).
compute_check([], _, CheckSum, PartialCheckSum):-
    CheckSum is mod(10 - mod(PartialCheckSum, 10), 10).    
compute_check([H|T], Index, CheckSum, PartialCheckSum):-
    atom_codes(H, [C]),
    between(66, 90, C),
    weight(Index, Weight),
    LetterValue is C - 64 + 9,
    Partial is PartialCheckSum + (LetterValue * Weight),
    succ(Index, I),
    compute_check(T, I, CheckSum, Partial).
compute_check([H|T], Index, CheckSum, PartialCheckSum):-
    atom_codes(H, [C]),
    between(48, 57, C),
    weight(Index, Weight),
    NumeralValue is C - 48,
    Partial is PartialCheckSum + (NumeralValue * Weight),
    succ(Index, I),
    compute_check(T, I, CheckSum, Partial).

check_digit(Base, BaseCheckDigit):-
    compute_check(Base, CheckDigit),
    append(Base, [CheckDigit], BaseCheckDigit).       

main:-
    (sedol(['2','9','3','6','9','2',1]), format("1~n", _);
     format("0~n", _)),
    (sedol(['1','2','3','4','5','6',7]), format("1~n", _);
     format("0~n", _)),
    (sedol(['B','0','Y','B','K','L',9]), format("1~n", _);
     format("0~n", _)),
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
1
0
1

Notes

I had originally hoped to have all code for this using almost exclusively DCGs. Things got a bit unwieldy with the checksum computation and so I dialed that back a bit, so to speak. Here the DCG part is for validating or generating a SEDOL base 6 digits sequence and the check digit is computed using regular Prolog predicates.

The rules around SEDOLs are a bit more complex than this problem lets on. I won't recount them all here, but suffice to say we are dealing with a quite idealized set of validations here. For example, prior to 2004 only numerals were allowed, but since then letters are allowed. But only a numeral can follow a letter. Again, though, those are only rules that apply for a certain time range.

Here we are just checking on length, whether or not the SEDOl contains all numerals and/or (uppercase) letter, and the checksum validation.

References

Challenge 135

Stock Exchange Daily Official List (SEDOL)

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

Part 1

Write a script to generate first 5 Pandigital Numbers in base 10.

Solution

:-initialization(first_5_pandigitals).

pandigital(Pandigitals):-
    Digits = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
    Pandigitals = [A, B, C, D, E, F, G, H, I, J],
    fd_domain([A, B, C, D, E, F, G, H, I, J], Digits),
    A #= 1,
    B #= 0,
    fd_labeling(Pandigitals).

first_5_pandigitals:-
    setof(P, pandigital(P), Pandigitals),
    sort(Pandigitals, [A, B, C, D, E | _ ]),
    print_pandigitals([A, B, C, D, E]).

print_pandigitals([]).
print_pandigitals([H|T]):-
    maplist(number_codes, H, Codes), 
    flatten(Codes, DigitCodes), 
    number_codes(Number, DigitCodes),
    write(Number), nl,
    print_pandigitals(T). 

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
1023456789
1023456798
1023456879
1023456897
1023456978

Notes

Rather than recursively iterate over numbers like in the Perl solution I instead use a bit of constraint programming to generate and test a large number of candidates. I then take only the first five as required. A bit of intuition, based on the definition, reduces the number of candidates generated: the first digit will clearly be a 1, the second a 0.

This runs pretty quickly, yet another testimonial to the design and implementation of GNU Prolog's FD solver. On my 2018 Mac Mini it ran to completion in about second. This is much faster than the brute force Perl solution which takes about 20s on the same machine.

Part 2

You are given 2 positive numbers, $m and $n. Write a script to generate multiplication table and display count of distinct terms.

Solution

:-initialization(main).

table(M, N, K):-
    between(1, M, I),
    between(1, N, J),
    K is I * J.

print_table(M, N, Distinct):-
    findall(K, table(M, N, K), Ks),
    setof(K, table(M, N, K), Distinct),
    print_header(M, N),
    print_seperator(M, N),
    print_rows(M, N, Ks),
    maplist(number_chars, Distinct, DistinctRow), 
    maplist(add_space, DistinctRow, DistinctSpaced),
    flatten(DistinctSpaced, DistinctSpacedFlattened),
    format("~nDistinct Terms: ~S~n", [DistinctSpacedFlattened]),
    length(Distinct, Count),
    format("Count: ~d ~n", [Count]).

print_rows(0, _, _).
print_rows(M, N, Products):-
    length(Row, N),
    append(Rest, Row, Products),
    M0 is M - 1,
    print_rows(M0, N, Rest),
    maplist(number_chars, Row, RowChars), 
    maplist(add_space, RowChars, CharsSpaced),
    flatten(CharsSpaced, CharsSpacedFlattened),
    format(" ~n  ~d | ~S ", [M, CharsSpacedFlattened]).

print_header(_, N):-
    format("  x | ", _),
    print_header(N).    
print_header(0).
print_header(N):-
    N0 is N - 1,
    print_header(N0),
    format("~d ", [N]). 

print_seperator(_, N):-
    format("~n  --+-", _),
    print_seperator(N).
print_seperator(0).
print_seperator(N):-
    N0 is N - 1,
    print_seperator(N0),
    format("~a", ['--']).

add_space(C, CS):-
    flatten(C, F),
    append(F, [' '], FS),
    atom_chars(A, FS),
    atom_chars(A, CS).       

main:-
    print_table(3, 3, _), nl, nl,
    print_table(3, 5, _),
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
  x | 1 2 3 
  --+------- 
  1 | 1 2 3   
  2 | 2 4 6   
  3 | 3 6 9  
Distinct Terms: 1 2 3 4 6 9 
Count: 6 


  x | 1 2 3 4 5 
  --+----------- 
  1 | 1 2 3 4 5   
  2 | 2 4 6 8 10   
  3 | 3 6 9 12 15  
Distinct Terms: 1 2 3 4 5 6 8 9 10 12 15 
Count: 11 

Notes

This was an interesting exercise in formatting output in Prolog! As can be seen, the vast majority of the code here is to format the table in the required way. I haven't ever done all that much with format/2, but it is quite versatile. As far as formatting output goes it provides a solid set of primitives in the spirit of C's printf that allow for us to do whatever we want, albeit with a bit of work.

The actual computation of the value takes no more than the first half dozen or so lines of code in table/3 and print_table/3.

References

Challenge 134

Pandigital Numbers

GNU Prolog format/2

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

Part 1

You are given two sets with unique numbers. Write a script to figure out if they are disjoint.

Solution

:-initialization(main).

conflicts(List0, List1):-
    member(X, List0),
    member(X, List1).

disjoint(List0, List1):-
    \+ conflicts(List0, List1).

main:-
    ((disjoint([1, 2, 5, 3, 4], [4, 6, 7, 8, 9]), write(1)); (write(0))),
    nl,
    ((disjoint([1, 3, 5, 7, 9], [0, 2, 4, 6, 8]), write(1)); (write(0))),
    nl,
    halt. 

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
0
1

Notes

The conflcts/2 predicate establishes whether or not if there is any overlapping elements in the two lists. To establish whether the sets are disjoint disjoint/2 examines the negation of this result.

Remember, Prolog only backtracks on failure and not success. This fits nicely for what we want. We only care if the lists have any overlap whatsoever. So using backtracking conflicts/2 will backtrack for all members of List0 until it either succeeds in finding an element that is also in List1 or, if none, fails completely indicating a disjoint set. Since we actually consider the discovery of disjoint sets a success we negate the result with \+ in disjoint/2.

Part 2

You are given a list of intervals. Write a script to determine conflicts between the intervals.

Solution

:-initialization(main).

conflicts(Intervals, Conflicts):-
    conflicts(Intervals, Conflicts, []).
conflicts([_|[]], Conflicts, ConflictsAccum):-
    sort(ConflictsAccum, Conflicts).
conflicts([H|T], Conflicts, ConflictsAccum):-
    last(T, Last),
    append(Intervals, [Last], T),
    append([H], Intervals, CompareIntervals),
    comparisons(Last, CompareIntervals, HasConflicts),
    append(ConflictsAccum, HasConflicts, ConflictsAccumUpdated),
    conflicts(CompareIntervals, Conflicts, ConflictsAccumUpdated).

comparisons(Interval, CompareIntervals, Conflicts):-
    comparisons(Interval, CompareIntervals, Conflicts, []).
comparisons(_, [], Conflicts, Conflicts).
comparisons(Interval, [[H0|T0]|T], Conflicts, ConflictsAccum):-
    [I|J] = Interval,
    I >= H0,
    I =< T0,
    comparisons([I|J], T, Conflicts, [Interval|ConflictsAccum]).
comparisons([I|J], [_|T], Conflicts, ConflictsAccum):-
    comparisons([I|J], T, Conflicts, ConflictsAccum).

main:-
    conflicts([[1, 4], [3, 5], [6, 8], [12, 13], [3, 20]], Conflicts0),
    write(Conflicts0), nl,
    conflicts([[3, 4], [5, 7], [6, 9], [10, 12], [13, 15]], Conflicts1),
    write(Conflicts1), nl,
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
[[3,5],[3,20]]
[[6,9]]

Notes

The examples given in the problem statement are with the [minimum, maximum] intervals sorted by the maximum value. This makes the problem a bit easier since then we need only check to see if, when working down the sorted list, if the minimum is in one of the other intervals.

This is mostly all handled using recursion which keeps with the nature of the examples in the problem statement. This is fine, and obviously works, but after having worked out the details of finding a solution it seems there is room to make this more, well, logical?

Preferring reasoning over recursion as a principle of Prolog development seems to be reasonable (pun intended!). Here we might, for example, arrange the intervals in Key-Value pairs stored in the Prolog database and make better use of built in backtracking. But even that would include a little extra work as we would need to sort the pairs by value and ultimately the same number of lines of code would be written as shown here, it would just arguably be a bit more Prological.

Sometimes the best solution to a problem is only discovered after working on it for a bit using alternative means!

References

Challenge 127

Disjoint Sets

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

Part 1

You are given a positive integer $N. Write a script to print count of numbers from 1 to $N that don’t contain digit 1.

Solution

:-initialization(main).

has_1(N):-
    number_codes(N, Codes),
    memberchk(49, Codes).  

count_numbers_without_1(N, Count):-
    count_numbers_without_1(N, 0, Count).  
count_numbers_without_1(1, Count, Count).  
count_numbers_without_1(N, CountAccum, Count):-
    \+ has_1(N),
    succ(CountAccum, C),
    N0 is N - 1,
    count_numbers_without_1(N0, C, Count).  
count_numbers_without_1(N, CountAccum, Count):-
    has_1(N),
    N0 is N - 1,
    count_numbers_without_1(N0, CountAccum, Count).  

main:-
    count_numbers_without_1(15, Count0),
    write(Count0), nl,
    count_numbers_without_1(25, Count1),
    write(Count1), nl,
    halt.   

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
8
13

Notes

The count_numbers_without_1 predicates recurse over the range of numbers and tally the qualifying numbers at each step. has_1/1 converts the numeral to the list of associated ascii codes and then we see if the ascii code for '1' (49) is present.

Part 2

You are given a rectangle with points marked with either x or *. Please consider the x as a land mine. Write a script to print a rectangle with numbers and x as in the Minesweeper game.

Solution

:-initialization(main).

rows(5).
columns(10).
grid([x, '*', '*', '*', x, '*', x, x, x, x, 
      '*', '*', '*', '*', '*', '*', '*', '*', '*', x,  
      '*', '*', '*', '*', x, '*', x, '*', x, '*',   
      '*', '*', '*', x, x, '*', '*', '*', '*', '*',
       x, '*', '*', '*', x, '*', '*', '*', '*', x]).

write_grid([H|T]):-
    write('\t'),
    write_grid([H|T], 0).
write_grid([], _).    
write_grid([H|T], Counter):-
    columns(Columns),
    succ(Counter, C),
    M is C mod Columns,
    M \== 0,
    write(H),
    write(' '),
    write_grid(T, C).
write_grid([H|T], Counter):-
    columns(Columns),
    C is Counter + 1,
    M is C mod Columns,
    M == 0,
    write(H),
    ((rows(Rows),
      columns(Columns),
      Cells is Rows * Columns,
      C \== Cells,
      nl,
      write('\t'),
      write_grid(T, C)
     );
     (
      write_grid(T, C)
    )).

minecount(List, MineCount):-
    minecount(List, 0, MineCount).
minecount([], MineCount, MineCount).
minecount([H|T], MineCountPartial, MineCount):-  
    H == x,
    MCP is MineCountPartial + 1,
    minecount(T, MCP, MineCount).
minecount([H|T], MineCountPartial, MineCount):-  
    H \== x,
    minecount(T, MineCountPartial, MineCount).

adjacent_bottomleft(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell + Columns1,
    C > 0,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M0 \== 0, M0 \==1, M1 < M0);
     (M0 == 0, M1 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_bottomleft(_, _, AdjacentCell):-
    AdjacentCell = null.

adjacent_left(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell - 1,
    C > 0,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M0 \== 0, M0 \==1, M1 < M0);
     (M0 == 0, M1 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_left(_, _, AdjacentCell):-
    AdjacentCell = null.   

adjacent_topleft(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell - (Columns + 1),
    C > 0,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M0 \== 0, M0 \==1, M1 < M0);
     (M0 == 0, M1 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_topleft(_, _, AdjacentCell):-
    AdjacentCell = null.  

adjacent_bottomright(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell + (Columns + 1),
    C > 0,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M1 > M0, M0 \== 0);
     (M1 == 0, M0 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_bottomright(_, _, AdjacentCell):-
    AdjacentCell = null.          

adjacent_right(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell + 1,
    C > 0,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M1 > M0, M0 \== 0);
     (M1 == 0, M0 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_right(_, _, AdjacentCell):-
    AdjacentCell = null.

adjacent_topright(Cell, Grid, AdjacentCell):-
    columns(Columns),
    Columns1 is Columns - 1,
    C is Cell - Columns1,
    M0 is Cell mod Columns,
    M1 is C mod Columns,
    ((M1 > M0, M0 \== 0);
     (M1 == 0, M0 == Columns1)),
    nth(C, Grid, AdjacentCell).
adjacent_topright(_, _, AdjacentCell):-
    AdjacentCell = null.    

adjacent_up(Cell, Grid, AdjacentCell):-
    columns(Columns),
    C is Cell - Columns,
    C > 0,
    nth(C, Grid, AdjacentCell).
adjacent_up(_, _, AdjacentCell):-
    AdjacentCell = null.    

adjacent_down(Cell, Grid, AdjacentCell):-
    columns(Columns),
    C is Cell + Columns,
    C > 0,
    nth(C, Grid, AdjacentCell).
adjacent_down(_, _, AdjacentCell):-
    AdjacentCell = null. 

adjacent(Cell, Grid, AdjacentCells):-
    adjacent_left(Cell, Grid, AdjacentCellLeft),
    adjacent_right(Cell, Grid, AdjacentCellRight),
    adjacent_up(Cell, Grid, AdjacentCellUp),
    adjacent_down(Cell, Grid, AdjacentCellDown),
    adjacent_topleft(Cell, Grid, AdjacentCellTopLeft),
    adjacent_topright(Cell, Grid, AdjacentCellTopRight),
    adjacent_bottomleft(Cell, Grid, AdjacentCellBottomLeft),
    adjacent_bottomright(Cell, Grid, AdjacentCellBottomRight),
    AdjacentCells = [AdjacentCellLeft, AdjacentCellRight, AdjacentCellUp, AdjacentCellDown,
                     AdjacentCellTopLeft, AdjacentCellTopRight, AdjacentCellBottomLeft, 
                     AdjacentCellBottomRight],!.

make_grid(Grid, NewGrid):-
    make_grid(Grid, 1, [], NewGrid). 
make_grid(Grid, Counter, NewGridPartial, NewGrid):-
    nth(Counter, Grid, CurrentCell),
    CurrentCell \== x,
    adjacent(Counter, Grid, AdjacentCells),
    minecount(AdjacentCells, MineCount),
    append(NewGridPartial, [MineCount], NGP),
    ((rows(Rows),
      columns(Columns),
      Cells is Rows * Columns,
      Counter == Cells, 
      !,
      NewGrid = NGP
    );
     (succ(Counter, C),
      make_grid(Grid, C, NGP, NewGrid))).
make_grid(Grid, Counter, NewGridPartial, NewGrid):-
    nth(Counter, Grid, CurrentCell),
    CurrentCell == x,
    append(NewGridPartial, [CurrentCell], NGP),
    ((rows(Rows),
      columns(Columns),
      Cells is Rows * Columns,
      Counter == Cells, 
      !,
      NewGrid = NGP
    );
     (succ(Counter, C),
      make_grid(Grid, C, NGP, NewGrid))).   

main:-
    grid(Grid),
    write('Input:'), nl,
    write_grid(Grid), nl,
    make_grid(Grid, NewGrid),
    write('Output:'), nl,
    write_grid(NewGrid), nl,
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
Input:
        x * * * x * x x x x
        * * * * * * * * * x
        * * * * x * x * x *
        * * * x x * * * * *
        x * * * x * * * * x
Output:
        x 1 0 1 x 2 x x x x
        1 1 0 2 2 4 3 5 5 x
        0 0 1 3 x 3 x 2 x 2
        1 1 1 x x 4 1 2 2 2
        x 1 1 3 x 2 0 0 1 x

Notes

For every cell C which does not contain a mine (x) we need to look at all eight adjacent cells and count the number of mines they contain. The number of mines in the adjacent cells is then set as C's label.

Obtaining the contents of the adjacent cells gets a little tedious. In fact, doing so is the majority of the code here. Care must be taken to make sure that we do not accidentally look for a cell which does not exist or is not actually adjacent. The logic for find the adjacent cells in this way is re-used from a coding challenge I did last year. The Advent of Code 2020 Day 11, in part, had a similar requirement.

After the logic of determining the contents of adjacent cells is worked out, the rest proceeds in a much less complicated way. The contents of all the adjacent cells are examined for mines and the cell labels are set appropriately.

References

Challenge 126

History of Minesweeper

Advent of Code 2020 Day 11

Prolog Solution: AoC 2020 Day 11 Part 1

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

Part 1

You are given an integer n >= 1. Write a script to find the nth Ugly Number.

Solution

:-initialization(main).  

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

ugly(N, UglyNumber):-
    ugly(N, 1, 1, _, UglyNumber).  
ugly(1, _, _, _, 1).
ugly(N, _, N, UglyNumber, UglyNumber).
ugly(N, X, I, _, UglyNumber):-  
    prime_factors(X, Factors), 
    member(Factor, Factors),   
    (Factor == 2; Factor == 3; Factor == 5), 
    X0 is X + 1,  
    I0 is I + 1,
    ugly(N, X0, I0, X, UglyNumber).  
ugly(N, X, I, UglyNext, UglyNumber):-  
    X0 is X + 1,  
    ugly(N, X0, I, UglyNext, UglyNumber).  

main:-
    ugly(10, UglyNumber),
    write(UglyNumber), nl,
    halt.   

Sample Run

$ gplc prolog/ch-1.p 
$ prolog/ch-1   
12

Notes

Here the first N ugly numbers are generated in a pretty routine way. Much of the code is related to computing the prime factors. Once that is out of way the rest of the code seems to be straightforward to follow: recursively counting up each Ugly Number until we reach the Nth one.

Part 2

You are given coordinates of four points. Write a script to find out if the given four points form a square.

Solution

:-initialization(main).  

dot_product(X0-Y0, X1-Y1, N):-
    N0 is X0 * X1,
    N is N0 + Y0 * Y1.  

swap_key_value([], []).
swap_key_value([A-B|R], [B-A|S]):-
    swap_key_value(R, S). 

square(Points):-
    setof(X, member(X-_, Points),  Xs),    
    setof(Y, member(_-Y, Points),  Ys),    
    length(Xs, LXs),
    length(Ys, LYs), 

    keysort(Points, PointsByX),    
    swap_key_value(Points, Swapped),
    keysort(Swapped, PointsByY0),    
    swap_key_value(PointsByY0, PointsByY),
    last(PointsByY, Sx-Sy),  
    last(PointsByX, Tx-Ty),  
    nth(1, PointsByY, Ux-Uy),  
    nth(1, PointsByX, Vx-Vy), 
    SUx is Sx + Ux,
    TVx is Tx + Vx,
    SUy is Sy + Uy,
    TVy is Ty + Vy,
    SUym is Sy - Uy,
    TVxm is Tx - Vx,

    DVSTx is Sx - Tx,
    DVSTy is Sy - Ty,
    DVTUx is Tx - Ux,
    DVTUy is Ty - Uy,
    DVUVx is Ux - Vx,
    DVUVy is Uy - Vy,
    DVVSx is Vx - Sx,
    DVVSy is Vy - Sy,

    dot_product(DVSTx-DVSTy, DVTUx-DVTUy, DPSTU),   
    dot_product(DVTUx-DVTUy, DVUVx-DVUVy, DPTUV),   
    dot_product(DVUVx-DVUVy, DVVSx-DVVSy, DPUVS),   

    ((LXs == 2, LYs == 2); (SUx == TVx, SUy == TVy, SUym == TVxm, DPSTU == 0, DPTUV == 0, DPUVS == 0)). 


main:-
    ((square([10-20, 20-20, 20-10, 10-10]), write(1)); (write(0))), 
    nl,
    ((square([12-24, 16-10, 20-12, 18-16]), write(1)); (write(0))), 
    nl,
    ((square([-3-1, 4-2, -(9,-3), -(2,-4)]), write(1)); (write(0))), 
    nl,
    ((square([0-0, 2-1, -(3,-1), -(1,-2)]), write(1)); (write(0))), 
    nl,
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2
1
0
0
1

Notes

This is most likely the most tedious Prolog code I have written in a long time! The actual logic of determining if the points determine a square is not so bad:

• Are there only two each of X and Y co-ordinates? Then that is enough to establish that we have a square.
• Otherwise, make sure the side lengths are all equivalent and that the angles between the sides are all 90 degrees.

The tedious part is just all the computation of the distance vectors, the sorting and arranging of the points, and so forth.

The points are represented as pairs. To orient the points they are sorted by X (key) or Y (value). This is both done by the builtin keysort/2 predicate, with keys and values swapped to facilitate the sorting by value.

In the case of negative co-ordinates we use the alternative (-)/2 syntax. For example, -(3,-1) is used since 3--1 is not valid syntactically.

In the example output we see that the first and last sets of points are both squares. The first is an example of a square with two unique X and Y co-ordinates. The third example is a rhombus and so is a good test to make sure the angles are being checked correctly.

References

Challenge 123

Rhombus

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

Part 1

You are given a stream of numbers, @N. Write a script to print the average of the stream at every point.

Solution

:-initialization(main).

moving_average(N):-
    moving_average(0, N, 1).
moving_average(Sum, N, I):-
    I \== N,
    Sum0 is Sum + (I * 10),
    Average is Sum0 / I,
    write(Average), nl,
    I0 is I + 1,
    moving_average(Sum0, N, I0).
moving_average(_, N, I):-
    I == N.

main:-
    moving_average(10),
    halt.

Sample Run

$ gplc prolog/ch-1.p
$ prolog/ch-1  
10.0
15.0
20.0
25.0
30.0
35.0
40.0
45.0
50.0

Notes

Typically when one thinks of a stream the idea is of a virtually endless source of data. Or, at least, data which is handled as if this were the case. Here the "stream" is simulated by a generated sequence of numbers. For each recursive call to moving_average/3 we increase the simulated "stream" by 10 and compute the moving average.

(The idea of a stream in Prolog is fairly specific. My preferred Prolog is Gnu Prolog, which has a very nice write up of the subject.)

Part 2

You are given a score $S. You can win basketball points e.g. 1 point, 2 points and 3 points. Write a script to find out the different ways you can score $S.

Solution

:-initialization(main).

points --> [].
points --> point, points.
point  --> [0]; [1]; [2]; [3].

basketball_points(Points, Goal):-
    length(Points, Goal),
    phrase(points, Points),
    sum_list(Points, Goal).

zero_remove([], []).
zero_remove([H|T], [ZR_H|ZR_T]):-
    delete(H, 0, ZR_H),
    zero_remove(T, ZR_T).

main:-
    findall(Ps, basketball_points(Ps, 4), Points),
    zero_remove(Points, PointsZR),
    sort(PointsZR, PointsZR_Unique),
    write(PointsZR_Unique), nl,
    halt.

Sample Run

$ gplc prolog/ch-2.p
$ prolog/ch-2  
[[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1]]

Notes

This is almost exactly identical to a solution for Challenge 112. The only difference is that I changed the predicate and variable names to match the current problem statement!

References

Challenge 122