RabbitFarm

2025-07-09

The Weekly Challenge 328 (Prolog Solutions)

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

Part 1: Replace all ?

You are given a string containing only lower case English letters and ?. Write a script to replace all ? in the given string so that the string doesn’t contain consecutive repeating characters.

Our solution is short and will be contained in a single file that has the following structure.

"ch-1.p" 1


state of the replacement 2
replace all 3
replace all ?s 4

Let’s use a DCG! First we’ll define a couple of helper rules to track the state of the replacement as the string gets processed.

state of the replacement 2 ⟩≡


replacement(Replacement), [Replacement] --> [Replacement].
replacement(R, Replacement), [Replacement] --> [R].

Fragment referenced in 1.

Next let’s have the DCG rules themselves. This looks a little more complex then it could be just because I handle certain corner cases as separate rules. Basically all we’re doing is looking at the current character code of the string to see if it’s a question mark (63) and if it is then check the previous character and the next character and rely on backtracking to find a suitable random letter. The corner cases are for when we have no previous character and if we just have one character remaining to process. We also consider the case when we have a character other than ?.

replace all 3 ⟩≡


replace(Input) --> replacement(R, Replacement),
{\+ R == [],
Input = [C, CNext|T],
C == 63,
random(97, 123, C0),
last(R, CPrevious),
\+ C0 == CPrevious,
\+ C0 == CNext,
append(R, [C0], Replacement)
},
replace([CNext|T]).
replace(Input) --> replacement(R, Replacement),
{R == [],
Input = [C, CNext|T],
C == 63,
random(97, 123, C0),
\+ C0 == CNext,
append(R, [C0], Replacement)
},
replace([CNext|T]).
replace(Input) --> replacement(R, Replacement),
{Input = [C|T],
\+ C == 63,
append(R, [C], Replacement)
},
replace(T).
replace(Input) --> replacement(R, Replacement),
{Input = [C|T],
C == 63,
random(97, 123, C0),
last(R, CPrevious),
\+ C0 == CPrevious,
append(R, [C0], Replacement)
},
replace(T).
replace([]) --> [].

Fragment referenced in 1.

Finally we’ll have a small predicate for calling the DCG using phrase/3 and formatting the result.

replace all ?s 4 ⟩≡


replace_qs(S, Replaced):-
phrase(replace(S), [[]], [ReplacedCodes]),
atom_codes(Replaced, ReplacedCodes).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- replace_qs("a?z", Replaced). 
 
Replaced = adz ? 
 
(1 ms) yes 
| ?- replace_qs("pe?k", Replaced). 
 
Replaced = petk ? 
 
yes 
| ?- replace_qs("gra?te", Replaced). 
 
Replaced = gralte ? 
 
yes 
| ?- replace_qs("abcdefg", Replaced). 
 
Replaced = abcdefg ? 
 
yes 
| ?-
    

Part 2: Good String

You are given a string made up of lower and upper case English letters only. Write a script to return the good string of the given string. A string is called good string if it doesn’t have two adjacent same characters, one in upper case and other is lower case.

Let’s use DCGs again! This will proceed in a way very similar to Part 1.

"ch-2.p" 5


find a bad pair 7
track the state of the deletions 6
make good 8
remove all bad pairs 9

Some helper rules to track the state of the deletions of the ”bad pairs“. The state will be maintained as modifications of the original string. This may seem a little unusual at first, we aren’t iterating over the string, rather we are iterating over all possible bad pairs. Maybe this use of a DCG is a little clunky, but why let that stop us!

(I say this is “clunky” because here we’re mainly using DCG notation simply as an alternative to ordinary recursion. There’s nothing being parsed per se and there is nothing especially interesting about the list being processed.)

track the state of the deletions 6 ⟩≡


deletion(Deletion), [Deletion] --> [Deletion].
deletion(D, Deletion), [Deletion] --> [D].

Fragment referenced in 5.

find a bad pair 7 ⟩≡


bad_pair([], _):- false.
bad_pair(S, P):-
member(X, S),
member(Y, S),
\+ X == Y,
nth(I, S, X),
nth(J, S, Y),
succ(I, J),
(X is Y + 32; X is Y - 32), P = [I, J], !.

Fragment referenced in 5.

The main DCG rules.

make good 8 ⟩≡


make_good(S) --> deletion(D, Deletion),
{D == [], \+ S == [], Deletion = S},
make_good(S).
make_good(S) --> deletion(D, Deletion),
{\+ D == [],
bad_pair(S, P),
[I, _] = P,
I > 1,
prefix(Prefix, S),
length(Prefix, I0),
I0 is I - 1,
append(Prefix, [_, _|Rest], S),
append(Prefix, Rest, Deletion)
},
make_good(Deletion).
make_good(S) --> deletion(D, Deletion),
{\+ D == [],
bad_pair(S, P),
[I, _] = P,
I == 1,
append([_, _], Deletion, S)
},
make_good(Deletion).
make_good(S) --> deletion(_, Deletion),
{\+ bad_pair(S, _),
Deletion = S}.
make_good([]) --> [].

Fragment referenced in 5.

Finally we’ll have a small predicate for calling the DCG using phrase/3.

remove all bad pairs 9 ⟩≡


make_good_string(S, Good):-
phrase(make_good(S), [[]], [GoodCodes]),
atom_codes(Good, GoodCodes), !.

Fragment referenced in 5.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- make_good_string("WeEeekly", Good). 
 
Good = ’Weekly’ 
 
(1 ms) yes 
| ?- make_good_string("abBAdD", Good). 
 
Good = ’’ 
 
yes 
| ?- make_good_string("abc", Good). 
 
Good = abc 
 
yes 
| ?-
    

References

The Weekly Challenge 328
Generated Code

posted at: 19:32 by: Adam Russell | path: /prolog | permanent link to this entry

2025-06-29

The Weekly Challenge 327 (Prolog Solutions)

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

Part 1: Missing Integers

You are given an array of n integers. Write a script to find all the missing integers in the range 1..n in the given array.

Our solution is short and will be contained in a single file that has the following structure.

"ch-1.p" 1


missing integers 2

This problem is straightforward to solve using member/2.

missing integers 2 ⟩≡


missing_integers(L, Missing):-
length(L, Length),
findall(M, (
between(1, Length, M),
\+ member(M, L)
), Missing).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- missing_integers([1, 2, 1, 3, 2, 5], Missing). 
 
Missing = [4,6] 
 
yes 
| ?- missing_integers([1, 1, 1], Missing). 
 
Missing = [2,3] 
 
yes 
| ?- missing_integers([2, 2, 1], Missing). 
 
Missing = [3] 
 
yes 
| ?-
    

Part 2: MAD

You are given an array of distinct integers. Write a script to find all pairs of elements with minimum absolute difference (MAD) of any two elements.

The code required is fairly small, we’ll just need a single predicate and use GNU Prolog’s clp(fd) solver.

"ch-2.p" 3


compute MAD and find pairs 4

This is a good use of GNU Prolog’s clp(fd) solver. We set up the finite domain variables I and J to take values from the given list. We then find the minimum value of the differences and return all pairs having satisfied that constraint.

compute MAD and find pairs 4 ⟩≡


