# Counterfeit coin problem in Prolog

with nothing to do. Don’t worry. Why not try this
one in Prolog:

“A man has 10 nickels among which there is a single
counterfeit coin, which is either heavier or lighter
than the other ones. How can one tell in weightings
whether there is a counterfeit nickel, and if so
which one it is?”

Any Prolog solutions? What about CLP(FD) or
CLP(B) solutions?

P.S.: Some say its related to this:

David A. Huffmans Epiphany
http://www.huffmancoding.com/my-uncle/scientific-american

Its the same as problem #1 from Nigel Coldwell’s collection of quant riddles. I solved all the red ones – attempting to use Prolog at each turn (it was some time ago, I was worse at Prolog then). Problem 14 is the hardest apparently. Here it is solved in Prolog.

Here is my Q1 solution (same as your challenge). It works but it isn’t elegant.

``````:- set_prolog_flag(stack_limit, 13_147_483_648).

score(L,0,N,0,0) :- N>=L-1,!.
score(_,0,_,_,-1) :- !.
score(L,Try,N,0,Try) :- N>=L-1,!.
score(L,Try,N,U,Score) :-
N+1>=L-1,
U<2,
Score is Try-1,!.
score(_,_,_,_,-1).
score(Ms,Try,Score) :-
length(Ms,L),
aggregate_all(count,(member(M,Ms),M=n),N),
aggregate_all(count,(member(M,Ms),M=u),U),
score(L,Try,N,U,Score),!.

% Use with predsort to remove symmetrical configs.
part_order(=,[Re1,Le1,_],[Re2,Le2,Ri2]) :-
Re1=Re2,(Le1=Le2;Le1=Ri2),!.
part_order(<,_,_).

% Calculate all possible admissible partitions.
partitions([],Rest,Left,Right,[Rest,Left,Right]) :-
Left\=[],Right\=[],
\+ (change_to(Left,n,Left),change_to(Right,n,Right)),
length(Left,N),
length(Right,N).
partitions([H|Tail],Rest,Left,Right,Partition) :-
partitions(Tail,[H|Rest],Left,Right,Partition);
partitions(Tail,Rest,[H|Left],Right,Partition);
partitions(Tail,Rest,Left,[H|Right],Partition).
partitions(Ms,Rest,Left,Right) :-
msort(Ms,Sorted),
partitions(Sorted,[],[],[],[Rest,Left,Right]).

% Change the marbles in a list to a value.
change_to_([],_,Ms,Ms) :- !.
change_to_([H|Rest],V0,Acc,Ms) :-
(V0=l,H=h->V=n;
(V0=h,H=l->V=n;
(V0\=n,H=n->V=n;
V=V0))),!,
change_to_(Rest,V0,[V|Acc],Ms).
change_to(Ms0,u,Ms0) :- !.
change_to(Ms0,V,Ms) :-
change_to_(Ms0,V,[],Ms).

% Change information about marbles after weighting.
outcome(Rest0,Left0,Right0,Re,Le,Ri,Marbles) :-
change_to(Rest0,Re,Rest),
change_to(Left0,Le,Left),
change_to(Right0,Ri,Right),
append(Left,Right,Marbles0),
append(Rest,Marbles0,Marbles).

:-table step/8.

% A minimax game against nature.
step(0,Ms,_,_,0,Score,Moves,Moves) :-           % Stop. No more tries.
score(Ms,0,Score),!.
step(Try,Ms,_,_,0,Score,Moves,Moves) :-         % Stop. Victory!
length(Ms,L),
aggregate_all(count,(member(M,Ms),M=n),N),
aggregate_all(count,(member(M,Ms),M=u),U),
U<2,
N+1>=L-1,
score(Ms,Try,Score),!.
step(Try0,Ms0,[],[],0,Score,Acc0,Moves) :-      % Player chooses split.
Try is Try0-1,
setof([Re,Le,Ri],partitions(Ms0,Re,Le,Ri),Poss0),
predsort(part_order,Poss0,Poss),
findall(S-[Re,Le,Ri],
(member([Re,Le,Ri],Poss),
step(Try,Re,Le,Ri,1,S,[],Moves)),Vs),
max_member(_-[Rest,Left,Right],Vs),
Acc=[[Rest,Left,Right]|Acc0],!,
step(Try,Rest,Left,Right,1,Score,Acc,Moves).
step(Try,Rest,Left,Right,1,Score,Acc,Moves) :-  % Nature chooses outcome.
outcome(Rest,Left,Right,u,n,n,Bal),
outcome(Rest,Left,Right,n,h,l,LTip),
outcome(Rest,Left,Right,n,l,h,RTip),
(change_to(Rest,n,Rest)->Poss=[LTip,RTip];Poss=[Bal,LTip,RTip]),
findall(S-P,(member(P,Poss),step(Try,P,[],[],0,S,[],Moves)),Ps),
min_member(_-Choice,Ps),!,
step(Try,Choice,[],[],0,Score,Acc,Moves).

