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.