mad(L, Pairs):-
fd_max_integer(MAX_INT),
fd_domain([I, J], L),
fd_domain(D, 1, MAX_INT),
J #> I,
fd_minimize((D #= J - I, fd_labeling([D])), D),
findall(Pair, (fd_labeling([I, J]), Pair = [I, J]), Pairs).

Fragment referenced in 3.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- mad([4, 1, 2, 3], Pairs). 
 
Pairs = [[1,2],[2,3],[3,4]] 
 
yes 
| ?- mad([1, 3, 7, 11, 15], Pairs). 
 
Pairs = [[1,3]] 
 
yes 
| ?- mad([1, 5, 3, 8], Pairs). 
 
Pairs = [[1,3],[3,5]] 
 
yes 
| ?-
    

References

The Weekly Challenge 327
Generated Code

posted at: 15:28 by: Adam Russell | path: /prolog | permanent link to this entry

2025-06-22

The Weekly Challenge 326 (Prolog Solutions)

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

Part 1: Day of the Year

You are given a date in the format YYYY-MM-DD. Write a script to find day number of the year that the given date represent.

Our solution is short, it involves just a couple of computations, and will be contained in a single file that has the following structure.

"ch-1.p" 1


day month year 4
leap year 2
february days 3
day of the year 5

We’ll put the determination of whether a year is a leap year or not into its own predicate.

leap year 2 ⟩≡


leap_year(Year):-
M1 is Year mod 4,
M2 is Year mod 100,
M3 is Year mod 400,
((M1 == 0, \+ M2 == 0);
(M1 == 0, M2 == 0, M3 == 0)).

Fragment referenced in 1.

Similarly, we’ll put the calculation of the number of February days in its own predicate.

february days 3 ⟩≡


february_days(Year, Days):-
leap_year(Year),
Days = 29.
february_days(_, Days):-
Days = 28.

Fragment referenced in 1.

One more utility predicate, which splits the input into day, month, and year values.

day month year 4 ⟩≡


day_month_year(S, Day, Month, Year):-
append(Y, [45|T], S),
append(M, [45|D], T),
number_codes(Day, D),
number_codes(Month, M),
number_codes(Year, Y).

Fragment referenced in 1.

Finally, let’s compute the day of the year.

day of the year 5 ⟩≡


day_of_year(Date, DayOfYear) :-
day_month_year(Date, Day, Month, Year),
february_days(Year, FebruaryDays),
DaysInMonth = [31, FebruaryDays, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31],
succ(M, Month),
length(Prefix, M),
prefix(Prefix, DaysInMonth),
sum_list(Prefix, MonthSum),
DayOfYear is MonthSum + Day.

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- day_of_year("2025-02-02", DayOfYear). 
 
DayOfYear = 33 ? 
 
yes 
| ?- day_of_year("2025-04-10", DayOfYear). 
 
DayOfYear = 100 ? 
 
yes 
| ?- day_of_year("2025-09-07", DayOfYear). 
 
DayOfYear = 250 ? 
 
yes 
| ?-
    

Part 2: Decompressed List

You are given an array of positive integers having even elements. Write a script to to return the decompress list. To decompress, pick adjacent pair (i, j) and replace it with j, i times.

The code required is fairly small, we’ll just need a couple of predicates.

"ch-2.p" 6


state of the decompression 7
decompress 8
decompress list 9

We’ll define a DCG to “decompress”the list. First, let’s have some predicates for maintaining the state of the decompression as it proceeds.

state of the decompression 7 ⟩≡


decompression(Decompression), [Decompression] --> [Decompression].
decompression(D, Decompression), [Decompression] --> [D].

Fragment referenced in 6.

The DCG for this is not so complex. Mainly we need to be concerned with maintaining the state of the decompression as we process the list.

decompress 8 ⟩≡


decompress(Input) --> decompression(D, Decompression),
{Input = [I, J|T],
length(L, I),
maplist(=(J), L),
append(D, L, Decompression)
},
decompress(T).
decompress([]) --> [].

Fragment referenced in 6.

Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3.

decompress list 9 ⟩≡


decompress_list(L, Decompressed):-
phrase(decompress(L), [[]], [Decompressed]).

Fragment referenced in 6.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- decompress_list([1, 3, 2, 4], Decompressed). 
 
Decompressed = [3,4,4] 
 
yes 
| ?- decompress_list([1, 1, 2, 2], Decompressed). 
 
Decompressed = [1,2,2] 
 
yes 
| ?- decompress_list([3, 1, 3, 2], Decompressed). 
 
Decompressed = [1,1,1,2,2,2] 
 
yes 
| ?-
    

References

The Weekly Challenge 326
Generated Code

posted at: 18:45 by: Adam Russell | path: /prolog | permanent link to this entry

2025-06-14

The Weekly Challenge 325 (Prolog Solutions)

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

Part 1: Consecutive One

You are given a binary array containing only 0 or/and 1. Write a script to find out the maximum consecutive 1 in the given array.

Our solution is short and will be contained in a single file that has the following structure.

"ch-1.p" 1


state of the count 2
count consecutive ones 3
consecutive ones 4

We’ll define a DCG to count the ones in the list. First, let’s have some predicates for maintaining the state of the count of consecutive ones.

state of the count 2 ⟩≡


consecutive_ones(Consecutive), [Consecutive] --> [Consecutive].
consecutive_ones(C, Consecutive), [Consecutive] --> [C].

Fragment referenced in 1.

The DCG for this is not so complex. Mainly we need to be concerned with maintaining the state of the count as we see each list element.

count consecutive ones 3 ⟩≡


count_ones(Input) --> consecutive_ones(C, Consecutive),
{Input = [H|T],
H == 1,
[Count, Maximum] = C,
succ(Count, Count1),
((Count1 > Maximum, Consecutive = [Count1, Count1]);
(Consecutive = [Count1, Maximum]))
},
count_ones(T).
count_ones(Input) --> consecutive_ones(C, Consecutive),
{Input = [H|T],
H == 0,
[_, Maximum] = C,
Consecutive = [0, Maximum]},
count_ones(T).
count_ones([]) --> [].

Fragment referenced in 1.

Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3.

consecutive ones 4 ⟩≡


consecutive_ones(L, MaximumConsecutive):-
phrase(count_ones(L), [[0, 0]], [Output]), !,
[_, MaximumConsecutive] = Output.

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- consecutive_ones([0, 1, 1, 0, 1, 1, 1], MaximumCount). 
 
MaximumCount = 3 
 
yes 
| ?- consecutive_ones([0, 0, 0, 0], MaximumCount). 
 
MaximumCount = 0 
 
yes 
| ?- consecutive_ones([1, 0, 1, 0, 1, 1], MaximumCount). 
 
MaximumCount = 2 
 
yes 
| ?-
    

Part 2: Final Price

You are given an array of item prices. Write a script to find out the final price of each items in the given array. There is a special discount scheme going on. If there’s an item with a lower or equal price later in the list, you get a discount equal to that later price (the first one you find in order).

The code required is fairly small, we’ll just need a couple of predicates.

"ch-2.p" 5


next smallest 6
compute lowest prices 7

Given a list and a price find the next smallest price in the list.

next smallest 6 ⟩≡


next_smallest([], _, 0).
next_smallest([H|_], Price, H):-
H =< Price, !.
next_smallest([H|T], Price, LowestPrice):-
H > Price,
next_smallest(T, Price, LowestPrice).

Fragment referenced in 5.

compute lowest prices 7 ⟩≡


compute_lowest([], []).
compute_lowest([H|T], [LowestPrice|LowestPrices1]):-
compute_lowest(T, LowestPrices1),
next_smallest(T, H, Discount),
LowestPrice is H - Discount.

Fragment referenced in 5.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- compute_lowest([8, 4, 6, 2, 3], FinalPrices). 
 
FinalPrices = [4,2,4,2,3] 
 
yes 
| ?- compute_lowest([1, 2, 3, 4, 5], FinalPrices). 
 
FinalPrices = [1,2,3,4,5] 
 
yes 
| ?- compute_lowest([7, 1, 1, 5], FinalPrices). 
 
FinalPrices = [6,0,1,5] 
 
yes 
| ?-
    

References

The Weekly Challenge 325
Generated Code

posted at: 15:33 by: Adam Russell | path: /prolog | permanent link to this entry

2025-06-08

The Weekly Challenge 324 (Prolog Solutions)

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

Part 1: 2D Array

You are given an array of integers and two integers $r and $c. Write a script to create two dimension array having $r rows and $c columns using the given array.

Our solution is short and will be contained in a single file that has the following structure.

"ch-1.p" 1


create two dimensional array 2

We’ll use a straightforward recursive approach.

create two dimensional array 2 ⟩≡


create_array(_, 0, _, []).
create_array(L, Rows, Columns, [Row|T]) :-
create_row(L, Columns, Row, L1),
R is Rows - 1,
create_array(L1, R, Columns, T).

create_row(L, 0, [], L).
create_row([H|T], Columns, [H|Row], L) :-
C is Columns - 1,
create_row(T, C, Row, L).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- create_array([1, 2, 3, 4], 2, 2, TwoDArray). 
 
TwoDArray = [[1,2],[3,4]] ? 
 
yes 
| ?- create_array([1, 2, 3], 1, 3, TwoDArray). 
 
TwoDArray = [[1,2,3]] ? 
 
yes 
| ?- create_array([1, 2, 3, 4], 4, 1, TwoDArray). 
 
TwoDArray = [[1],[2],[3],[4]] ? 
 
yes 
| ?-
    

Part 2: Total XOR

You are given an array of integers. Write a script to return the sum of total XOR for every subset of given array.

GNU Prolog has a sublist/2 predicate which will generate all needed subsets on backtracking. We’ll use this inside of a findall/3. The code required is fairly small, although we’ll define a couple of small utility predicates.

"ch-2.p" 3


subtotal 6
compute total xor 4
combine xors 5

compute total xor 4 ⟩≡


total_xor(L, Total):-
findall(S, (
sublist(S, L),
\+ S = []
), SubLists),
maplist(combine, SubLists, Combined),
maplist(subtotal, Combined, SubTotals),
sum_list(SubTotals, Total).

Fragment referenced in 3.

combine xors 5 ⟩≡


combine([], 0).
combine([H|T], Combined):-
combine(T, Combined1),
Combined = xor(H, Combined1).

Fragment referenced in 3.

subtotal 6 ⟩≡


subtotal(Combined, X):-
X is Combined.

Fragment referenced in 3.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- total_xor([1, 3], Total). 
 
Total = 6 
 
yes 
| ?- total_xor([5, 1, 6], Total). 
 
Total = 28 
 
yes 
| ?- total_xor([3, 4, 5, 6, 7, 8], Total). 
 
Total = 480 
 
yes 
| ?-
    

References

The Weekly Challenge 324
Generated Code

posted at: 14:40 by: Adam Russell | path: /prolog | permanent link to this entry

2025-06-06

The Weekly Challenge 323 (Prolog Solutions)

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

Part 1: Increment Decrement

You are given a list of operations. Write a script to return the final value after performing the given operations in order. The initial value is always 0.

Our solution will be contained in a single file that has the following structure.

"ch-1.p" 1


update input variables 4
state of the variables 2
process input 3
show final state of the variables 5
increment decrement 6

We’ll use a DCG approach to process the input and maintain the state of the variables.

First, let’s have some predicates for maintaining the state of the variables as the DCG processes the input.

state of the variables 2 ⟩≡


variables(VariableState), [VariableState] --> [VariableState].
variables(V, VariableState), [VariableState] --> [V].

Fragment referenced in 1.

Now we need to process the input, which we’ll treat as lists of character codes.

process input 3 ⟩≡


process(Input) --> variables(V, VariableState),
{Input = [Code1, Code2, Code3 | Codes],
Code1 == 43, Code2 == 43, Code3 >= 97,
Code3 =< 122,
increment_variable(Code3, V, VariableState)},
process(Codes).
process(Input) --> variables(V, VariableState),
{Input = [Code1, Code2, Code3 | Codes],
Code2 == 43, Code3 == 43, Code1 >= 97,
Code1 =< 122,
increment_variable(Code1, V, VariableState)},
process(Codes).
process(Input) --> variables(V, VariableState),
{Input = [Code1, Code2, Code3 | Codes],
Code1 == 45, Code2 == 45, Code3 >= 97,
Code3 =< 122,
decrement_variable(Code3, V, VariableState)},
process(Codes).
process(Input) --> variables(V, VariableState),
{Input = [Code1, Code2, Code3 | Codes],
Code2 == 45, Code3 == 45, Code1 >= 97,
Code1 =< 122,
decrement_variable(Code1, V, VariableState)},
process(Codes).
process(Input) --> variables(V, VariableState),
{Input = [Code | Codes],
Code >= 97, Code =< 122,
declare_variable(Code, V, VariableState)},
process(Codes).
process(Input) --> {Input = [Code | Codes],
Code == 32},
process(Codes).
process([]) --> [].

Fragment referenced in 1.

We’ll define some utility predicates for updating the state of the variables in our DCG input.

update input variables 4 ⟩≡


increment_variable(X, U, V):-
member(X-I, U),
delete(U, X-I, U1),
I1 is I + 1,
append([X-I1], U1, V).
increment_variable(X, U, V):-
\+ member(X-_, U),
append([X-1], U, V).
decrement_variable(X, U, V):-
member(X-I, U),
delete(U, X-I, U1),
I1 is I - 1,
append([X-I1], U1, V).
decrement_variable(X, U, V):-
\+ member(X-_, U),
append([X-(-1)], U, V).
declare_variable(X, U, V):-
delete(U, X-_, U1),
append([X-0], U1, V).

Fragment referenced in 1.

One more small utility predicate. This one is for displaying the final results. It’s intended to be called from maplist/2.

show final state of the variables 5 ⟩≡


show_variables(X-I):-
atom_codes(A, [X]),
write(A),
write(’:␣’),
write(I), nl.

Fragment referenced in 1.

Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3.

increment decrement 6 ⟩≡


increment_decrement(Input):-
phrase(process(Input), [[]], [Output]), !,
maplist(show_variables, Output).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- increment_decrement("--xx++x++"). 
x: 1 
 
yes 
| ?- increment_decrement("x++++xx++"). 
x: 3 
 
(1 ms) yes 
| ?- increment_decrement("x++++x--xx--"). 
x: 0 
 
yes 
| ?- increment_decrement("abca++b++c++++a++b++c--a--b--ca--b--c--a++++bc++"). 
c: 1 
b: 1 
a: 1 
 
yes 
| ?-
    

Part 2: Tax Amount

You are given an income amount and tax brackets. Write a script to calculate the total tax amount.

While a DCG approach is also certainly possible for this second part we’ll go with a more plain recursive solution.

"ch-2.p" 7


compute taxes 8

The code is simple enough that it is pretty explainable in one single code section.

compute taxes 8 ⟩≡


compute_taxes(Income, TaxBrackets, Tax):-
compute_taxes(Income, TaxBrackets, 0, 0, Tax).
compute_taxes(0, _, 0, 0, 0).
compute_taxes(Income, [[Limit, Rate]|TaxBrackets], Taxable, Taxed, Tax):-
Limit =< Income,
Taxable1 is Limit - Taxable,
Taxed1 is Taxed + Taxable1,
compute_taxes(Income, TaxBrackets, Taxable1, Taxed1, Tax1),
Tax is Tax1 + (Taxable1 * (Rate/100)).
compute_taxes(Income, [[Limit, Rate]|_], _, Taxed, Tax):-
Limit > Income,
Tax is ((Income - Taxed) * (Rate/100)).

Fragment referenced in 7.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- compute_taxes(10, [[3, 50], [7, 10], [12,25]], Tax), format("$~2f", [Tax]). 
$2.65 
 
Tax = 2.6499999999999999 ? 
 
yes 
| ?- compute_taxes(2, [[1, 0], [4, 25], [5,50]], Tax), format("$~2f", [Tax]). 
$0.25 
 
Tax = 0.25 ? 
 
yes 
| ?- compute_taxes(0, [[2, 50]], Tax), format("$~2f", [Tax]). 
$0.00 
 
Tax = 0 ? 
 
yes 
| ?-
    

References

The Weekly Challenge 323
Generated Code

posted at: 17:05 by: Adam Russell | path: /prolog | permanent link to this entry

2025-05-26

The Weekly Challenge 322 (Prolog Solutions)

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

Part 1:String Format

You are given a string and a positive integer. Write a script to format the string, removing any dashes, in groups of size given by the integer. The first group can be smaller than the integer but should have at least one character. Groups should be separated by dashes.

Our solution will be contained in a single file that has the following structure.

"ch-1.p" 1


state of the formatted string 2
process string 3
string format 4

We’ll use a DCG approach to process the string and maintain the result.

First, let’s have some predicates for maintaining the state of a character list as the DCG processes the string.

state of the formatted string 2 ⟩≡


format_(Format), [Format] --> [Format].
format_(F, Format), [Format] --> [F].

Fragment referenced in 1.

Now we need to process the strings, which we’ll treat as lists of character codes.

process string 3 ⟩≡


process(String, I, J) --> {String = [Code | Codes],
Code == 45},
process(Codes, I, J).
process(String, I, J) --> format_(F, Format),
{String = [Code | Codes],
\+ Code == 45,
succ(J, I),
char_code(C, Code),
length(Codes, L),
((L > 0, Format = [’-’, C|F]);
(Format = [C|F]))},
process(Codes, I, 0).
process(String, I, J) --> format_(F, Format),
{String = [Code | Codes],
\+ Code == 45,
succ(J, J1),
char_code(C, Code),
Format = [C|F]},
process(Codes, I, J1).
process([], _, _) --> [].

Fragment referenced in 1.

Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3. We’re going to work from right to left so we’ll use reverse/2 to input into our DCG.

string format 4 ⟩≡


string_format(String, I, FormattedString):-
reverse(String, R),
phrase(process(R, I, 0), [[]], [F]), !,
atom_chars(FormattedString, F).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- string_format("ABC-D-E-F", 3, F). 
 
F = ’ABC-DEF’ 
 
yes 
| ?- string_format("A-BC-D-E", 2, F). 
 
F = ’A-BC-DE’ 
 
yes 
| ?- string_format("-A-B-CD-E", 4, F). 
 
F = ’A-BCDE’ 
 
yes 
| ?-
    

Part 2: Rank Array

You are given an array of integers. Write a script to return an array of the ranks of each element: the lowest value has rank 1, next lowest rank 2, etc. If two elements are the same then they share the same rank.

We’ll sort/2 the list of integers and then use the sroted list to look up the rank using nth/3. Remember, sort/2 removes duplicates! If it did not this approach would require extra work to first get the unique values.

"ch-2.p" 5


rank lookup  6
rank list 7

This is a predicate we’ll call via maplist.

rank lookup  6 ⟩≡


rank(SortedList, X, Rank):-
nth(Rank, SortedList, X).

Fragment referenced in 5.

We’ll define a predicate to do an initial sort and call rank/3.

rank list 7 ⟩≡


rank_list(L, Ranks):-
sort(L, Sorted),
maplist(rank(Sorted), L, Ranks).

Fragment referenced in 5.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- rank_list([55, 22, 44, 33], Ranks). 
 
Ranks = [4,1,3,2] ? 
 
yes 
| ?- rank_list([10, 10, 10], Ranks). 
 
Ranks = [1,1,1] ? 
 
yes 
| ?- rank_list([5, 1, 1, 4, 3], Ranks). 
 
Ranks = [4,1,1,3,2] ? 
 
yes 
| ?-
    

References

The Weekly Challenge 322
Generated Code

posted at: 00:31 by: Adam Russell | path: /prolog | permanent link to this entry

2025-05-18

The Weekly Challenge 321 (Prolog Solutions)

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

Part 1: Distinct Average

You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.

Our solution will be pretty short, contained in just a single file that has the following structure.

"ch-1.p" 1


first last 2
distinct average 3

We’ll define a predicate for getting the minimum/maximum pairs. These will be the first/last pairs from a sorted list.

first last 2 ⟩≡


first_last([], []).
first_last(Numbers, FirstLastPairs):-
nth(1, Numbers, First),
last(Numbers, Last),
append([First|Rest], [Last], Numbers),
first_last(Rest, FirstLastPairs0),
append([[First, Last]], FirstLastPairs0, FirstLastPairs).

Fragment referenced in 1.

We just need a single predicate to sort the given list of numbers, call first_last/2, call maplist/2 with sum_list/2, sort/2 the results, and return the count of unique pairs. Since we only have pairs of numbers their averages will be the same if their sums are the same. (This also allows us to ignore potential floating point number annoyances). Also, remember that sort/2 will remove duplicates.

distinct average 3 ⟩≡


distinct_average(Numbers, DistinctAverage):-
sort(Numbers, NumbersSorted),
first_last(NumbersSorted, MinimumMaximumPairs),
maplist(sum_list, MinimumMaximumPairs, MinimumMaximumSums),
sort(MinimumMaximumSums, MinimumMaximumSumsSorted),
length(MinimumMaximumSumsSorted, DistinctAverage).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- distinct_average([1, 2, 4, 3, 5, 6], DistinctAverage). 
 
DistinctAverage = 1 ? 
 
yes 
| ?- distinct_average([0, 2, 4, 8, 3, 5], DistinctAverage). 
 
DistinctAverage = 2 ? 
 
yes 
| ?- distinct_average([7, 3, 1, 0, 5, 9], DistinctAverage). 
 
DistinctAverage = 2 ? 
 
yes 
| ?-
    

Part 2: Backspace Compare

You are given two strings containing zero or more #. Write a script to return true if the two given strings are same by treating # as backspace.

We’ll use a DCG approach to process the strings and maintain an list of characters.

"ch-2.p" 4


state of the character list 5
process string 6
backspace compare 7

Let’s have some predicates for maintaining the state of a character list as the DCG processes the string.

state of the character list 5 ⟩≡


characters(Characters), [Characters] --> [Characters].
characters(C, Characters), [Characters] --> [C].

Fragment referenced in 4.

Now we need to process the strings, which we’ll treat as lists of character codes.

process string 6 ⟩≡


process(String) --> characters(C, Characters),
{String = [Code | Codes],
last(C, PreviousCharacter),
((Code \== 35, char_code(C0, Code),
append(C, [C0], Characters));
(append(Characters, [PreviousCharacter], C))), !},
process(Codes).
process([]) --> [].

Fragment referenced in 4.

Finally, let’s wrap the calls to the DCG in a small predicate using phrase/3. This will process both strings and then compare the results.

backspace compare 7 ⟩≡


backspace_compare(String1, String2):-
phrase(process(String1), [[’’]], [R1]),
delete(R1, ’’, R2),
atom_chars(Result1, R2),
phrase(process(String2), [[’’]], [R3]),
delete(R3, ’’, R4),
atom_chars(Result2, R4),
Result1 == Result2.

Fragment referenced in 4.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- backspace_compare("ab#c", "ad#c"). 
 
yes 
| ?- backspace_compare("ab##", "a#b#"). 
 
yes 
| ?- backspace_compare("a#b", "c"). 
 
no 
| ?-
    

References

The Weekly Challenge 321
Generated Code

posted at: 13:02 by: Adam Russell | path: /prolog | permanent link to this entry

2025-05-11

The Weekly Challenge 320 (Prolog Solutions)

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

Part 1: Maximum Count

You are given an array of integers. Write a script to return the maximum between the number of positive and negative integers. Zero is neither positive nor negative.

Our solution will be pretty short, contained in just a single file that has the following structure.

"ch-1.p" 1


identify negatives 2
identify positives 3
count negatives 4
count positives 5
maximum count 6

We’ll define two predicates for counting the number of negative and positive numbers. These will use small helper predicates to be called via maplist.

identify negatives 2 ⟩≡


identify_negatives(Number, 1):-
Number < 0.
identify_negatives(_, 0).

Fragment referenced in 1.

identify positives 3 ⟩≡


identify_positives(Number, 1):-
Number > 0.
identify_positives(_, 0).

Fragment referenced in 1.

count negatives 4 ⟩≡


count_negatives(Numbers, Count):-
maplist(identify_negatives, Numbers, Negatives),
sum_list(Negatives, Count).

Fragment referenced in 1.

count positives 5 ⟩≡


count_positives(Numbers, Count):-
maplist(identify_positives, Numbers, Positives),
sum_list(Positives, Count).

Fragment referenced in 1.

We’ll need a predicate to tie everything together, that’s what this next one does.

maximum count 6 ⟩≡


maximum_count(Numbers, MaximumCount):-
count_negatives(Numbers, NegativesCount),
count_positives(Numbers, PositivesCount),
max_list([NegativesCount, PositivesCount], MaximumCount).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- maximum_count([-3, -2, -1, 1, 2, 3], MaximumCount). 
 
MaximumCount = 3 ? 
 
yes 
| ?- maximum_count([-2, -1, 0, 0, 1], MaximumCount). 
 
MaximumCount = 2 ? 
 
yes 
| ?- maximum_count([1, 2, 3, 4], MaximumCount). 
 
MaximumCount = 4 ? 
 
yes 
| ?-
    

Part 2: Sum Differences

You are given an array of positive integers. Write a script to return the absolute difference between digit sum and element sum of the given array.

As in the first part, our solution will be pretty short, contained in just a single file.

"ch-2.p" 7


char_number 10
element sum 8
digit sum 9
sum differences 11

The element sum is a straightforward application of the builtin predicate sum_list/2.

element sum 8 ⟩≡


element_sum(Numbers, ElementSum):-
sum_list(Numbers, ElementSum).

Fragment referenced in 7.

To compute the digit sum we’ll first convert them to characters, via maplist, flatten the list, convert them back to numbers, and take the sum_list.

digit sum 9 ⟩≡


digit_sum(Numbers, DigitSum):-
maplist(number_chars, Numbers, Characters),
flatten(Characters, CharactersFlattened),
maplist(char_number, CharactersFlattened, Digits),
sum_list(Digits, DigitSum).

Fragment referenced in 7.

The above predicate, for convenience of the maplist, requires a small helper predicate to reverse the arguments of numbers_chars.

char_number 10 ⟩≡


char_number(C, N):-
number_chars(N, [C]).

Fragment referenced in 7.

sum_difference/2 is the main predicate, which calls the others we’ve defined so far.

sum differences 11 ⟩≡


sum_differences(Numbers, Differences):-
element_sum(Numbers, ElementSum),
digit_sum(Numbers, DigitSum),
Differences is abs(DigitSum - ElementSum).

Fragment referenced in 7.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- sum_differences([1, 23, 4, 5], SumDifferences). 
 
SumDifferences = 18 
 
yes 
| ?- sum_differences([1, 2, 3, 4, 5], SumDifferences). 
 
SumDifferences = 0 
 
yes 
| ?- sum_differences([1, 2, 34], SumDifferences). 
 
SumDifferences = 27 
 
yes 
| ?-
    

References

The Weekly Challenge 320
Generated Code

posted at: 13:04 by: Adam Russell | path: /prolog | permanent link to this entry

2025-05-04

The Weekly Challenge 319 (Prolog Solutions)

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

Part 1: Word Count

You are given a list of words containing alphabetic characters only. Write a script to return the count of words either starting with a vowel or ending with a vowel.

Our solution will be pretty short, contained in just a single file that has the following structure.

"ch-1.p" 1


vowels 2
start_end_vowel 3
word count 4

We’re going to be using character codes for this. For convenience let’s declare are vowels this way.

vowels 2 ⟩≡


vowel(97). % a
vowel(101). % e
vowel(105). % i
vowel(111). % o
vowel(117). % u

Fragment referenced in 1.

We’ll use a small predicate, later to be called from maplist, to check if a word starts or ends with a vowel.

start_end_vowel 3 ⟩≡


start_end_vowel(Word, StartsEnds):-
((nth(1, Word, FirstLetter),
vowel(FirstLetter));
(last(Word, LastLetter),
vowel(LastLetter))),
StartsEnds = true.
start_end_vowel(_, -1).

Fragment referenced in 1.

We’ll need a predicate to tie everything together, that’s what this next one does.

word count 4 ⟩≡


word_count(Words, Count):-
maplist(start_end_vowel, Words, StartsEndsAll),
delete(StartsEndsAll, -1, StartsEnds),
length(StartsEnds, Count).

Fragment referenced in 1.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- word_count(["unicode", "xml", "raku", "perl"], Count). 
 
Count = 2 ? 
 
yes 
| ?- word_count(["the", "weekly", "challenge"], Count). 
 
Count = 2 ? 
 
yes 
| ?- word_count(["perl", "python", "postgres"], Count). 
 
Count = 0 
 
yes 
| ?-
    

Part 2: Minimum Common

You are given two arrays of integers. Write a script to return the minimum integer common to both arrays. If none found return -1.

As in the first part, our solution will be pretty short, contained in just a single file.

"ch-2.p" 5


minimum common 7

To check for common elements is easy in Prolog. First we subtract/3 all elements of one list from the other. That will give us the unique elements. Then we’ll delete the unique elements from one of the original lists to get all common elements. After that min_list/2 determines the result.

subtract lists to determine common elemets 6 ⟩≡


subtract(List1, List2, Difference1),
subtract(List2, List1, Difference2),
append(Difference1, Difference2, Differences),
subtract(List1, Differences, Common),

Fragment referenced in 7.

Defines: Common 7.

minimum_common/3 is the main (and only) predicate we define

minimum common 7 ⟩≡


minimum_common(List1, List2, MinimumCommon):-
subtract lists to determine common elemets 6
length(Common, L),
L >= 1,
min_list(Common, MinimumCommon).
minimum_common(_, _, -1).

Fragment referenced in 5.

Uses: Common 6.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- minimum_common([1, 2, 3, 4], [3, 4, 5, 6], MinimumCommon). 
 
MinimumCommon = 3 ? 
 
yes 
| ?- minimum_common([1, 2, 3], [2, 4], MinimumCommon). 
 
MinimumCommon = 2 ? 
 
yes 
| ?- minimum_common([1, 2, 3, 4], [5, 6, 7, 8], MinimumCommon). 
 
MinimumCommon = -1 
 
yes 
| ?-
    

References

The Weekly Challenge 319
Generated Code

posted at: 14:47 by: Adam Russell | path: /prolog | permanent link to this entry

2025-04-27

The Weekly Challenge 318 (Prolog Solutions)

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

Part 1: Group Position

You are given a string of lowercase letters. Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return “” if none found.

We can do this in a single predicate which uses maplist to get the groupings with a small utility predicate.

utility predicate for finding groups 1 ⟩≡


group(Letters, Letter, Group):-
length(Letters, LengthLetters),
delete(Letters, Letter, Deleted),
length(Deleted, LengthDeleted),
Difference is LengthLetters - LengthDeleted,
Difference >= 3,
length(G1, Difference),
maplist(=(Letter), G1),
append(G1, _, G2),
append(_, G2, Letters),
atom_codes(Group, G1).
group(_, _, nil).

Fragment referenced in 3.

groupings 2 ⟩≡


groupings(Word, Groupings):-
sort(Word, UniqueLetters),
maplist(group(Word), UniqueLetters, Groups),
delete(Groups, nil, Groupings).

Fragment referenced in 3.

The rest of the code just wraps this single predicate into a file.

"ch-1.p" 3


utility predicate for finding groups 1
groupings 2

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- groupings("abccccd", Groupings). 
 
Groupings = [cccc] ? 
 
yes 
| ?- groupings("aaabcddddeefff", Groupings). 
 
Groupings = [aaa,dddd,fff] ? 
 
yes 
| ?- groupings("abcdd", Groupings). 
 
Groupings = [] 
 
yes 
| ?-
    

Part 2: Reverse Equals

You are given two arrays of integers, each containing the same elements as the other. Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.

This is going to be a quick one, but there’s going to be a few pieces we need to take care of. First we will check that we can subtract/3 the two words (character code lists) and obtain an empty list. Then we’ll check in which places the words differ. If they differ in one place or more then we’re done. Otherwise we’ll test the reversal of the sublist.

test elements 4 ⟩≡


subtract(List1, List2, []),

Fragment referenced in 8.

Uses: List1 8, List2 8.

find differences 5 ⟩≡


length(List1, Length),
findall(I, (
between(1, Length, I),
nth(I, List1, C1),
nth(I, List2, C2),
\+ C1 = C2
), DifferenceIndices),

Fragment referenced in 8.

Defines: DifferenceIndices 6, 8.

Uses: List1 8, List2 8.

get sublists 6 ⟩≡


length(DifferenceIndices, NumberDifferences),
NumberDifferences > 0,
nth(1, DifferenceIndices, FirstIndex),
last(DifferenceIndices, LastIndex),
findall(E, (
between(FirstIndex, LastIndex, I),
nth(I, List1, E)
), SubList1),
findall(E, (
between(FirstIndex, LastIndex, I),
nth(I, List2, E)
), SubList2),

Fragment referenced in 8.

Defines: SubList1 7, SubList2 7.

Uses: DifferenceIndices 5, List1 8, List2 8.

test sublists and their reversals 7 ⟩≡


reverse(SubList1, Reverse1),
reverse(SubList2, Reverse2),
append(SubList1, Suffix1, S1),
append(SubList2, Suffix2, S2),
append(Reverse1, Suffix1, S3),
append(Reverse2, Suffix2, S4),
append(Prefix1, S1, List1),
append(Prefix2, S2, List2),
(append(Prefix1, S3, List2); append(Prefix2, S4, List1))

Fragment referenced in 8.

Uses: List1 8, List2 8, SubList1 6, SubList2 6.

All these pieces will be assembled into reverse_equals/2.

reverse equals 8 ⟩≡


reverse_equals(List1, List2):-
test elements 4
find differences 5
get sublists 6
test sublists and their reversals 7 .
reverse_equals(List1, List2):-
test elements 4
find differences 5
length(DifferenceIndices, NumberDifferences),
NumberDifferences = 0.

Fragment referenced in 9.

Defines: List1 4, 5, 6, 7, List2 4, 5, 6, 7.

Uses: DifferenceIndices 5.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 9


reverse equals 8

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- reverse_equals([3, 2, 1, 4], [1, 2, 3, 4]). 
 
true ? 
 
yes 
| ?- reverse_equals([1, 3, 4], [4, 1, 3]). 
 
no 
| ?- reverse_equals([2], [2]). 
 
yes 
| ?-
    

References

The Weekly Challenge 318
Generated Code

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

2025-04-19

The Weekly Challenge 317 (Prolog Solutions)

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

Part 1: Acronyms

You are given an array of words and a word. Write a script to return true if concatenating the first letter of each word in the given array matches the given word, return false otherwise.

We can do this in a single predicate which uses maplist to get the first character from each word, which we’ll take as a list of character code lists.

acronym 1 ⟩≡


acronym(Words, Word):-
maplist(nth(1), Words, FirstLetters),
Word = FirstLetters.

Fragment referenced in 2.

The rest of the code just wraps this single predicate into a file.

"ch-1.p" 2


acronym 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- acronym(["Perl", "Weekly", "Challenge"], "PWC"). 
 
yes 
| ?- acronym(["Bob", "Charlie", "Joe"], "BCJ"). 
 
yes 
| ?- acronym(["Morning", "Good"], "MM"). 
 
no 
| ?-
    

Part 2: Friendly Strings

You are given two strings. Write a script to return true if swapping any two letters in one string match the other string, return false otherwise.

This is going to be a quick one. First we will check that we can subtract/3 the two words (character code lists) and obtain an empty list. Then we’ll check in which places the words differ. They must only differ in exactly two places.

friendly 3 ⟩≡


friendly(Word1, Word2):-
subtract(Word1, Word2, []),
length(Word1, Length),
findall(Difference, (
between(1, Length, I),
nth(I, Word1, C1),
nth(I, Word2, C2),
\+ C1 = C2,
Difference = [C1, C2]
), Differences),
length(Differences, NumberDifferences),
NumberDifferences == 2.

Fragment referenced in 4.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 4


friendly 3

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- friendly("desc", "dsec"). 
 
yes 
| ?- friendly("cat", "dog"). 
 
no 
| ?- friendly("stripe", "sprite"). 
 
yes 
| ?-
    

References

The Weekly Challenge 317
Generated Code

posted at: 21:39 by: Adam Russell | path: /prolog | permanent link to this entry

2025-04-12

The Weekly Challenge 316 (Prolog Solutions)

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

Part 1: Circular

You are given a list of words. Write a script to find out whether the last character of each word is the first character of the following word.

We can do this in a single predicate which recursively examines the list of words, which we’ll take as a list of character code lists.

circular 1 ⟩≡


circular([]).
circular([_]).
circular([H0, H1|T]):-
last(H0, C0),
nth(1, H1, C1),
C0 = C1,
circular([H1|T]).

Fragment referenced in 2.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 2


circular 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- circular(["perl", "loves", "scala"]). 
 
true ? 
 
(1 ms) yes 
| ?- circular(["love", "the", "programming"]). 
 
no 
| ?- circular(["java", "awk", "kotlin", "node.js"]). 
 
true ? 
 
yes 
| ?-
    

Part 2: Subsequence

You are given two strings. Write a script to find out if one string is a subsequence of another.

This is going to be a quick one, seeing as GNU Prolog has a sublist/2 predicate which does exactly this! As in the previous part we’ll take the strings as lists of character codes.

subsequence 3 ⟩≡


subsequence(S, T):-
sublist(S, T).

Fragment referenced in 4.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 4


subsequence 3

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- subsequence("uvw", "bcudvew"). 
 
true ? 
 
yes 
| ?- subsequence("aec", "abcde"). 
 
no 
| ?- subsequence("sip", "javascript"). 
 
true ? 
 
yes 
| ?-
    

References

The Weekly Challenge 316
Generated Code

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

2025-04-06

The Weekly Challenge 315 (Prolog Solutions)

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

Part 1: Find Words

You are given a list of words and a character. Write a script to return the index of word in the list where you find the given character.

This can be done with a basic predicate with findall. Or we can use maplist! maplist is more fun in my opinion, so we’ll go with that.

First off a small utility predicate to see if a word contains a given letter.

contains letter 1 ⟩≡


contains_letter(Letter, Index-Word, Index):-
atom_chars(Word, C),
member(Letter, C).
contains_letter(_, _, -1).

Fragment referenced in 4.

You can see that we are sending that previous predicate a pair. The first element in that pair is an index. Let’s build a word index, mainly for the sake of avoiding the use of between and findall. Those builtin predicates are fine, but aesthetically to me it seems nicer to not use them if we absolutely don’t have to.

build word index 2 ⟩≡


word_index(Words, Index):-
word_index(Words, 0, Index).
word_index([], _, []).
word_index([H|T], N, [I-H|Index]):-
succ(N, I),
word_index(T, I, Index).

Fragment referenced in 4.

Now we’ll use maplist to find the words.

find the indices of words that contain the letter 3 ⟩≡


find_words(Words, Letter, Indices):-
word_index(Words, Index),
maplist(contains_letter(Letter), Index, I),
delete(I, -1, Indices).

Fragment referenced in 4.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 4


contains letter 1
build word index 2
find the indices of words that contain the letter 3

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- find_words([the, weekly, challenge], e, Indices). 
 
Indices = [1,2,3] ? 
 
yes 
| ?- find_words([perl, raku, python], p, Indices). 
 
Indices = [1,3] ? 
 
yes 
| ?- find_words([abc, def, bbb, bcd], b, Indices). 
 
Indices = [1,3,4] ? 
 
yes 
| ?-
    

Part 2: Find Third

You are given a sentence and two words. Write a script to return all words in the given sentence that appear in sequence to the given two words.

In the first part I mentioned the between and findall predicates. Here we will use them to find successive words.

find third 5 ⟩≡


find_third(Words, One, Two, Thirds):-
length(Words, WordLength),
N is WordLength - 2,
findall(Third, (
between(1, N, I),
succ(I, J),
nth(I, Words, One),
nth(J, Words, Two),
succ(J, K),
nth(K, Words, Third)
), Thirds).

Fragment referenced in 6.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 6


find third 5

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- find_third([’Perl’, is, a, my, favourite, language, but, ’Python’, is, my, favourite, too], my, favourite, Thirds). 
 
Thirds = [language,too] 
 
yes 
| ?- find_third([’Barbie’, is, a, beautiful, doll, also, also, a, beautiful, princess], a, beautiful, Thirds). 
 
Thirds = [doll,princess] 
 
yes 
| ?- find_third([we, will, we, will, rock, you, rock, you], we, will, Thirds). 
 
Thirds = [we,rock] 
 
yes 
| ?-
    

References

The Weekly Challenge 315
Generated Code

posted at: 17:41 by: Adam Russell | path: /prolog | permanent link to this entry

2025-03-29

The Weekly Challenge 314 (Prolog Solutions)

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

Part 1: Equal Strings

You are given three strings. You are allowed to remove the rightmost character of a string to make all equals. Write a script to return the number of operations to make it equal otherwise -1.

The approach we’ll take is to pop off the last letter of each and compare the remainders. If they are equal then we are done. Otherwise we’ll continue popping off letter until we’re done.

A special case to consider is when the strings are of unequal length. In that case we make sure to only pop off letters from equal length strings, although the untouched strings will still be used when checking to see if we are done.

We’re going to define some convenience predicates, some with the intention that they’re going to be called from a maplist.

remove last letter 1 ⟩≡


remove_last(S, S1):-
length(Last, 1),
append(S1, Last, S).

Fragment referenced in 7.

strings all of the same size 2 ⟩≡


match_length(Length, S, S):-
length(S, Length).
match_length(_, _, nil).

Fragment referenced in 7.

all strings are equal 3 ⟩≡


all_equal([H|T]):-
maplist(==(H), T).

Fragment referenced in 7.

all strings are empty 4 ⟩≡


all_empty(L):-
maplist(==([]), L).

Fragment referenced in 7.

max size of all strings 5 ⟩≡


max_string_size(Strings, MaxLength):-
maplist(length, Strings, Lengths),
max_list(Lengths, MaxLength).

Fragment referenced in 7.

We’ll define a predicate for doing all the co-ordination and overall logic.

equal strings 6 ⟩≡


equal_strings(Strings, Operations):-
equal_strings(Strings, 0, Operations), !.
equal_strings(Strings, Operations, Operations):-
last(Strings, S),
\+ S = [],
all_equal(Strings).
equal_strings(Strings, _, -1):-
last(Strings, S),
S = [].
equal_strings(Strings, OperationsAccum, Operations):-
max_string_size(Strings, MaxLength),
maplist(match_length(MaxLength), Strings, S1),
delete(S1, nil, S2),
subtract(Strings, S2, S4),
maplist(remove_last, S2, S3),
append(S4, S3, S5),
all_equal(S5),
\+ all_empty(S5),
length(S2, Removals),
Operations is OperationsAccum + Removals.
equal_strings(Strings, OperationsAccum, Operations):-
max_string_size(Strings, MaxLength),
maplist(match_length(MaxLength), Strings, S1),
delete(S1, nil, S2),
subtract(Strings, S2, S4),
maplist(remove_last, S2, S3),
append(S4, S3, S5),
\+ all_equal(S5),
length(S2, Removals),
O is OperationsAccum + Removals,
equal_strings(S5, O, Operations).

Fragment referenced in 7.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 7


remove last letter 1
strings all of the same size 2
all strings are equal 3
all strings are empty 4
max size of all strings 5
equal strings 6

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- equal_strings(["abb", "ab", "abc"], Operations). 
 
Operations = 2 
 
yes 
| ?- equal_strings(["ayz", "cyz", "xyz"], Operations). 
 
Operations = -1 
 
yes 
| ?- equal_strings(["yza", "yzb", "yzc"], Operations). 
 
Operations = 3 
 
yes 
| ?-
    

Part 2: Sort Column

You are given a list of strings of same length. Write a script to make each column sorted lexicographically by deleting any non sorted columns. Return the total columns deleted.

We’ll start with a short predicate for convenience.

column 8 ⟩≡


column(I, L, Column):-
maplist(nth(I), L, Column).

Fragment referenced in 10.

sort column 9 ⟩≡


sort_column(Strings, Removals):-
last(Strings, S),
length(S, L),
findall(R, (
between(1, L, I),
column(I, Strings, Column),
msort(Column, ColumnSorted),
\+ Column == ColumnSorted,
R = Column
), Rs),
length(Rs, Removals).

Fragment referenced in 10.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 10


column 8
sort column 9

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- sort_column(["swpc", "tyad", "azbe"], Removals). 
 
Removals = 2 
 
yes 
| ?- sort_column(["cba", "daf", "ghi"], Removals). 
 
Removals = 1 
 
yes 
| ?- sort_column(["a", "b", "c"], Removals). 
 
Removals = 0 
 
yes 
| ?-
    

References

The Weekly Challenge 314
Generated Code

posted at: 19:05 by: Adam Russell | path: /prolog | permanent link to this entry

2025-03-16

The Weekly Challenge 312 (Prolog Solutions)

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

Part 1: Minimum Time

You are given a typewriter with lowercase english letters a to z arranged in a circle. Typing a character takes 1 sec. You can move pointer one character clockwise or anti-clockwise. The pointer initially points at a. Write a script to return minimum time it takes to print the given string.

All the logic for computing the shortest move us contained in a single predicate.

compute minumum number of moves to get to the next letter 1 ⟩≡


compute_moves(Current, Next, Moves):-
X is Current - 96,
Y is Next - 96,
XH is X + 13,
YH is Y + 13,
((Y >= XH, Moves is X + 26 - Y);
(Y >= X, Y =< XH, Moves is Y - X);
(X >= YH, Moves is Y + 26 - X);
(X >= Y, X =< YH, Moves is X - Y)).

Fragment referenced in 3.

We’ll use a DCG to process the list of letters (we’re using ASCII codes).

process letters 2 ⟩≡


minimum_time([Current, Next|Letters]) --> [Time], {
compute_moves(Current, Next, Moves),
succ(Moves, Time)}, minimum_time([Next|Letters]).
minimum_time([_]) --> [].

Fragment referenced in 3.

Finally, let’s combine the previous predicates into a file along with a predicate minimum_time/2 that ties everything together.

"ch-1.p" 3


compute minumum number of moves to get to the next letter 1
process letters 2
minimum_time(S, MinimumTime):-
append([97], S, S0),
phrase(minimum_time(S0), Times),
sum_list(Times, MinimumTime), !.

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- minimum_time("abc", MinimumTime). 
 
MinimumTime = 5 
 
yes 
| ?- minimum_time("bza", MinimumTime). 
 
MinimumTime = 7 
 
yes 
| ?- minimum_time("zjpc", MinimumTime). 
 
MinimumTime = 34 
 
yes 
| ?-
    

Part 2: Balls and Boxes

There are $n balls of mixed colors: red, blue or green. They are all distributed in 10 boxes labelled 0-9. You are given a string describing the location of balls. Write a script to find the number of boxes containing all three colors. Return 0 if none found.

We’ll use a DCG here in Part 2, althought it’ll be just a little bit more intricate.

First off, we’ll be passing the state around via some helper predicates. At the end of processing we’ll have a set of pairs that hold the contents of each box.

state of the content of the boxes 4 ⟩≡


boxes(Boxes), [Boxes] --> [Boxes].
boxes(Box, Boxes), [Boxes] --> [Box].

Fragment referenced in 7.

Now the DCG. For each record given we’ll process each Ball/Box pair.

process the record of box contents as a list 5 ⟩≡


box_record([]) --> [].
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
var(B), B = Box-[Color], append([], [B], Boxes)},
box_record(T).
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
nonvar(B), member(Box-Colors, B), delete(B, Box-Colors, B0),
append([Color], Colors, Colors0), append([Box-Colors0], B0, Boxes)},
box_record(T).
box_record(Record) --> boxes(B, Boxes), {[Color, Box|T] = Record,
nonvar(B), \+ member(Box-_, B), append([Box-[Color]], B, Boxes)},
box_record(T).