% Outcome of worse case scenario.
check() :-
step(3,[u,u,u,u,u,u,u,u,u,u,u,u],[],[],0,Score,[],Moves),
write("SCORE: "),writeln(Score),
print_moves(Moves).

print_moves([]).
print_moves([H|Rest]) :-
writeln(H),
print_moves(Rest).
``````

I should add, what I was trying to do at this point in my Prolog journey is NOT solve the problem and then implement it in Prolog, but state the problem in Prolog and have it solve it without an implementation in mind. Problem 01 has a simple analytical solution, which can easily be implemented in any language, but here it is framed as a minimax game against nature: a problem unspecific approach.

Thanks for sharing your solution. The problem seems to have
maximum difficulty on the scale of the quant collection. Since there
is now a solution, we have to turn it into a code golfing turnament.

Is this the final word as a short solution?

P.S.: Now they give again the impression that Wallstreet traders
are all math geniuses, but then the granny from my village told me
about the Halloween indicator, which has even some empirical support.

P.P.S: You wrote “minimax game against nature”, interesting. From
browsing the internet I found some Huffman Coding approach, which
even used Entropy, and then another paper mentioning Max Flow.

They are not really “quant” puzzles, just puzzles involving bits of maths and computer science. Objectively, they are not particularly hard.

This, on the other hand, I found hard. Don’t cheat. Can you do it? This is the “easy” puzzle from the GCHQ Christmas challenge…

The puzzle is not a proper programming
friendly puzzle, more a puzzle for a ChatGPT with
some regional word knowledge, given the solution:

The puzzle is hard because the shape of the answer is not obvious and it encourages cognitive bias.

SCARBOROUGH is a give away: it should make you think “places!”. If you then test everything else for that type you’ll find PUDSEY and BEVERLEY.

At that point, due to confirmation bias, I assume that most people will box their search to just types and start thinking about what other types of thing could relate what remains. The ability to not yield to confirmation bias is presumably a quality GCHQ look for.

PITCH / JASMINE / STICKY are a give away for prefix relationships. You only have to discover one of them before the rest become evident.

Any change you can conceal the answer?
It would be nice for people to consider it without the reveal.

Now I got a solution with 3-way Huffman code, but I needed
a trick, I had to make a decision to first separate the pennies
into two groups, so that the strategy can start. This query:

``````?- huffman([0.1-0,0.1-1,0.1-2,0.1-3,0.1-4], R),
huffman([0.1-5,0.1-6,0.1-7,0.1-8,0.1-9], S),
strategy(node(R,S), 0, -1).
``````

Gives me this decision tree in a blink. It doesn’t solve the full
puzzle yet, it assumes a single heavier coin. It cannot yet
deal with a possibly heavier or lighter coin:

``````compare coins [3,4,0,1,2] with [8,9,5,6,7]
if left is heavier than right:
compare coins [3,8,9] with [0,1,2]
if left is heavier than right:
the heavier coin is 3
if left and right have same weight:
the heavier coin is 4
if left is lighter than right:
compare coins [0] with [2]
if left is heavier than right:
the heavier coin is 0
if left and right have same weight:
the heavier coin is 1
if left is lighter than right:
the heavier coin is 2
if left is lighter than right:
compare coins [8,3,4] with [5,6,7]
if left is heavier than right:
the heavier coin is 8
if left and right have same weight:
the heavier coin is 9
if left is lighter than right:
compare coins [5] with [7]
if left is heavier than right:
the heavier coin is 5
if left and right have same weight:
the heavier coin is 6
if left is lighter than right:
the heavier coin is 7
``````

The number of compares is now maximally 3 and they are 3-way compares,
except for the first one which is a 2-way compare. Not yet sure how could deal
with both possibly heavier and possibly lighter coins.