Fragment referenced in 7.

helper predicate for checking if a box has all three colors 6 ⟩≡


full_box(_-Colors, Full):-
sort(Colors, ColorsSorted),
length(ColorsSorted, NumberColors),
((NumberColors == 3, Full = true);
(Full = false)).

Fragment referenced in 7.

Finally, let’s assemble our completed code into a single file. We’ll also add a predicate to co-orindate calling the DCG and processing the final result.

"ch-2.p" 7


state of the content of the boxes 4
process the record of box contents as a list 5
helper predicate for checking if a box has all three colors 6
full_boxes(BallsBoxes, CountFullBoxes):-
phrase(box_record(BallsBoxes), [_], [Boxes]),
maplist(full_box, Boxes, Full),
delete(Full, false, FullBoxes),
length(FullBoxes, CountFullBoxes), !.

Sample Run
$ gprolog --consult-file prolog/ch-2.p 
| ?- full_boxes("G0B1R2R0B0", FullBoxes). 
 
FullBoxes = 1 
 
yes 
| ?- full_boxes("G1R3R6B3G6B1B6R1G3", FullBoxes). 
 
FullBoxes = 3 
 
yes 
| ?- full_boxes("B3B2G1B3", FullBoxes). 
 
FullBoxes = 0 
 
yes 
| ?-
    

References

The Weekly Challenge 312
Generated Code

posted at: 15:35 by: Adam Russell | path: /prolog | permanent link to this entry

2025-03-09

The Weekly Challenge 311 (Prolog Solutions)

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

Part 1: Upper Lower

You are given a string consists of english letters only. Write a script to convert lower case to upper and upper case to lower in the given string.

GNU Prolog defines a predicate lower_upper/2 which does pretty much what this problem is asking for. We could also just use the character code values instead of chars, but using chars seems a little more elegant as it avoids ASCII math.

upper lower 1 ⟩≡


upper_lower(S, UpperLower):-
atom_chars(S, C),
upper_lower(C, UL, _),
atom_chars(UpperLower, UL).
upper_lower([], [], _).
upper_lower([C|T], [L|UL], _):-
lower_upper(C, C0),
C == C0,
lower_upper(L, C),
upper_lower(T, UL, _).
upper_lower([C|T], [U|UL], _):-
lower_upper(C, U),
\+ C == U,
upper_lower(T, UL, _).

Fragment referenced in 2.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 2


upper lower 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- upper_lower(’pERl’, UpperLower). 
 
UpperLower = ’PerL’ ? 
 
yes 
| ?- upper_lower(’rakU’, UpperLower). 
 
UpperLower = ’RAKu’ ? 
 
yes 
| ?- upper_lower(’PyThOn’, UpperLower). 
 
UpperLower = pYtHoN ? 
 
yes 
| ?-
    

Part 2: Group Digit Sum

You are given a string, $str, made up of digits, and an integer, $int, which is less than the length of the given string. Write a script to divide the given string into consecutive groups of size $int (plus one for leftovers if any). Then sum the digits of each group, and concatenate all group sums to create a new string. If the length of the new string is less than or equal to the given integer then return the new string, otherwise continue the process.

To solve this problem we need to do the following

  1. divide the list into groups of the given size
  2. compute the sums
  3. recombine
  4. repeat as needed

Let’s look at each of those pieces individually and then combine them together into one predicate.

divide the list into groups of the given size 3 ⟩≡


group_list(S, Size, GroupedList):-
atom_chars(S, C),
maplist(char_number, C, N),
group_list(N, Size, [], [], GroupedList).
group_list([], _, Group, GroupedListAccum, GroupedList):-
length(Group, L),
((L > 0, append(GroupedListAccum, [Group], GroupedList));
(GroupedList = GroupedListAccum)).
group_list([H|T], Size, Group, GroupedListAccum, GroupedList):-
length(Group, L),
L < Size,
append(Group, [H], G),
GLA = GroupedListAccum,
group_list(T, Size, G, GLA, GroupedList).
group_list([H|T], Size, Group, GroupedListAccum, GroupedList):-
length(Group, L),
L == Size,
append(GroupedListAccum, [Group], GLA),
group_list([H|T], Size, [], GLA, GroupedList).

Fragment referenced in 9.

Uses: GroupedList 8, Size 8.

turn a numeral into a number 4 ⟩≡


char_number(C, N):-
number_chars(N, [C]).

Fragment referenced in 9.

We can compute the sums using the GNU Prolog builtin predicate sum_list/2.

compute the sums 5 ⟩≡


maplist(sum_list, GroupedList, Sums),

Fragment referenced in 8.

Defines: Sums 7.

Uses: GroupedList 8.

join a list of numbers into a single atom 6 ⟩≡


join([], ’’).
join([H|T], A):-
join(T, A0),
number_atom(H, A1),
atom_concat(A1, A0, A).

Fragment referenced in 9.

recombine and check if done 7 ⟩≡


flatten(Sums, SumsFlatted),
join(SumsFlatted, A),
atom_property(A, length(Length)),
((Length =< Size, GroupDigitSum = A, !);
(group_digit_sum(A, Size, GroupDigitSum), !)).

Fragment referenced in 8.

Uses: GroupDigitSum 8, Size 8, Sums 5.

the main predicate 8 ⟩≡


group_digit_sum(S, Size, GroupDigitSum):-
group_list(S, Size, GroupedList),
compute the sums 5
recombine and check if done 7

Fragment referenced in 9.

Defines: GroupDigitSum 7, GroupedList 3, 5, Size 3, 7.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 9


the main predicate 8
divide the list into groups of the given size 3
turn a numeral into a number 4
join a list of numbers into a single atom 6

Sample Run
$ gprolog prolog/ch-2.p 
| ?- group_digit_sum(’111122333’, 3, GroupDigitSum). 
 
GroupDigitSum = ’359’ 
 
yes 
| ?- group_digit_sum(’1222312’, 2, GroupDigitSum). 
 
GroupDigitSum = ’76’ 
 
yes 
| ?- group_digit_sum(’100012121001’, 4, GroupDigitSum). 
 
GroupDigitSum = ’162’ 
 
yes 
| ?-
    

References

The Weekly Challenge 311
Generated Code

posted at: 00:39 by: Adam Russell | path: /prolog | permanent link to this entry

2025-03-02

The Weekly Challenge 310 (Prolog Solutions)

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

Part 1: Arrays Intersection

You are given a list of array of integers. Write a script to return the common elements in all the arrays.

Let’s define a predicate that can be called via maplist. This will just wrap member and be used to return a list of common elements. We’ll also remove duplicates (via sort).

Note that because the predicate used with maplist must be true for all list elements we’ll return a nil value if there is no match. We just need to make sure to delete all the nils before further using the list.

common element finder 1 ⟩≡


common_elements(L0, L1, Common):-
maplist(common_element(L0), L1, C0),
sort(C0, C1),
delete(C1, nil, Common).
common_element(L, X, X):-
member(X, L).
common_element(L, X, nil):-
\+ member(X, L).

Fragment referenced in 3.

The plan is to find the common elements in the first two lists and then compare those common elements against the rest of the lists, only keeping elements that continue to be in common. We’ll use tail recursion and an accumulator here.

process lists 2 ⟩≡


intersections(Lists, Intersections):-
intersections(Lists, [], Intersections).
intersections([H0, H1|[]], [], Intersections):-
common_elements(H0, H1, Intersections).
intersections([H0, H1|[]], IntersectionsAccum, Intersections):-
common_elements(H0, H1, Common),
common_elements(Common, IntersectionsAccum, Intersections).
intersections([H0, H1|T], IntersectionsAccum, Intersections):-
common_elements(H0, H1, Common),
append(IntersectionsAccum, Common, I),
intersections([Common|T], I, Intersections).

Fragment referenced in 3.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 3


common element finder 1
process lists 2

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- intersections([[1, 2, 3, 4], [4, 5, 6, 1], [4, 2, 1, 3]], Intersections). 
 
Intersections = [1,4] ? 
 
yes 
| ?- intersections([[1, 0, 2, 3], [2, 4, 5]], Intersections). 
 
Intersections = [2] ? 
 
yes 
| ?- intersections([[1, 2, 3], [4, 5], [6]], Intersections). 
 
Intersections = [] ? 
 
yes 
| ?-
    

Part 2: Sort Odd Even

You are given an array of integers. Write a script to sort odd index elements in decreasing order and even index elements in increasing order in the given array.

To solve this problem we need to do the following

  1. seperate the odd and even indexed numbers
  2. sort the two lists as directed
  3. combine the results

This problem was written with 0-based indices in mind so we will keep that in mind when calculating whether an index is odd or even.

seperate the odd and even indexed numbers 4 ⟩≡


odd_even_indexed(List, Odds, Evens):-
length(List, L),
findall(Odd,(
between(1, L, Index),
succ(I, Index),
M is I rem 2,
\+ M == 0,
nth(Index, List, Odd)
), Odds),
findall(Even,(
between(1, L, Index),
succ(I, Index),
M is I rem 2,
M == 0,
nth(Index, List, Even)
), Evens).

Fragment referenced in 8.

We’ll need a few more predicates to contain most of the rest of the work needed. To do the descending sort we’ll take the negatives of the numbers. We also need to combine the final result.

negate numbers 5 ⟩≡


negate(X, Y):-
Y is -1 * X.

Fragment referenced in 8.

combine 6 ⟩≡


combine(OddsSorted, EvensSorted, Combined):-
combine(OddsSorted, EvensSorted, 0, [], Combined).
combine([], [], _, Combined, Combined).
combine([O|OT], EvensSorted, Index, CombinedAccum, Combined):-
M is Index rem 2,
\+ M == 0,
append(CombinedAccum, [O], C),
succ(Index, I),
combine(OT, EvensSorted, I, C, Combined).
combine(OddsSorted, [E|ET], Index, CombinedAccum, Combined):-
M is Index rem 2,
M == 0,
append(CombinedAccum, [E], C),
succ(Index, I),
combine(OddsSorted, ET, I, C, Combined).