The source code so far is here:

``````% huffman(+Map, -Tree)
huffman(M, T) :- keysort(M, N), huffman2(N, T).

huffman2([K1-V1,K2-V2,K3-V3|L], T) :- !, K is K1+K2+K3, huffman([K-node(V1,V2,V3)|L], T).
huffman2([K1-V1,K2-V2|L], T) :- !, K is K1+K2, huffman([K-node(V1,V2)|L], T).
huffman2([_-T], T).

% strategy(+Tree, +Integer, +Tree)
strategy(node(A,B), O, _) :- !,
collect(A, P, []),
collect(B, Q, []),
H is O+4,
tab(O), write('compare coins '), write(P), write(' with '), write(Q), nl,
tab(O), write('if left is heavier than right:'), nl,
strategy(A, H, B),
tab(O), write('if left is lighter than right:'), nl,
strategy(B, H, A).
strategy(node(A,B,C), O, D) :- !,
collect(A, P, []),
collect(C, Q, []),
collect(D, R, []),
align(P, Q, R, X, Y),
H is O+4,
tab(O), write('compare coins '), write(X), write(' with '), write(Y), nl,
tab(O), write('if left is heavier than right:'), nl,
strategy(A, H, C),
tab(O), write('if left and right have same weight:'), nl,
strategy(B, H, A),
tab(O), write('if left is lighter than right:'), nl,
strategy(C, H, A).
strategy(I, O, _) :-
tab(O), write('the heavier coin is '), write(I), nl.

% align(+List, +List, +List, -List, -List)
align([], [], _, [], []).
align([], [X|L], [Y|R], [Y|S], [X|T]) :-
align([], L, R, S, T).
align([X|L], [], [Y|R], [X|S], [Y|T]) :-
align(L, [], R, S, T).
align([X|L], [Y|R], H, [X|S], [Y|T]) :-
align(L, R, H, S, T).

% collect(+Tree, +List, -List)
collect(node(A,B,C)) --> !, collect(A), collect(B), collect(C).
collect(I) --> [I].
``````

There’s insight for this tricky puzzle at strategy - Twelve balls and a scale - Puzzling Stack Exchange

Hello,
@j4n_bur53 Please give me back 2 weeks of my life during which I have been obssessed with this puzzle !

After manually solving this problem for 12 marbles with dependent weighting, I have read the independent weighting solution using number theory.
From there, I have implemented of full on clpfd solutions of this problem that normally generalize to any number of marbles or coins.

The code is too long to be copy pasted here but I have made a swish notebook here: Marbles.swinb with a little bit of explanations.
See the last cells for how to write a query for solving `N` marbles with `Digit` weightings.

1 Like

Here’s a solution for 10 coins, using clpb:

``````main :-
between(1, 10, CF),
between(0, 1, HeavyInput),
once(main(CF, HeavyInput)),
fail.

main(CF, HeavyInput) :-
CoinCount = 10,
numlist(1, CoinCount, Is),
maplist(coin_i, Coins, Is),
maplist(coin_b, Coins, Bs),
sat(card([1], Bs)),
% Whether the 1 counterfeit coin is heavy or light, does not need to be determined
test_loop(Coins, input(CF, HeavyInput), Heavy, Steps),
length(Steps, StepsLen),
once(nth1(CFCalc, Bs, 1)),
format('Coin ~d with heavy ~d inputted - determined coin ~d with heavy ~k in ~d weighings\n', [CF, HeavyInput, CFCalc, Heavy, StepsLen]).

% Ends with the heavy side, then the light side
heavy_weigh(0, Side, Other, Side, Other).
heavy_weigh(1, Side, Other, Other, Side).

coin_i(c(I, _), I).
coin_b(c(_I, B), B).

certain_coin(c(_I, B)) :-
taut(B, _).

test_loop(Coins, Input, Heavy, Steps) :-
partition(certain_coin, Coins, Knowns, Us),
test_loop_(Us, Knowns, Coins, Input, Heavy, Steps).

% Don't care whether it's heavy or light
test_loop_([], _Knowns, _Coins, _Input, _Heavy, []).
test_loop_(Us, Knowns, Coins, Input, Heavy, Steps) :-
Us = [_|_],
% Choose some coins to weigh
once(prepare_weigh(Us, Knowns, Left, Right, UsExcl)),
maplist(coin_b, Left, LeftBs),
maplist(coin_b, Right, RightBs),
maplist(coin_b, UsExcl, UsExclBs),
weigh_coins(Input, side(Left, LeftBs), side(Right, RightBs), UsExclBs, Heavy),
Steps = [step(Left,Right)|Steps0],
test_loop(Coins, Input, Heavy, Steps0).