Fragment referenced in 8.

sort odd evens 7 ⟩≡


sort_odd_evens(List, Sorted):-
odd_even_indexed(List, Odds, Evens),
maplist(negate, Odds, OddsNegated),
sort(OddsNegated, OddsNegatedSorted),
maplist(negate, OddsNegatedSorted, OddsSorted),
sort(Evens, EvensSorted),
combine(OddsSorted, EvensSorted, Sorted).

Fragment referenced in 8.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 8


seperate the odd and even indexed numbers 4
negate numbers 5
combine 6
sort odd evens 7

Sample Run
$ gprolog prolog/ch-2.p 
| ?- sort_odd_evens([4, 1, 2, 3], Sorted). 
 
Sorted = [2,3,4,1] ? 
 
yes 
| ?- sort_odd_evens([3, 1], Sorted). 
 
Sorted = [3,1] ? 
 
yes 
| ?- sort_odd_evens([5, 3, 2, 1, 4], Sorted). 
 
Sorted = [2,3,4,1,5] ? 
 
yes 
| ?-
    

References

The Weekly Challenge 310
Generated Code

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

2025-02-23

The Weekly Challenge 309 (Prolog Solutions)

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

Part 1: Min Gap

You are given an array of integers, @ints, increasing order. Write a script to return the element before which you find the smallest gap.

There are probably a few good approaches to this problem. Here we’ll use a DCG approach. Ultimately this problem is at its core is to process a list of integers, and processing a list is something a DCG is well suited to handle.

We will be passing the state of the minimal gap found through the list processing predicates. The plan is that every time we find a new smallest gap the element where we found it will be appended to the list, along with the size of the gap. At the end of processing the final element will contain where the smallest gap was found.

gap state 1 ⟩≡


gap(Gap), [Gap] --> [Gap].
gap(G, Gap), [Gap] --> [G].

Fragment referenced in 4, 7.

find all gaps/locations 2 ⟩≡


min_gap([]) --> [].
min_gap(Integers) --> {[_] = Integers}.
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, var(G), G = D, append([], [G-Y], Gap)},
min_gap([Y|T]).
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, last(G, GCurrent-_), D < GCurrent, append(G, [D-Y], Gap)},
min_gap([Y|T]).
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, last(G, GCurrent-_), D >= GCurrent, Gap = G},
min_gap([Y|T]).

Fragment referenced in 4.

Let’s give this DCG a simple interface. We’ll write a utility predicate that calls the DCG and sets the location of the smallest gap found.

gap location finder 3 ⟩≡


min_gap(Integers, MinGapLocation):-
phrase(min_gap(Integers), [_], [Gaps]),
last(Gaps, _-MinGapLocation), !.

Fragment referenced in 4.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 4


gap state 1
find all gaps/locations 2
gap location finder 3

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- min_gap([2, 8, 10, 11, 15], MinGapLocation). 
 
MinGapLocation = 11 
 
(1 ms) yes 
| ?- min_gap([1, 5, 6, 7, 14], MinGapLocation). 
 
MinGapLocation = 6 
 
yes 
| ?- min_gap([8, 20, 25, 28], MinGapLocation). 
 
MinGapLocation = 28 
 
yes 
| ?-
    

Part 2: Min Diff

You are given an array of integers, @ints. Write a script to find the minimum difference between any two elements.

From Part 1 we know that if we sort the list we know we need to only check adjacent elements to find the minimum difference.

Much of the code is going to be the same. In fact there’s going to be less code since all we need to do is track the gap sizes and not the locations.

find all gaps 5 ⟩≡


min_gap([]) --> [].
min_gap(Integers) --> {[_] = Integers}.
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, var(G), G = D, append([], [G], Gap)},
min_gap([Y|T]).
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, last(G, GCurrent), D < GCurrent, append(G, [D], Gap)},
min_gap([Y|T]).
min_gap(Integers) -->
gap(G, Gap),
{[X,Y|T] = Integers, D is Y - X, last(G, GCurrent), D >= GCurrent, Gap = G},
min_gap([Y|T]).

Fragment referenced in 7.

As before let’s give this DCG a simple interface. We’ll write a utility predicate that calls the DCG and sets the smallest gap found.

gap finder 6 ⟩≡


min_gap(Integers, MinGap):-
msort(Integers, SortedIntegers),
phrase(min_gap(SortedIntegers), [_], [Gaps]),
last(Gaps, MinGap), !.

Fragment referenced in 7.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 7


gap state 1
find all gaps 5
gap finder 6

Sample Run
$ gprolog prolog/ch-2.p 
| ?- min_gap([1, 5, 8, 9], MinGap). 
 
MinGap = 1 
 
yes 
| ?- min_gap([9, 4, 1, 7], MinGap). 
 
MinGap = 2 
 
yes 
| ?-
    

References

The Weekly Challenge 309
Generated Code

posted at: 20:01 by: Adam Russell | path: /prolog | permanent link to this entry

2024-11-30

The Weekly Challenge 296 (Prolog Solutions)

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

Part 1: String Compression

You are given a string of alphabetic characters, $chars. Write a script to compress the string with run-length encoding.

A compressed unit can be either a single character or a count followed by a character.

BONUS: Write a decompression function.

There are probably a few good approaches to this problem. Here we’ll use a DCG approach. Ultimately this problem is at its core is to process a list of characters, something a DCG is best suited to handle.

For convenience, let’s define a clause for checking that we have a valid ascii character code. Maybe this is more my opinion than anything else, but working with character codes versus, say, characters seems to simplify matters for this particular problem.

ascii character code check 1 ⟩≡


code(Code) --> [Code], {integer(Code), Code >= 97, Code =< 122}.

Fragment referenced in 4.

ascii digit code check 2 ⟩≡


digit(Code) --> [Code], {integer(Code), Code >= 48, Code =< 57}.

Fragment never referenced.

We will be passing the state of the partial encoding through the encoding predicates.

encoding state 3 ⟩≡


encoding(Encoding), [Encoding] --> [Encoding].
encoding(E, Encoding), [Encoding] --> [E].

Fragment referenced in 11.

encoding process 4 ⟩≡


encode(Codes) -->
encoding(E, Encoding),
{Codes = [Code | T], Code >= 97, Code =< 122},
{last(E, Count), append(L, [Count], E),
((Count == nil, X = 0, C = Code); Count = C-X),
((Code == C, succ(X, X0), C0 = C,
append(L, [C0 - X0], Encoding));
(Code =\= C, X0 = 1, C0 = Code,
append(E, [C0 - X0], Encoding)))},
encode(T).
encode([]) --> [].
ascii character code check 1

Fragment referenced in 11.

Let’s give this DCG a simple interface. We’ll write some utility predicates.

build the final encoded result 5 ⟩≡


build_encoded([], ’’).
build_encoded([H|T], Encoded):-
H = C - X,
number_atom(X, N),
atom_codes(A, [C]),
build_encoded(T, E),
((X > 1, atom_concat(N, A, NA), atom_concat(NA, E, Encoded));
(X == 1, atom_concat(A, E, Encoded))).

Fragment referenced in 11.

encoder 6 ⟩≡


encoder(String, EncodedString):-
phrase(encode(String), [[nil]], [Encoding]),
build_encoded(Encoding, EncodedString).

Fragment referenced in 11.

Ok, so that’s the main part, but what about decoding for the bonus? We can also do that with a DCG. This proceeds about the same as the encoding process. We have a main DCG and then some utility predicates.

decoding state 7 ⟩≡


decoding(Decoding), [Decoding] --> [Decoding].
decoding(D, Decoding), [Decoding] --> [D].

Fragment referenced in 11.

decoding process 8 ⟩≡


decode(Codes) --> decoding(D, Decoding),
{phrase(letter(L), Codes, R),
append(D, [L], Decoding)},
decode(R).
decode(Codes) --> decoding(D, Decoding),
{phrase(number_letter(NL), Codes, R),
append(D, [NL], Decoding)},
decode(R).
decode([]) --> [].

number_letter(NL) --> number(N), letter(L), {append([N], L, NL)}.

number(N) --> digit(D), number(N0), {append([D], N0, N)}.
number([]) --> [].

letter(L) --> [C], {C >= 97, C =< 122, L = C}.

digit(D) --> [C], {C >= 48, C =< 57, D = C}.

Fragment referenced in 11.

build the final decoded result 9 ⟩≡


build_decoded([], ’’).
build_decoded([H|T], Decoded):-
H = [X|C],
number_codes(N, X),
length(L, N), maplist(=(C), L),
build_decoded(T, D),
atom_codes(A, L),
atom_concat(A, D, Decoded).
build_decoded([H|T], Decoded):-
number(H),
build_decoded(T, D),
atom_codes(A, [H]),
atom_concat(A, D, Decoded).

Fragment referenced in 11.

decoder 10 ⟩≡


decoder(String, DecodedString):-
phrase(decode(String), [[]], [Decoding]),
build_decoded(Decoding, DecodedString), !.

Fragment referenced in 11.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 11


encoding state 3
encoding process 4
build the final encoded result 5
encoder 6
decoding state 7
decoding process 8
build the final decoded result 9
decoder 10

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- encoder("abbc", Encoded). 
 
Encoded = a2bc ? 
 
yes 
| ?- encoder("aaabccc", Encoded). 
 
Encoded = ’3ab3c’ ? 
 
yes 
| ?- encoder("abcc", Encoded). 
 
Encoded = ab2c ? 
 
yes 
| ?- encoder("abbc", Encoded), atom_codes(Encoded, C), decoder(C, DecodedString). 
 
C = [97,50,98,99] 
DecodedString = abbc 
Encoded = a2bc ? 
 
yes 
| ?- encoder("abbbbbbccccccccccc", Encoded), atom_codes(Encoded, C), decoder(C, DecodedString). 
 
C = [97,54,98,49,49,99] 
DecodedString = abbbbbbccccccccccc 
Encoded = a6b11c ? 
 
yes 
| ?-
    

Part 2: Matchstick Square

You are given an array of integers, @ints. Write a script to find if it is possible to make one square using the sticks as in the given array @ints where $ints[$i] is the length of ith stick.

In order to make a square we need four sides that are of the same length. Let’s view this problem as how we can divide the list into four sublists which all sum to the same thing.

Seeing as it is just four sides the code can be a bit rote without looking too horrible.

matchstick square 12 ⟩≡


convenience predicate for list removals 13
matchstick_square(L):-
sublist(S0, L),
S0 \== [],
remove_one(S0, L, L0),
L0 \== [],
sublist(S1, L0),
S1 \== [],
remove_one(S1, L0, L1),
L1 \== [],
sublist(S2, L1),
S2 \== [],
remove_one(S2, L1, L2),
L2 \== [],
sublist(S3, L2),
S3 \== [],
remove_one(S3, L2, L3),
L3 == [],
sum_list(S0, Sum0),
sum_list(S1, Sum1),
sum_list(S2, Sum2),
sum_list(S3, Sum3),
Sum0 == Sum1, Sum1 == Sum2, Sum2 == Sum3, !.

Fragment referenced in 14.

convenience predicate for list removals 13 ⟩≡


remove_one([], S, S).
remove_one([H|T], L, S):-
member(H, L),
select(H, L, L0),
remove_one(T, L0, S).

Fragment referenced in 12.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 14


matchstick square 12

Sample Run
$ gprolog prolog/ch-2.p 
| ?- matchstick_square([1, 2, 2, 2, 1]). 
 
(8 ms) yes 
| ?- matchstick_square([2, 2, 2, 4]). 
 
(2 ms) no 
| ?- matchstick_square([2, 2, 2, 2, 4]). 
 
(187 ms) no 
| ?- matchstick_square([3, 4, 1, 4, 3, 1]). 
 
(1 ms) yes 
| ?-
    

References

The Weekly Challenge 296
Generated Code

posted at: 15:13 by: Adam Russell | path: /prolog | permanent link to this entry

2024-11-24

The Weekly Challenge 295 (Prolog Solutions)

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

Part 1: Word Break

You are given a string, $str, and list of words, @words.

Write a script to return true or false whether the given string can be segmented into a space separated sequence of one or more words from the given list.

This is a good example of doing recursion in Prolog! Everything can be contained within a short recursive predicates.

At each recursive step we select a word form the list and see if it can be removed form the beginning of the final string. If we can whittle the final string down to the empty string then we know we have succeeded.

word break detection 1 ⟩≡


word_break(’’, _).
word_break(S, L):-
member(W, L),
atom_concat(W, R, S),
word_break(R, L).

Fragment referenced in 2.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 2


word break detection 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- word_break(weeklychallenge, [challenge, weekly]). 
 
true ? 
 
yes 
| ?- word_break(perlrakuperl, [raku, perl]). 
 
true ? 
 
yes 
| ?- word_break(sonsanddaughter, [sons, sand, daughters]). 
 
no 
| ?-
    

Part 2: Jump Game

You are given an array of integers, @ints. Write a script to find the minimum number of jumps to reach the last element. $ints[$i] represents the maximum length of a forward jump from the index $i. In case last element is unreachable then return -1.

In some ways this has a very similar approach as part 1. That is, a recursive solution which explores all possible “jumps”.

When using the jump

jump game 3 ⟩≡


jump_game(L, MinimumMoves):-
(findall(Moves, jump_game(L, 1, Moves), AllMoves),
sort(AllMoves, AllMovesSorted),
nth(1, AllMovesSorted, MinimumMoves)); MinimumMoves = -1.
jump_game(L, I, Moves):-
nth(I, L, X),
between(1, X, J),
K is I + J,
jump_game(L, K, M),
succ(M, Moves).
jump_game(L, I, Moves):-
length(L, Length),
nth(I, L, X),
between(1, X, J),
K is I + J,
K == Length,
Moves = 1.

Fragment referenced in 4.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 4


jump game 3

Sample Run
$ gprolog prolog/ch-2.p 
| ?- findall(Moves, jump_game([2, 3, 1, 1, 4], 1, Moves), AllMoves), sort(AllMoves, AllMovesSorted), nth(1, AllMovesSorted, MinimumMoves). 
 
AllMoves = [4,3,2,3] 
AllMovesSorted = [2,3,4] 
MinimumMoves = 2 
 
yes 
| ?- findall(Moves, jump_game([2, 3, 0, 4], 1, Moves), AllMoves), sort(AllMoves, AllMovesSorted), nth(1, AllMovesSorted, MinimumMoves). 
 
AllMoves = [2] 
AllMovesSorted = [2] 
MinimumMoves = 2 
 
yes 
| ?- findall(Moves, jump_game([2, 0, 0, 4], 1, Moves), AllMoves), sort(AllMoves, AllMovesSorted), nth(1, AllMovesSorted, MinimumMoves). 
 
no 
| ?-
    

References

The Weekly Challenge 290
Generated Code

posted at: 20:46 by: Adam Russell | path: /prolog | permanent link to this entry

2024-10-14

The Weekly Challenge 290 (Prolog Solutions)

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

Part 1: Double Exist

You are given an array of integers, @ints. Write a script to find if there exist two indices $i and $j such that:

  1. $i≠$j
  2. 0 $i < size @ints and 0 $j < size @ints
  3. $ints[$i] = 2 $ints[$j]

This is a nice problem for Constraint Logic Programming. The solution is contained in just a single predicate which uses GNU Prolog’s finite domain (FD) constraint solver.

find the values as specified 1 ⟩≡


double_exist(L, I, J):-
length(L, Length),
fd_domain([I, J], 1, Length),
I #\= J,
fd_element(I, L, X),
fd_element(J, L, Y),
X #= 2 * Y,
fd_labeling([I, J]).

Fragment referenced in 2.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 2


find the values as specified 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- double_exist([6, 2, 3, 3], I, J). 
 
I = 1 
J = 3 
 
yes 
| ?- double_exist([3, 1, 4, 13], I, J). 
 
no 
| ?- double_exist([2, 1, 4, 2], I, J). 
 
I = 1 
J = 2 ? 
 
(1 ms) yes 
| ?- double_exist([2, 1, 4, 2], I, J). 
 
I = 1 
J = 2 ? ; 
 
I = 3 
J = 1 
 
yes 
| ?-
    

Part 2: Luhn’s Algorithm

You are given a string $str containing digits (and possibly other characters which can be ignored). The last digit is the payload; consider it separately. Counting from the right, double the value of the first, third, etc. of the remaining digits. For each value now greater than 9, sum its digits. The correct check digit is that which, added to the sum of all values, would bring the total mod 10 to zero. Return true if and only if the payload is equal to the correct check digit.

This is essentially a list processing problem and is quite amenable to a DCG solution. Here I just use some ordinary predicates though.

compute 3 ⟩≡


luhn(L):-
reverse(L, [Check|T]),
luhn(Check, T, DigitSums),
sum_list(DigitSums, S0),
M is (S0 + Check) mod 10, !,
M == 0.

luhn(_, [], []).
luhn(Check, [H0, H1|T], [DigitSum|DigitSums]):-
DS is H0 * 2,
sum_digits(DS, Sum),
DigitSum is Sum + H1,
luhn(Check, T, DigitSums).
luhn(Check, [H|T], [[DigitSum|DigitSums]]):-
DS is H * 2,
sum_digits(DS, Sum),
DigitSum is Sum,
luhn(Check, T, DigitSums).

Fragment referenced in 5.

For convenience we’ll have a predicate for summing the digits of numbers > 10.

sum digits 4 ⟩≡


sum_digits(N, Sum):-
N < 10,
Sum = N.
sum_digits(N, Sum):-
number_chars(N, [C0, C1]),
number_chars(N0, [C0]),
number_chars(N1, [C1]),
Sum is N0 + N1.

Fragment referenced in 5.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 5


sum digits 4
compute 3

Sample Run
$ gprolog prolog/ch-2.p 
| ?- luhn([1, 7, 8, 9, 3, 7, 2, 9, 9, 7, 4]). 
 
yes 
| ?- luhn([4, 1, 3, 7, 8, 9, 4, 7, 1, 1, 7, 5, 5, 9, 0, 4]). 
 
yes 
| ?- luhn([4, 1, 3, 7, 8, 9, 7, 4, 1, 1, 7, 5, 5, 9, 0, 4]). 
 
no 
| ?-
    

References

The Weekly Challenge 290
Generated Code

posted at: 00:32 by: Adam Russell | path: /prolog | permanent link to this entry

2024-10-06

The Weekly Challenge 289 (Prolog Solutions)

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

Part 1: Third Maximum

You are given an array of integers, @ints. Write a script to find the third distinct maximum in the given array. If a third maximum doesn’t exist then return the maximum number.

The majority of the work can be done in a couple of lines. We need only sort the distinct integers in the list and then return either the third largest number or, if none exists, the largest.

sort and return the third largest (or just the largest) 1 ⟩≡


third_maximum(L, ThirdMaximum):-
sort(L, Sorted),
reverse(Sorted, SortedReverse),
(nth(3, SortedReverse, ThirdMaximum), !;
last(Sorted, ThirdMaximum)).

Fragment referenced in 2.

The rest of the code just wraps this predicate into a file.

"ch-1.p" 2


sort and return the third largest (or just the largest) 1

Sample Run
$ gprolog --consult-file prolog/ch-1.p 
| ?- third_maximum([5, 6, 4, 1], X). 
 
X = 4 
 
yes 
| ?- third_maximum([4, 5], X). 
 
X = 5 
 
yes 
| ?- third_maximum([1, 2, 2, 3], X). 
 
X = 1 
 
yes 
| ?-
    

Part 2: Jumbled Letters

Your task is to write a program that takes English text as its input and outputs a jumbled version

The rules for jumbling are given as follows:

  1. The first and last letter of every word must stay the same.
  2. The remaining letters in the word are scrambled in a random order (if that happens to be the original order, that is OK).
  3. Whitespace, punctuation, and capitalization must stay the same.
  4. The order of words does not change, only the letters inside the word.

Looking closer at these rules the main thing we need to concern ourselves with is jumbling the letters with the exception of the first and last. The use of map will ensure the words are processed in order. To make sure the first/last letters are unchanged also depends on detecting punctuation.

Let’s first concern ourselves with identifying punctuation. We need to maintain a record of where they were located so we can put them back in later. We do this by recursively examining each character code to see if it is in the range for punctuation and, if it matches, creating an Index-Punctuation pair.

identify punctuation 3 ⟩≡


punctuation_index(Codes, IndexPunctuation):-
punctuation_index(Codes, 1, IndexPunctuation).
punctuation_index([], _, []).
punctuation_index([Code|Codes], I, [I-P|IndexPunctuation]):-
((Code >= 33, Code =< 46);
(Code >= 58, Code =< 64)),
P = Code,
succ(I, J),
punctuation_index(Codes, J, IndexPunctuation).
punctuation_index([_|Codes], I, IndexPunctuation):-
succ(I, J),
punctuation_index(Codes, J, IndexPunctuation).

Fragment referenced in 7.

With these Index-Punctuation pairs created let’s write some code which will put them back in when we’re done with the jumbling of the other characters.

add punctuation back into the jumbled word 4 ⟩≡


add_punctuation(Word, IndexPunctuation, PunctuatedWord):-
add_punctuation(Word, 1, IndexPunctuation, PunctuatedWord).
add_punctuation([], _, [], []).
add_punctuation([Code|Codes], _, [], [Code | PunctuatedWord]):-
add_punctuation(Codes, _, [], PunctuatedWord).
add_punctuation([], _, [_-P|IndexPunctuation], [P | PunctuatedWord]):-
add_punctuation([], _, IndexPunctuation, PunctuatedWord).
add_punctuation([Code|Codes], I, [I-P|IndexPunctuation], [P, Code | PunctuatedWord]):-
succ(I, J),
add_punctuation(Codes, J, IndexPunctuation, PunctuatedWord).
add_punctuation([Code|Codes], I, [X-P|IndexPunctuation], [Code | PunctuatedWord]):-
succ(I, J),
add_punctuation(Codes, J, [X-P|IndexPunctuation], PunctuatedWord).

Fragment referenced in 7.

The bulk of the work is done in jumble_word/2 which, after the punctuation has been located and removed from further consideration, permutates the remaining letters and then randomly selects a permutation. This is then combined with the first/last letters.

Words that are one or two characters in length are not jumbled.

jumble a single word 5 ⟩≡


jumble_word(Word, Jumble):-
atom_length(Word, Length),
Length > 2,
atom_codes(Word, Codes),
punctuation_index(Codes, IndexPunctuation), !,
subtract(Codes, [33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
45, 46, 58, 59, 60, 61, 62, 63, 64], PunctuationRemoved),
append([First|Middle], [Last], PunctuationRemoved),
findall(Permutation, (permutation(Middle, Permutation)),
Permutations),
length(Permutations, NP),
succ(NP, NumberPermutations),
randomize,
random(1, NumberPermutations, R),
nth(R, Permutations, P),
append([First|P], [Last], J),
add_punctuation(J, IndexPunctuation, JP),
atom_codes(Jumble, JP).
jumble_word(Word, Jumble):-
atom_length(Word, Length),
Length =< 2,
Jumble = Word.

Fragment referenced in 7.

Jumbling words is done by using maplist/3 to call jumble_word/2 on the list of words.

jumble words 6 ⟩≡


jumble_words(Words, Jumble):-
maplist(jumble_word, Words, Jumble).

Fragment referenced in 7.

Finally, let’s assemble our completed code into a single file.

"ch-2.p" 7


identify punctuation 3
add punctuation back into the jumbled word 4
jumble a single word 5
jumble words 6

Sample Run
$ gprolog prolog/ch-2.p 
| ?- jumble_words([in, the, ’ASCII’, range, match, all, ’non-controls.’], Jumbled). 
 
Jumbled = [in,the,’ASCII’,rgnae,mtach,all,’nnc-troolons.’] ? 
 
(161 ms) yes 
| ?-
    

References

The Weekly Challenge 289
Generated Code

posted at: 18:42 by: Adam Russell | path: /prolog | permanent link to this entry

2024-03-09

Representing a graph in Prolog

The standard way that graphs are taught in Prolog is to represent the graph edges in the Prolog database and then, as needed, manipulate the database using assertz/1 and retract/1. There really is nothing wrong with this for many applications. However, when dealing with large graphs the overhead of writing to the database may not be worth the performance gain (via indexing) when querying. Especially in cases when the amount of querying may be low, there may not be any “return on investment”.

An alternative method, promoted by Markus Triska, is the use of attributed variables. In this way a variable represents a graph node and the attributes represent edges. Additionally, beyond that basic representation, additional attributes can be used for other information on the node and to add attributes to the edges such as a weight or other information on the relationship between nodes.

To be clear, attributed variables are primarily intended for use when building libraries, such as for constraint logic programming. There the default Prolog unification algorithm is less convenient than an extended version using attributed variables. In these cases hooks are used to determine, say, domain constraints on variables. Here will not concern ourselves with such advanced topics!

Not all Prologs provide attributed variables. Scryer and SWI are among those that do. All of our code is implemented and tested using SWI-Prolog.

Examples

Let’s start off with the most basic example: a small set of otherwise meaningless nodes connected at random.

PIC

This small graph, adapted from an example in Clocksin’s Clause and Effect, can be represented in Prolog in the traditional way as follows.

Example Graph (Standard) 1 ⟩≡


edge(g, h).
edge(d, a).
edge(g, d).
edge(e, d).
edge(h, f).
edge(e, f).
edge(a, e).
edge(a, b).
edge(b, f).
edge(b, c).
edge(f, c).

Fragment referenced in 14.

As needed additional edges can be added and removed from the Prolog database dynamically using assertz/1 and retract/1.

How might we change this to an attributed variables representation?

First off, we need to keep in mind that only an uninstantiated variable can have an attribute set unless we also provide an attribute hook. Since we otherwise have no need for a hook, we will restrict ourselves to having only uninstantiated variables as nodes. Of course, we need to maintain information for each node and edge. In both cases the node information and the edge information are kept as attributes. At first this sounds more complicated than it really is. Let’s see how it comes together in practice.

To build a bridge from the old to the new we will first create a predicate, edges_attributed/2 which converts a list of edges (e.g. [edge(a, b), edge(b, f), edge(f, c)]) to a list of attributed variables where the edges are attributes on the nodes. The attributes on each node are a list of edges to other node and, also, an attribute containing the node label.

For now we are only concerning ourselves with simple graphs like the example, so nodes are just unique atoms (e.g. a, b, c, ...). We’re also assuming that all edges are directed as given.

Convert list of edges to attributed variables. 2 ⟩≡


edges_attributed(Edges, Attributed):-
Extract the nodes from all edges. 3
Create a unique list of nodes. 4
Make the list of K-V pairs for the nodes. 5
Construct a graph of attributed variables. 6

Fragment referenced in 14.

Extract the nodes from all edges. 3 ⟩≡


maplist(edge_nodes, Edges, Nodes),

Fragment referenced in 2.

Create a unique list of nodes. 4 ⟩≡


flatten(Nodes, NodesFlattened),
sort(NodesFlattened, UniqueNodes),

Fragment referenced in 2.

Make the list of K-V pairs for the nodes. 5 ⟩≡


maplist(node_var_pair, UniqueNodes, _, NodePairs),

Fragment referenced in 2.

Construct a graph of attributed variables. 6 ⟩≡


maplist(graph_attributed(Edges, NodePairs), NodePairs, Attributed).

Fragment referenced in 2.

A lot of work is happening in helper predicates via maplist/3. For the most part these are just one or two lines each.

Helper predicate for extracting nodes from edges. 7 ⟩≡


edge_nodes(edge(U, V), [U, V]).

Fragment referenced in 14.

Create a K-V pair for each node. 8 ⟩≡


node_var_pair(N, V, N-V):-
put_attr(V, node, N).

Fragment referenced in 14.

Generate attribute edge list. 9 ⟩≡


edge_list_attribute(Node, NodePairs, Target, Edge):-
memberchk(Target-T, NodePairs),
Edge = edge(Weight, Node, T),
put_attr(Weight, weight, 1).

Fragment referenced in 14.

The lengthiest of the predicates used in a maplist/3 is graph_attributed/3. This is where the final assembly of the graph of attributed variables takes place.

From the node pairs, create the graph of attributed variables. 10 ⟩≡


graph_attributed(Edges, NodePairs, K-V, K-V):-
findall(Target, member(edge(K, Target), Edges), Targets),
maplist(edge_list_attribute(K-V, NodePairs), Targets, EdgeAttributes),
put_attr(V, edges, EdgeAttributes).

Fragment referenced in 14.

Testing this predicate out, with just a small set of edges, we can get a sense of this new representation. A weight attribute, with default value of 1, has been added to demonstrate the possibility of attributed edge variables, but we won’t make any further use of this here.

?- Edges = [edge(a, b), edge(b, c), edge(b, d)], 
edges_attributed(Edges, Attributed). 
Edges = [edge(a, b), edge(b, c), edge(b, d)], 
Attributed = [a-_A, b-_B, c-_C, d-_D], 
put_attr(_A, node, a), 
put_attr(_A, edges, [edge(_E, a-_A, _B)]), 
put_attr(_B, node, b), 
put_attr(_B, edges, [edge(_F, b-_B, _C), edge(_G, b-_B, _D)]), 
put_attr(_C, node, c), 
put_attr(_C, edges, []), 
put_attr(_D, node, d), 
put_attr(_D, edges, []), 
put_attr(_E, weight, 1), 
put_attr(_F, weight, 1), 
put_attr(_G, weight, 1).

That looks nice, but let’s put it to work with a basic traversal.

To start with, let’s defines a predicate to determine if any two nodes are connected by a directed edge. If one or both of the two node arguments are uninstantiated then member/2 will find one for us, otherwise this will just confirm they are in the Graph, which we will be passed to all predicates that need it. This small amount of extra bookkeeping is part of the trade-off for no longer using the dynamic database.

Also, speaking of extra bookkeeping, we’ll try and maintain a level of encapsulation around the use of attributed variables. For example, in the following predicates we only need worry about the handling of attributes when determining connectedness. When building on this code for more complex purposes that is an important part of the design to keep in mind: encapsulate the low level implementation details and provide predicates which have a convenient higher level of interface.

Determine if two nodes are connected by a directed edge. 11 ⟩≡


connected_directed(Graph, S-U, T-V):-
member(S-U, Graph),
member(T-V, Graph),
S \== T,
get_attr(U, edges, UEdges),
member(edge(_, _, X), UEdges),
get_attr(X, node, XN),
XN == T.

Fragment referenced in 14.

In the spirit of building a big example, the following code does the same connectedness check, but for undirected edges. We’re not worrying too much about such graphs, but this is one way to do it.

Determine if two nodes are connected by an undirected edge. 12 ⟩≡


connected_undirected(Graph, S-U, T-V):-
member(S-U, Graph),
member(T-V, Graph),
S \== T,
get_attr(U, edges, UEdges),
get_attr(V, edges, VEdges),
((member(edge(_, _, X), UEdges),
get_attr(X, node, XN),
XN == T);
(member(edge(_, _, X), VEdges),
get_attr(X, node, XN),
XN == S)).

Fragment referenced in 14.

Finally we can use this connectedness check to define path finding predicates that look a lot like any standard Prolog example of path finding you may have seen before!

Find a path between any two nodes, if such a path exists. 13 ⟩≡


path(Graph, S, T, Path):-
path(Graph, S, T, [S, T], P),
Path = [S|P].

path(Graph, S, T, _, Path):-
connected_directed(Graph, S, T),
Path = [T].

path(Graph, S, T, Visited, Path):-
connected_directed(Graph, S, U),
\+ member(U, Visited),
path(Graph, U, T, [U|Visited], P),
Path = [U|P].

Fragment referenced in 14.

Closing

At this point you should understand how to build a graph using attribute variables in Prolog. The example code here can be further extended as needed. You’ll find that this approach can take on quite a good deal of complexity!

All the code above is structured in a single file as shown. A link to this is in the References section.

"graph.p" 14


Example Graph (Standard) 1
Helper predicate for extracting nodes from edges. 7
Create a K-V pair for each node. 8
Generate attribute edge list. 9
From the node pairs, create the graph of attributed variables. 10
Convert list of edges to attributed variables. 2
Determine if two nodes are connected by a directed edge. 11
Determine if two nodes are connected by an undirected edge. 12
Find a path between any two nodes, if such a path exists. 13