prepare_weigh([], _, [], [], []).
prepare_weigh([U1], [], [], [], [U1]).
prepare_weigh([U1], [K|_], [K], [U1], []).
% Need to vary the ordering, for maximum logical inferences, as explained at:
% http://www.murderousmaths.co.uk/books/12coinans.htm
% This particular varying is good enough for 10 coins, but can take 4 steps with 12 coins
prepare_weigh([U1,U2,U3], _Knowns, [U3], [U2], [U1]).
prepare_weigh([U1,U2], [], [U1], [U2], []).
prepare_weigh([U1,U2], [K|_], [U2], [K], [U1]).
prepare_weigh([U1,U2,U3|Us], Knowns, [U1|Left0], [U2|Right0], [U3|Excl0]) :-
prepare_weigh(Us, Knowns, Left0, Right0, Excl0).

weigh_coins(input(CF, HeavyInput), Left, Right, UsExcl, Heavy) :-
permutation([Left, Right], [Side1, Side2]),
Side1 = side(Coins, _),
memberchk(c(CF, _), Coins),
!,
% The excluded coins are all good
sat(card([0], UsExcl)),
% Map to the heavy side vs light side
heavy_weigh(HeavyInput, Side1, Side2, side(_, HeavyBs), side(_, LightBs)),
% clpb logic - 1 card is heavy xor 1 card is light
sat((card([1], HeavyBs) * Heavy) # (card([1], LightBs) * ~Heavy)).
weigh_coins(_Input, side(_, LeftBs), side(_, RightBs), _UsExcl, _Heavy) :-
% The weighed coins are all good
append(LeftBs, RightBs, Bs),
sat(card([0], Bs)).
``````

Results:

``````?- main.
Coin 1 with heavy 0 inputted - determined coin 1 with heavy 1 in 3 weighings
Coin 1 with heavy 1 inputted - determined coin 1 with heavy 0 in 3 weighings
Coin 2 with heavy 0 inputted - determined coin 2 with heavy 1 in 3 weighings
Coin 2 with heavy 1 inputted - determined coin 2 with heavy 0 in 3 weighings
Coin 3 with heavy 0 inputted - determined coin 3 with heavy 1 in 3 weighings
Coin 3 with heavy 1 inputted - determined coin 3 with heavy 0 in 3 weighings
Coin 4 with heavy 0 inputted - determined coin 4 with heavy 1 in 3 weighings
Coin 4 with heavy 1 inputted - determined coin 4 with heavy 0 in 3 weighings
Coin 5 with heavy 0 inputted - determined coin 5 with heavy 1 in 3 weighings
Coin 5 with heavy 1 inputted - determined coin 5 with heavy 0 in 3 weighings
Coin 6 with heavy 0 inputted - determined coin 6 with heavy 1 in 3 weighings
Coin 6 with heavy 1 inputted - determined coin 6 with heavy 0 in 3 weighings
Coin 7 with heavy 0 inputted - determined coin 7 with heavy 1 in 3 weighings
Coin 7 with heavy 1 inputted - determined coin 7 with heavy 0 in 3 weighings
Coin 8 with heavy 0 inputted - determined coin 8 with heavy 1 in 3 weighings
Coin 8 with heavy 1 inputted - determined coin 8 with heavy 0 in 3 weighings
Coin 9 with heavy 0 inputted - determined coin 9 with heavy _ in 2 weighings
Coin 9 with heavy 1 inputted - determined coin 9 with heavy _ in 2 weighings
Coin 10 with heavy 0 inputted - determined coin 10 with heavy 1 in 3 weighings
Coin 10 with heavy 1 inputted - determined coin 10 with heavy 0 in 3 weighings
false.
``````

Coin 9 gets determined quickly because it is the only coin excluded from the first 2 weighings, so it is inferred to be the counterfeit, but its heavy vs light weight is unknown because it has not been weighed at all.

I’m using a bit of a hack in `prepare_weigh` to vary the weighing sides. Perhaps sat_count/2 could be used to determine the optimum 2 sides to weigh.

1 Like