Indices

Files

"graph.p" Defined by 14.

Fragments

Construct a graph of attributed variables. 6 Referenced in 2.

Convert list of edges to attributed variables. 2 Referenced in 14.

Create a K-V pair for each node. 8 Referenced in 14.

Create a unique list of nodes. 4 Referenced in 2.

Determine if two nodes are connected by a directed edge. 11 Referenced in 14.

Determine if two nodes are connected by an undirected edge. 12 Referenced in 14.

Example Graph (Standard) 1 Referenced in 14.

Extract the nodes from all edges. 3 Referenced in 2.

Find a path between any two nodes, if such a path exists. 13 Referenced in 14.

From the node pairs, create the graph of attributed variables. 10 Referenced in 14.

Generate attribute edge list. 9 Referenced in 14.

Helper predicate for extracting nodes from edges. 7 Referenced in 14.

Make the list of K-V pairs for the nodes. 5 Referenced in 2.

References

This method has been promoted by Markus Triska on Stack Overflow, but publicly available examples are rare. Hopefully this page will be useful to any interested persons looking for more information.

Stack Overflow Post #1

Stack Overflow Post #2

Strongly Connected Components An implementation of Tarjan’s strongly connected components algorithm which uses this graph representation.

graph.p

posted at: 00:34 by: Adam Russell | path: /prolog | permanent link to this entry

2023-12-03

The Weekly Challenge 245 (Prolog Solutions)

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

Part 1

You are given two array of languages and its popularity. Write a script to sort the language based on popularity.

Solution


make_pairs(K, V, K-V).

sort_language(Languages, Popularity, SortedLanguages):-
    maplist(make_pairs, Popularity, Languages, PopularityLanguages),
    keysort(PopularityLanguages, SortedPopularityLanguages),
    findall(Language,  member(_-Language, SortedPopularityLanguages), SortedLanguages).

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- sort_language([2, 1, 3], [perl, c, python], SortedLanguages). 

SortedLanguages = [1,2,3]

yes
| ?- 

Notes

A pretty standard Prolog convention is the - separated Pair. So here all we need do is generate the pairs of popularity and language, and then use keysort/2 to get everything in the right order.

Part 2

You are given an array of integers >= 0. Write a script to return the largest number formed by concatenating some of the given integers in any order which is also multiple of 3. Return -1 if none found.

Solution


largest_of_three(Numbers, LargestOfThree):-
    findall(Number,(
        sublist(SubList, Numbers),
        \+ SubList = [],
        permutation(SubList, SubListPermutation),
        number_codes(Number, SubListPermutation),
        0 is Number mod 3), NumbersOfThree),
    ((NumbersOfThree = [], LargestOfThree = -1);
     (max_list(NumbersOfThree, LargestOfThree))). 

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- largest_of_three("819", LargestOfThree).

LargestOfThree = 981

yes
| ?- largest_of_three("86710", LargestOfThree).

LargestOfThree = 8760

(1 ms) yes
| ?- largest_of_three("1", LargestOfThree).    

LargestOfThree = -1 ? 

yes
| ?- 

Notes

This is perhaps the most naive solution to the problem: generate sublists and sort the matching permutations of those sublists.

References

Challenge 245

posted at: 20:39 by: Adam Russell | path: /prolog | permanent link to this entry

2023-11-26

The Weekly Challenge 244 (Prolog Solutions)

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

Part 1

You are given an array of integers. Write a script to calculate the number of integers smaller than the integer at each index.

Solution


smaller([], _, 0).
smaller([H|Integers], X, Y):-
    smaller(Integers, X, Y0),
    ((X > H, succ(Y0, Y));
     (X =< H, Y = Y0)).

count_smaller(Integers, CountSmaller):-
    maplist(smaller(Integers), Integers, CountSmaller).

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- count_smaller([2, 2, 2], CountSmaller). 

CountSmaller = [0,0,0]

yes
| ?- count_smaller([6, 5, 4, 8], CountSmaller).

CountSmaller = [2,1,0,3] ? 

yes
| ?- count_smaller([8, 1, 2, 2, 3], CountSmaller).

CountSmaller = [4,0,1,1,3] ? 

yes
| ?- 

Notes

Probably this is the most obvious way to count up smaller elements as required. In order to cut down on the recursion I call smaller/3 via a maplist/3.

Part 2

You are given an array of integers representing the strength. Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest.

Solution


group_hero(Group, GroupHero):-
    findall(Hero, (
        sublist(SubList, Group),
        max_list(SubList, Maximum),
        min_list(SubList, Minimum),
        Hero #= Maximum**2 * Minimum
    ), Heroes),
    sum_list(Heroes, GroupHero). 

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- group_hero([2, 1, 4], GroupHero).

GroupHero = 141

yes
| ?-

Notes

The core of this problem is to enumerate all the Power Sets of the Group list. In other programming languages enumerating all sublists of a list is straightforward enough, but requires much more code. Here, with Prolog, we need only call sublist/2 with backtracking. We use a findall/3 to generate all the necessary backtracking and create the list of intermediate sums, which are then all summed for the final solution.

References

Challenge 244

posted at: 15:01 by: Adam Russell | path: /prolog | permanent link to this entry

2023-11-19

The Weekly Challenge 243 (Prolog Solutions)

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

Part 1

You are given an array of integers. Write a script to return the number of reverse pairs in the given array.

Solution


reverse_pair(X, Y, Z):-
    (X =\= Y, X > Y + Y, Z = 1, !); Z = 0.
reverse_pairs([], 0).    
reverse_pairs([H|T], ReversePairs):-
    reverse_pairs(T, R),
    maplist(reverse_pair(H), T, RP),
    sum_list(RP, Sum),
    ReversePairs is R + Sum.  

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- reverse_pairs([1, 3, 2, 3, 1], ReversePairs).  

ReversePairs = 2

yes
| ?- reverse_pairs([2, 4, 3, 5, 1], ReversePairs).  

ReversePairs = 3

yes
| ?- 

Notes

reverse_pair/3 implements the reverse pair criteria and is called via a maplist/3 in reverse_pairs/3 which recurses over the list and counts up all Reverse Pairs found.

Part 2

You are given an array of positive integers (>=1). Write a script to return the floor sum.

Solution


floor_sum_pair(X, Y, Z):-
    Z is floor(X / Y).

floor_sum(Integers, FloorSum):-
    floor_sum(Integers, Integers, FloorSum).
floor_sum([], _, 0).    
floor_sum([H|T], L, FloorSum):-
    floor_sum(T, L, F),
    maplist(floor_sum_pair(H), L, FS),
    sum_list(FS, Sum),
    FloorSum is F + Sum.  

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- floor_sum([2, 5, 9], FloorSum).

FloorSum = 10

yes
| ?- floor_sum([7, 7, 7, 7, 7, 7, 7], FloorSum).

FloorSum = 49

(1 ms) yes
| ?- 

Notes

The process here is, co-incidentally, much the same as the first part above. We recurse over the list and use a maplist/3 to build an incremental sum at each step.

References

Challenge 243

posted at: 17:33 by: Adam Russell | path: /prolog | permanent link to this entry

2023-11-11

The Weekly Challenge 242 (Prolog Solutions)

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

Part 1

You are given two arrays of integers. Write a script to find out the missing members in each other arrays.

Solution


missing(L, E, Member):-
    (member(E, L), Member = nil);
    (\+ member(E, L), Member = E).
missing_members([List1, List2], [Missing1, Missing2]):-
    maplist(missing(List2), List1, Missing1Nil),
    delete(Missing1Nil, nil, Missing1),
    maplist(missing(List1), List2, Missing2Nil),
    delete(Missing2Nil, nil, Missing2). 

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- missing_members([[1, 2, 3], [2, 4, 6]] ,Missing).

Missing = [[1,3],[4,6]] ? 

yes
| ?- missing_members([[1, 2, 3, 3], [1, 1, 2, 2]] ,Missing).

Missing = [[3,3],[]] ? 

yes
| ?- missing_members([[1, 2, 3, 3], [1, 1, 2, 2]], Missing), maplist(sort, Missing, MissingNoDuplicates). 

Missing = [[3,3],[]]
MissingNoDuplicates = [[3],[]] ? 

yes
| ?- 

Notes

missing/3 is used in a maplist/3 to determine which elements are missing from an array. If they are not missing a nil is set for it. By deleting the nil elements all that remain are the ones that are missing. This solution doesn't itself remove duplicate missing elements that are identified. That said, as you can see in the example above that can be added, say, using sort/2.

Part 2

You are given n x n binary matrix. Write a script to flip the given matrix as below.

Solution


flip(B, F):-
    F is \ B /\ 1.
flip_matrix([], []).    
flip_matrix([Row|Matrix], [RowFlipped|MatrixFlipped]):-
    reverse(Row, RowReversed),
    maplist(flip, RowReversed, RowFlipped),
    flip_matrix(Matrix, MatrixFlipped).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- flip_matrix([[1, 1, 0], [1, 0, 1], [0, 0, 0]], FlippedMatrix).

FlippedMatrix = [[1,0,0],[0,1,0],[1,1,1]]

yes
| ?- flip_matrix([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]], FlippedMatrix).

FlippedMatrix = [[1,1,0,0],[0,1,1,0],[0,0,0,1],[1,0,1,0]]

yes
| ?- 

Notes

For the given matrix we need only recursively consider each row, reverse it, do the necessary bit flips, and then assemble the newly flipped rows into the completed Flipped Matrix.

References

Challenge 242

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

2023-11-05

The Weekly Challenge 241 (Prolog Solutions)

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

Part 1

You are given an array (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the given rules.

Solution


arithmetic_triplets(Numbers, Difference, TripletCount):-
    length(Triplet, 3),  
    member(I, Triplet),      
    member(J, Triplet),      
    member(K, Triplet),      
    fd_domain(Triplet, Numbers),  
    fd_all_different(Triplet), 
    Difference #= J - I,
    Difference #= K - J,  
    I #< J,
    J #< K,
    findall(Triplet, fd_labeling(Triplet), Triplets),
    length(Triplets, TripletCount).  

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- arithmetic_triplets([0, 1, 4, 6, 7, 10], 3, TripletCount).

TripletCount = 2 ? 

yes
| ?- arithmetic_triplets([4, 5, 6, 7, 8, 9], 2, TripletCount). 

TripletCount = 2 ? 

yes
| ?- 

Notes

The rules for arithmetic triples are a) i < j < k b) nums[j] - nums[i] == diff and c) nums[k] - nums[j] == diff, where diff is a provided parameter. The code above implements these rules directly, letting Prolog do all the work for us!

Part 2

You are given an array of unique positive integers greater than 2. Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

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

kvf_insert_sort(List,Sorted):-
    i_sort(List,[],Sorted).

i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
    kvf_insert(H,Acc,NAcc),
    i_sort(T,NAcc,Sorted).

kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 > V1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 = V1,
    K0 > K1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 = V1,
    K0 < K1.    
kvf_insert(K0-V0, [], [K0-V0]).

write_factor_sorted([K-_|[]]):-
    write(K),
    nl.
write_factor_sorted([K-_|T]):-
    write(K),
    write(', '),
    write_factor_sorted(T).

factor_counter(Number, Number-FactorCount):-
    prime_factors(Number, Factors),
    length(Factors, FactorCount).

factor_sorter(Numbers, FactorsSorted):-
    maplist(factor_counter, Numbers, Factors),
    kvf_insert_sort(Factors, FactorsSorted).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- factor_sorter([11, 8, 27, 4], FactorsSorted), write_factor_sorted(FactorsSorted).
11, 4, 8, 27

FactorsSorted = [11-1,4-2,8-3,27-3] ? 

yes
| ?- 

Notes

This code is build mainly from pieces from previous challenges. The prime factorization code is something I've used several times and the modified Insertion Sort is a minor modification of code from TWC 233.

References

Challenge 241

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

2023-10-29

The Weekly Challenge 240 (Prolog Solutions)

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

Part 1

You are given an array of strings and a check string. Write a script to find out if the check string is the acronym of the words in the given array.

Solution


acronym(Strings, CheckString):-
    maplist(nth(1), Strings, CheckStringUpperCaseCodes),
    maplist(char_code, CheckStringUpperCase, CheckStringUpperCaseCodes),
    maplist(lower_upper, CheckStringLowerCase, CheckStringUpperCase),
    atom_chars(CheckStringA, CheckStringLowerCase),
    atom_codes(CheckStringA, CheckString).

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- acronym(["Perl", "Python", "Pascal"], "ppp"). 

true ? 

yes
| ?- acronym(["Perl", "Raku"], "rp").             

no
| ?- acronym(["Oracle", "Awk", "C"], "oac").

true ? 

yes
| ?- acronym(["Oracle", "Awk", "C"], A), atom_codes(Acronym, A).

A = [111,97,99]
Acronym = oac ? 

yes
| ?- 

Notes

In keeping with the spirit of the original, Perl centric, challenge question I use strings instead of Prolog atoms. The difference is that strings will be represented as lists of character codes, so a little extra code is required.

Chanelling the spirit of Prolog, the solution will backtrack and provide the acronym if that variable is given uninstantiated!

Part 2

You are given an array of integers. Write a script to create an array such that new[i] = old[old[i]] where 0 <= i < new.length.

Solution


build_list(_, [], []).
build_list(Old, [OldH|OldT], [NewH|NewT]):-
    succ(OldH, I),
    nth(I, Old, NewH),
    build_list(Old, OldT, NewT).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- Old = [0, 2, 1, 5, 3, 4], build_list(Old, Old, New).

New = [0,1,2,4,5,3]
Old = [0,2,1,5,3,4] ? 

yes
| ?- Old = [5, 0, 1, 2, 3, 4], build_list(Old, Old, New).

New = [4,5,0,1,2,3]
Old = [5,0,1,2,3,4] ? 

yes
| ?- 

Notes

This is basically the same recursive procedure as used in the Perl solution to the same problem. I did the Perl version first, which was helpful to prototype the recursion.

References

Challenge 240

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

2023-10-23

The Weekly Challenge 239 (Prolog Solutions)

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

Part 1

You are given two arrays of strings. Write a script to find out if the word created by concatenating the array elements is the same.

Solution


concatenate_all([], '').
concatenate_all([H|T], Concatenated):-
    concatenate_all(T, C),
    atom_concat(H, C, Concatenated).

same_string(L0, L1):-
    concatenate_all(L0, C0),
    concatenate_all(L1, C1),
    C0 == C1. 

Sample Run


% gprolog --consult-file prolog/ch-1.p
| ?- same_string([ab, c], [a, bc]).

yes
| ?- same_string([ab, c], [ac, b]). 

no
| ?- same_string([ab, cd, e], [abcde]).

yes
| ?- 

Notes

The problem is given as strings, which I interpret here as meaning atoms, in which case we need to concatenate all the atoms together and then check to see if they are equal.

If, instead, I had strictly used strings (arrays of character codes) then there would be no need to actually concatenate anything. In that case we could just flatten the lists and then check to see if the lists were the same.

Part 2

You are given an array of strings and allowed string having distinct characters. A string is consistent if all characters in the string appear in the string allowed. Write a script to return the number of consistent strings in the given array.

Solution


consistent(Allowed, String, Consistent):-
    subtract(String, Allowed, Subtracted),
    length(Subtracted, SubtractedLength),
    ((SubtractedLength == 0, Consistent = 1);
     (SubtractedLength == 1, Consistent = 0)).

consistent_strings(Strings, Allowed, ConsistentStringsCount):-
    maplist(consistent(Allowed), Strings, ConsistentStrings),
    sum_list(ConsistentStrings, ConsistentStringsCount).

Sample Run


% gprolog --consult-file prolog/ch-2.p 
| ?- consistent_strings(["ad", "bd", "aaab", "baa", "badab"], "ab", ConsistentStrings).

ConsistentStrings = 2 ? 

(1 ms) yes
| ?- consistent_strings(["a", "b", "c", "ab", "ac", "bc", "abc"], "abc", ConsistentStrings).

ConsistentStrings = 7 ? 

yes
| ?- consistent_strings(["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad", ConsistentStrings).

ConsistentStrings = 4 ? 

yes
| ?- 

Notes

Here I count up all the consistent strings by using a maplist/3 to create a list of 0s and 1s. 0 if the string is not consistent, 1 if it is consistent. The check for if a string is consistent is done in a helper predicate which works by removing all the allowed characters and then checking if all characters have been removed, which satisfies the criteria.

References

Challenge 239

posted at: 00:37 by: Adam Russell | path: /prolog | permanent link to this entry

2023-09-07

The Weekly Challenge 233 (Prolog Solutions)

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

Part 1

You are given an array of words made up of alphabets only. Write a script to find the number of pairs of similar words. Two words are similar if they consist of the same characters.

Solution


similar(A, B, Similar):-
    atom_codes(A, ACodes),
    sort(ACodes, ASorted),
    atom_codes(B, BCodes),
    sort(BCodes, BSorted),
    (ASorted = BSorted, Similar = 1);
    Similar = 0.

count_similar_pairs([], 0).
count_similar_pairs([Word|Words], PairsSimilar):-
    count_similar_pairs(Words, P), 
    maplist(similar(Word), Words, Similar), !,
    sum_list(Similar, SimilarCount),
    PairsSimilar is P + SimilarCount.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- count_similar_pairs([aba, aabb, abcd, bac, aabc], PairsSimilar).

PairsSimilar = 2

yes
| ?- count_similar_pairs([aabb, ab, ba], PairsSimilar).              

PairsSimilar = 3

(1 ms) yes
| ?- count_similar_pairs([nba, cba, dba], PairsSimilar).             

PairsSimilar = 0

yes
| ?- 

Notes

Similarity of words is determined by doing a pairwise comparison of the unique character codes. I've gotten into the habit of counting things by using maplist with a predicate that provides a list of 0 and 1 elements. The count is done by summing the list. Here the counting is done in this way by similar/3. count_similar_pairs/2 recursively considers all pairs.

Part 2

You are given an array of integers. Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.

Solution


kvf_insert_sort(List,Sorted):-
    i_sort(List,[],Sorted).

i_sort([],Acc,Acc).
i_sort([H|T],Acc,Sorted):-
    kvf_insert(H,Acc,NAcc),
    i_sort(T,NAcc,Sorted).

kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 > V1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 < V1.
kvf_insert(K0-V0,[K1-V1|T],[K1-V1|NT]):-
    V0 = V1,
    K0 < K1,
    kvf_insert(K0-V0,T,NT).
kvf_insert(K0-V0,[K1-V1|T],[K0-V0,K1-V1|T]):-
    V0 = V1,
    K0 > K1.    
kvf_insert(K0-V0, [], [K0-V0]).

frequency_writer(_-0).
frequency_writer(K-F):-
    write(K),
    write(', '),
    succ(X, F),
    frequency_writer(K-X).

write_frequencies([K-F|[]]):-
    succ(X, F),
    frequency_writer(K-X),
    write(K),
    nl.
write_frequencies([H|T]):-
    frequency_writer(H),
    write_frequencies(T).

frequency_counter(Numbers, Number, Number-Count):-
    length(Numbers, StartCount),
    delete(Numbers, Number, NumberDeleted),
    length(NumberDeleted, EndCount),
    Count is StartCount - EndCount.

frequency_sorter(Numbers, FrequencySorted):-
    sort(Numbers, UniqueNumbers),
    maplist(frequency_counter(Numbers), UniqueNumbers, Frequencies),
    kvf_insert_sort(Frequencies, FrequencySorted).

Sample Run


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

Sorted = [3-1,1-2,2-3] ? 

(1 ms) yes
| ?- frequency_sorter([2, 3, 1, 3, 2], Sorted), write_frequencies(Sorted).
1, 3, 3, 2, 2

Sorted = [1-1,3-2,2-2] ? 

(1 ms) yes
| ?- frequency_sorter([-1, 1, -6, 4, 5, -6, 1, 4, 1], Sorted), write_frequencies(Sorted).
5, -1, 4, 4, -6, -6, 1, 1, 1

Sorted = [5-1,-1-1,4-2,-6-2,1-3] ? 

(1 ms) yes
| ?- 

Notes

First off, we get a count of the frequencies of each number in the list, via a maplist with frequency_counter/3. After that is when we hit the real complexity of the problem. This problem requires a somewhat unique idea of sorting frequencies! The frequencies have been built as key-value pairs but an ordinary sort or key sort won't work here for these unique requirements. All the required unique sort logic is contained in the kvf_insert_sort/2 and related predicates. This is a modification of insertion sort found in Roman Barták's Guide to Prolog Programming.

With the list of frequencies sorted all that is left is to print the result as specified, which is the work of write_frequencies/1. Those somewhat lengthy looking predicates expand the key-value pairs from the sorted result and print them in the new order.

References

Sort Algorithms in Prolog

Challenge 233

posted at: 17:09 by: Adam Russell | path: /prolog | permanent link to this entry

2023-08-21

The Weekly Challenge 231 (Prolog Solutions)

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

Part 1

You are given an array of distinct integers. Write a script to find all elements that is neither minimum nor maximum. Return -1 if you can’t.

Solution


not_min_max(Numbers, NotMinMax):-
    min_list(Numbers, Minimum),
    max_list(Numbers, Maximum),
    delete(Numbers, Minimum, NumbersNoMinimum),
    delete(NumbersNoMinimum, Maximum, NumbersNoMinimumNoMaximum),
    ((length(NumbersNoMinimumNoMaximum, 0), NotMinMax = -1), !;
     (NotMinMax = NumbersNoMinimumNoMaximum)).

Sample Run


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

NotMinMax = -1

yes
| ?- not_min_max([3, 2, 1, 4], NotMinMax). 

NotMinMax = [3,2]

yes
| ?- not_min_max([1, 3, 2], NotMinMax).

NotMinMax = [2]

yes

Notes

This is about as straightforward a solution as you can get in Prolog. All the details can be handled by built in predicates. That is, finding the minimum and maximum values, removing those values from consideration are all done for us. The only complication comes fromt he stipulation that we should return -1 instead of the empty list. This isn't a very Prolog thing to do! These problems are not written with Prolog in mind, however, and we make it work easily enough anyway.

Part 2

You are given a list of passenger details in the form “9999999999A1122”, where 9 denotes the phone number, A the sex, 1 the age and 2 the seat number. Write a script to return the count of all senior citizens (age >= 60).

Solution


passenger_senior(Passenger, Senior):-
    length(AgeSeat, 4),
    length(Age, 2),
    atom_chars(Passenger, PassengerChars),
    suffix(AgeSeat, PassengerChars),
    prefix(Age, AgeSeat),
    number_chars(A, Age),
    ((A >= 60, Senior = 1); Senior = 0).

count_senior_citizens(Passengers, CountSeniorCitizens):-
    maplist(passenger_senior, Passengers, SeniorCitizens), !,
    sum_list(SeniorCitizens, CountSeniorCitizens).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- count_senior_citizens(['7868190130M7522', '5303914400F9211', '9273338290F4010'], Count).

Count = 2

(1 ms) yes
| ?- count_senior_citizens(['1313579440F2036', '2921522980M5644'], Count).   

Count = 0

yes
| ?-

Notes

Since the passenger details are given in strings with fixed width fields we can chop up and find what we need using lists. Since the information we seek (the age) is at the end of the passenger details we can work from the suffix. First we get the details as characters, then we get the final four characters. Of these final four the first two are the age.

This is all done by way of maplist/3. Only those passengers that meet the age criteria are given a value of one, the rest zero. The final count is taken via sum_list/2.

References

Challenge 231

posted at: 20:38 by: Adam Russell | path: /prolog | permanent link to this entry

2023-08-20

The Weekly Challenge 230 (Prolog Solutions)

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

Part 1

You are given an array of positive integers. Write a script to separate the given array into single digits.

Solution


clone(X, [X]).

separate(Number, Digits):-
    number_chars(Number, Chars),
    maplist(clone, Chars, DigitChars),
    maplist(number_chars, Digits, DigitChars).

separate_digits(Numbers, Digits):-
    maplist(separate, Numbers, D),
    flatten(D, Digits).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- separate_digits([1, 34, 5, 6], Digits).

Digits = [1,3,4,5,6] ? 

yes

Notes

For a long time I really never embraced the full power of maplist. At present I can't seem to get enough! In this solution to TWC230.1 we use maplist to first create a singleton list for each digit character in each of the given numbers, we then use maplist to convert these singleton lists to single digit numbers as required.

Part 2

You are given an array of words made up of alphabetic characters and a prefix. Write a script to return the count of words that starts with the given prefix.

Solution


prefix_match(Prefix, Word, Match):-
    atom_chars(Prefix, PrefixChars),
    atom_chars(Word, WordChars),
    ((prefix(PrefixChars, WordChars), Match = 1);
     (\+ prefix(PrefixChars, WordChars), Match = 0)).

count_words(Prefix, Words, Count):-
    maplist(prefix_match(Prefix), Words, Matches),
    sum_list(Matches, Count).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- count_words(at, [pay, attention, practice, attend], Count).

Count = 2 ? 

yes
| ?- count_words(ja, [janet, julia, java, javascript], Count).  

Count = 3 ? 

(1 ms) yes
| ?- 

Notes

Another nice use of maplist, but a bit less gratuitous. In this solution to TWC230.2 we use maplist to generate a list of 0s or 1s, depending on whether a given word starts with the given prefix. The count of matching words is then the sum_list/2 of those results.

References

Challenge 230

posted at: 21:40 by: Adam Russell | path: /prolog | permanent link to this entry

2023-07-23

The Weekly Challenge 226 (Prolog Solutions)

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

Part 1

You are given a string and an array of indices of same length as string. Write a script to return the string after re-arranging the indices in the correct order.

Solution


letter_shuffle(Shuffled, Letter, Index):-
    nth(Index, Shuffled, Letter).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- length(L, 9), maplist(letter_shuffle(L), "lacelengh", [4, 3, 1, 6, 5, 9, 7, 8, 2]), atom_codes(A, L).

A = challenge
L = [99,104,97,108,108,101,110,103,101]

yes

Notes

Many Prologs, including GNU Prolog, treat double quoted strings as lists of the character codes representing each letter. So here maplist/3 is presented such a list as well as the given list of indices. We give a letter_shuffle/3 an empty list of the right length and all that is left is for nth/3 to assign the letters as needed.

Part 2

You are given an array of non-negative integers, @ints. Write a script to return the minimum number of operations to make every element equal zero.

Solution


subtract_minimum(Minimum, X, Y):-
    Y is X - Minimum.

zero_array(Numbers, Operations):-
    delete(Numbers, 0, NumbersNoZero),
    zero_array(NumbersNoZero, 0, Operations).
zero_array([], Operations, Operations).    
zero_array(Numbers, OperationsCounter, Operations):-
    delete(Numbers, 0, NumbersNoZero),
    min_list(NumbersNoZero, Minimum),
    maplist(subtract_minimum(Minimum), NumbersNoZero, NumbersSubtracted),
    succ(OperationsCounter, OperationsCounterNext), 
    delete(NumbersSubtracted, 0, NumbersSubtractedNoZero),
    zero_array(NumbersSubtractedNoZero, OperationsCounterNext, Operations).

Sample Run


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

Operations = 3 ? 

yes
| ?- zero_array([0], Operations).

Operations = 0 ? 

yes
| ?- zero_array([2, 1, 4, 0, 3], Operations).

Operations = 4 ? 

yes
| ?- 

Notes

A convenient issue with this problem is that once a list entry is zero we can ignore it. Since we can ignore it we can delete/3 it and thereby reduce the list eventually to the empty list, the base of our recursion. Each time we recurse we find the minimum element, subtract it from all others, and increment the number of operations.

References

Challenge 226

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

2023-07-13

The Weekly Challenge 225 (Prolog Solutions)

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

Part 1

You are given a list of sentences. Write a script to find out the maximum number of words that appear in a single sentence.

Solution


check_and_read(32, [], _):-
    !.
check_and_read(46, [], _):-
    !. 
check_and_read(-1, [], _):-
    !.
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).

sentence_atoms(Sentence, Atoms):-
    open_input_codes_stream(Sentence, Stream),
    read_data(Stream, Atoms).

max_sentence_length(Sentences, MaxLength):-
    maplist(sentence_atoms, Sentences, SentenceAtoms),
    maplist(length, SentenceAtoms, Lengths),
    max_list(Lengths, MaxLength).

Sample Run


$ gprolog --consult-file prolog/ch-1.p
| ?- max_sentence_length(["Perl and Raku belong to the same family.", "I love Perl.", "The Perl and Raku Conference."], MaxLength).            

MaxLength = 8 ? 

yes
| ?- max_sentence_length(["The Weekly Challenge.", "Python is the most popular guest language.", "Team PWC has over 300 members."], MaxLength).

MaxLength = 7 ? 

yes
| ?- 

Notes

Since these are programming challenges which are designed with Perl in mind the inputs sometimes require a little manipulation to make them more Prolog friendly. In this case the sentence strings need to be turned into lists of atoms. This is done here by use of Stream processing!

I don't think I've had much occasion to use open_input_codes_stream/2 before. What this does is take the double quoted string, which is seen by Prolog as a list of character codes, and open this as a Stream. We can then process this in the same way as we'd process any other input stream, more typically a file. In fact, much of the code for processing this Stream is re-used from other such code.

The solution, then, is that max_sentence_length/2 will take a list of sentences, call senetence_atoms/2 via a maplist/3 to get a list of list of atoms, then again with a maplist/3 get the lengths of the atom lists, and then finally get the maximum sentence length (the result) from max_list/2.

Part 2

You are given an array of integers. Write a script to return left right sum difference array.

Solution


difference(X, Y, Z):-
    Z is abs(X - Y).

differences(_, 0, LeftAccum, RightAccum, LeftRightDifferences):-
    maplist(difference, LeftAccum, RightAccum, LeftRightDifferences).
differences(Numbers, Index, LeftAccum, RightAccum, LeftRightDifferences):-
    length(Numbers, L),
    Left is Index - 1,
    Right is L - Index,
    length(Prefix, Left),
    length(Suffix, Right),
    prefix(Prefix, Numbers),
    suffix(Suffix, Numbers),
    sum_list(Prefix, LeftSum),
    sum_list(Suffix, RightSum),
    succ(IndexNext, Index),
    differences(Numbers, IndexNext, [LeftSum|LeftAccum], [RightSum|RightAccum], LeftRightDifferences).

left_right_differences(Numbers, LeftRightDifferences):-
    length(Numbers, L),
    differences(Numbers, L, [], [], LeftRightDifferences).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- left_right_differences([10, 4, 8, 3], LeftRightDifferences).

LeftRightDifferences = [15,1,11,22] ? 

yes
| ?- left_right_differences([1], LeftRightDifferences). 

LeftRightDifferences = [0] ? 

yes
| ?- left_right_differences([1, 2, 3, 4, 5], LeftRightDifferences).

LeftRightDifferences = [14,11,6,1,10] ? 

(1 ms) yes
| ?- 

Notes

The problem statement may be a little confusing at first. What we are trying to do here is to get two lists the prefix sums and suffix sums, also called the left and right sums. We then pairwise take the absolute values of each element in these lists to get the final result. Recursively iterating over the list the prefix sums are the partial sums of the list elements to the left of the current element. The suffix sums are the partial sums of the list elements to the right of the current element.

Once the problem is understood the components of the solution start to come together:

  1. Iterate over the original list and build up the partial sums. prefix/2, suffix/2, and sum_list/2 are very helpful here!
  2. When we are done building the lists of partial sums take the pairwise differences. This could also be done iteratively, but more elegantly we can make use of maplist/4.
  3. Our use of maplist/4 uses the small utility predicate difference/3.

References

Challenge 225

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

2023-01-29

The Weekly Challenge 201 (Prolog Solutions)

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

posted at: 18:39 by: Adam Russell | path: /prolog | permanent link to this entry

2023-01-15

The Weekly Challenge 199 (Prolog Solutions)

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

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

2023-01-08

The Weekly Challenge 198 (Prolog Solutions)

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

posted at: 13:29 by: Adam Russell | path: /prolog | permanent link to this entry

2022-12-18

The Weekly Challenge 195 (Prolog Solutions)

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

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