We were sitting in a punt during May Week when I was challenged to put some prolog cgis on my website. I had written the guess the change code fairly recently, and had been contemplating solution strategies. A prolog program implementing a solution strategy seemed like the obvious choice. For completeness, I also wrote the game code in prolog, and the introductory page. The prolog version of the game is not provided, although the source is, mainly because it seems both superfluous to the original version and inferior---it uses a rather naive method of saving the generated change which would not have stood up to, for example, two or more people trying to play the game at the same time.
:- use_module(library(cgi)).
value(Name,Value, [AO|_]):-AO=..[Name,Value],!.
value(Name,Value, [_|T]):-value(Name,Value,T).
value(_,'',[]).
change(C):-cgi_get_form(Arguments),value('change', C, Arguments).
main:-
tell(user),
write('Content-type:text/html\n\n'),
write('<?xml version="1.0" encoding="UTF-8"?><!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'),
write(' "DTD/xhtml1-strict.dtd">'),
format('<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">',[]),
write('<head><title>Guess the change solution strategy (prolog)</title>'),
write('<link rel="stylesheet" type="text/css" href = "../styles/change.css"></link></head><body>'),
change(C),
format('<div class="intro">Solving for ~w</div>',[C]),
format('<div class="guesses">'),
atom_chars(C,Atl),
int_list(Atl, Cl),
solve(Cl),
bookkeep,
format('</div><div>Hit reload to see a new solution.</div>'),
write('<div class="footer"><hr /><a href="./">Guess the change solution strategy (prolog)</a>
<a href="src.cgi">Prolog source code</a>
<a href="../change">Play guess the change</a>
<a href="../">Home</a></div></body></html>').
check(C):-valid(C).
check(C):-not(valid(C)),
format('Sorry, ~w is not a valid change~n</div>',[C]),
write('<p class="back"><a class="nav" href="./">Try again</a></p>'),
write('<div class="footer"><hr /><a href="./">Guess the change solution strategy (prolog) </a>
<a href="src.cgi">Prolog source code</a>
<a href="../change">Play guess the change</a>
<a href="../">Home</a></div></body></html>'),
fail.
valid(C):-
length(C,N),
change(X,N),
fuzzy_match(X,C).
fuzzy_match([],[]).
fuzzy_match([H|T],L):-fuzz_remove(H,L,N), fuzzy_match(T,N).
fuzz_remove(H,[X|Y],Y):-dwim_match(H,X),!.
fuzz_remove(H,[X|Y],[X|L]):-fuzz_remove(H,Y, L).
solve(C):-
start,
check(C),
asserta(query(1,2)),
asserta(start_list([])),
cleanup,
start,
length(C,N),
change(L,N),
asserta(start_list(L)),
guess(L,C),
select_change(X),
guess(X,C), equal(X,C).
cleanup:-query(Y,X),retract(query(Y,X)),cleanup.
cleanup:-start_list(X),retract(start_list(X)),cleanup.
cleanup:-seed(X), retract(seed(X)), cleanup.
cleanup.
bookkeep:-account(0,_).
account(Start,Final):-
query(Y,X),
retract(query(Y,X)),
S is Start+1,
account(S,Final).
account(Start,Start):-format('<span class="yay">total guesses ~d</span>', Start),
append('prolsolve.dat'),
change(C),
write('-----\n'),
get_time(X),
convert_time(X,S),
write(S),
write(C),
write(:),
write(Start),
write(\n),
told.
guess(X,C):-
format('trying ~w', [X]),
count(X,C,N),
asserta(query(X,N)),
format(': ~d<br />~n', N).
inconsistent(Guess):-
query(PrevG, N),
match_up(Guess, PrevG, Comm),
not(N is Comm).
match_up([],[],0):-!.
match_up([H|T1],[H|T2],M):-!,match_up(T1,T2,N), M is N+1.
match_up([X|T1],[Y|T2],N):-not(equal(X,Y)),match_up(T1,T2,N).
select_change(X):-
start_list(L),
permutation(L,X),
not(query(X,_)),
not(inconsistent(X)).
count([],[],0).
count([H|T], [H|R], M):-!,count(T,R,N), M is N+1.
count([X|T], [Y|R], M):-not(equal(X,Y)),count(T,R,M).
permutation([],[]):-!.
permutation(L, [H|T]):-
append(V,[H|U],L), append(V,U,W), permutation(W,T).
build([M|[]],M,M).
build([N|T],N,M):-K is N+1, build(T,K,M).
build_list(L,N):-build(L,1,N).
equal(X,X).
/*generate a random change*/
ranlist([],0,_):-!.
ranlist([H|T],N,C):-M is N-1,ranlist(T,M,C), genrand(H,T,C).
change(C,X):-ranlist(C,X,X).
genrand(X,List,Top):-random(Top,X), not(member(X,List)),!.
genrand(X,List,Top):-genrand(X,List,Top).
sum([],0).
sum([H|T], R):-sum(T,R1), R is (10*R1+H) mod 4091.
start:-get_time(X),convert_time(X,S), string_to_list(S,L), sum(L,N), Z is N, asserta(seed(Z)).
random(R,N):-seed(S),N is (S mod R) +1, NewSeed is (125*S +13) mod 4091,asserta(seed(NewSeed)),!.
int_list([],[]).
int_list(['0'|T],[10|Y]):-!,int_list(T,Y).
int_list(['E'|T],[11|Y]):-!,int_list(T,Y).
int_list(['T'|T],[12|Y]):-!,int_list(T,Y).
int_list(['e'|T],[11|Y]):-!,int_list(T,Y).
int_list(['t'|T],[12|Y]):-!,int_list(T,Y).
int_list([H|T], [X|Y]):-term_to_atom(X,H), int_list(T,Y).
Back to top
/*to do if site has many visitors - replace tempchange with temporary file*/
:- use_module(library(cgi)).
/*gets the value for a particular named input (or vv)*/
value(Name,Value, [AO|_]):-AO=..[Name,Value],!.
value(Name,Value, [_|T]):-value(Name,Value,T).
value(_,'',[]).
main :-
asserta(seed(13)),
cleanup,
start,
cgi_get_form(Arguments),
asserta(args(Arguments)),
write('Content-type:text/html\n\n'),
write('<?xml version="1.0" encoding="UTF-8"?><!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'),
write(' "DTD/xhtml1-strict.dtd">'),
format('<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">',[]),
write('<head><title>Guess the change-Prolog version</title>'),
write('<link rel="stylesheet" type="text/css" href = "http://muse.19inch.net/~mair/srcf/styles/change.css"></link></hea\
d><body>'),
play_loop(Arguments),
format('<div class="footer"><hr /><a href="http://muse.19inch.net/~mair/srcf/cgi-bin/change/prolog">Back to prolog intro</a><a href="http://muse.19inch.net/~mair/srcf/cgi-bin/change">Guess the change (non-prolog version)</a><a href="http://muse.19inch.net/~mair/srcf/cgi-bin">Home</a></div></body>~n</html>~n', []).
guess(X,Arguments):-value('guess', X, Arguments).
cleanup:-seed(X), retract(seed(X)), cleanup.
cleanup.
play_loop(Arguments):-
value('number',Num,Arguments),
format('<h2>Playing on ~d bells</h2>', Num),
value('started', 'yes', Arguments),
value('guess', Guess, Arguments),
value('previous',Prev,Arguments),
value('goes',Goes,Arguments),
atom_chars(Guess,Guessl),
invalid(Guessl),
Goesn is Goes-1,
input_form(Num, Prev, "", "", Goesn),
fail.
play_loop(Arguments):-
value('number',Num,Arguments),
value('started', 'yes', Arguments),
value('guess', Guess, Arguments),
value('previous',Prev,Arguments),
value('goes',Goes,Arguments),
format('<div class="guesses">~w',[Prev]),
atom_chars(Guess,Guessl),
correct(Guessl,Num),!,
format('<p><span class="yay">', []),
write(Guess),
write(:),
format('~d</b></span></p></div>',[Num]),
format('<p><span class="yay">Congratulations! ~d goes</span><a class="nav" href="prologintro.cgi">Play again</a></p>',[Goes]),
append('/home/mair/records/prolplay.dat'),
format('~n',[]),
write(Guess),
write(:),
write(Num),
format('~n',[]),
told.
play_loop(Arguments):-
value('started', 'yes', Arguments),!,
value('number',Num,Arguments),
value('guess', Guess, Arguments),
value('previous',Prev,Arguments),
value('goes',Goes,Arguments),
atom_chars(Guess,Guessl),
correct(Guessl,N),
format('<p><b>', []),
write(Guess),
write(:),
format('~d</b></p></div>',[N]),
input_form(Num,Prev,Guess,N,Goes).
play_loop(Arguments):-value('started','no',Arguments), value('number', X, Arguments),go(X), input_form(X, '','','',0).
play_loop(Arguments):-value('started', X, Arguments),format('initialisation failed, started had value ~w', [X]).
input_form(Num,Prev,Guess,Corr,Goes):-
format('<form action="prologplay.cgi" method="post">',[]),
see('tempchange.txt'),
read(X),
seen,
length(X,L),
args(Arguments), value("working",Working,Arguments),
format('<div>Working:<textarea rows="8" cols="15" name="working">~w</textarea><br /><br /></div>',[Working]),
format('<div>Enter a guess:<input type="text" name="guess" maxlength="~d" />',[L]),
format('<input type="hidden" value="yes" name="started" />',[]),
format('<input type="hidden" value="~w" name="number" />',[Num]),
format('<input type="hidden" value="~w<br />~w:~w" name="previous" />',[Prev,Guess,Corr]),
NewGoes is Goes+1,
format('<input type="hidden" value="~d" name="goes" />', [NewGoes]),
format('<input type="submit" value="guess" /></div></form>',[]).
go(X):-
change(C,X),
tell('tempchange.txt'),
write(C),
write('.'),
told,
tell(user).
correct(C, N):-
valid(C),
see('tempchange.txt'),
read(X),
seen,
count(C,X,N).
invalid(C):-
not(valid(C)),
format('<span class="about">Sorry,~w is not a valid change~n<br /></span>',[C]).
valid(C):-
see('tempchange.txt'),
read(X),
seen,
fuzzy_match(X,C).
fuzzy_match([],[]).
fuzzy_match([H|T],L):-fuzz_remove(H,L,N), fuzzy_match(T,N).
fuzz_remove(H,[X|Y],Y):-dwim_match(H,X),!.
fuzz_remove(H,[X|Y],[X|L]):-fuzz_remove(H,Y, L).
permutation([],[]):-!.
permutation(L, [H|T]):-
append(V,[H|U],L), append(V,U,W), permutation(W,T).
count([],[],0).
count([X|T], [Y|R], M):-dwim_match(X,Y),!,count(T,R,N), M is N+1.
count([X|T], [Y|R], M):-not(equal(X,Y)),count(T,R,M).
validate([]).
validate([H|T]):-not(member(H,T)), validate(T).
/*offline*/
play(X):-go(X),
game_loop(X).
game_loop(X):-read(Guess), test(Guess,X).
test(Guess,X):-correct(Guess,X).
test(Guess,X):-correct(Guess,N), write(N),write('\n'), game_loop(X).
equal(X,X).
/*generating a change*/
ranlist([],0,_):-!.
ranlist([H|T],N,C):-M is N-1,ranlist(T,M,C), genrand(H,T,C).
change(C,X):-ranlist(C,X,X).
genrand(X,List,Top):-random(Top,X), not(member(X,List)),!.
genrand(X,List,Top):-genrand(X,List,Top).
sum([],0).
sum([H|T], R):-sum(T,R1), R is R1*10+H mod 4091.
start:-get_time(X),convert_time(X,S), string_to_list(S,L), sum(L,N), Z is N, asserta(seed(Z)).
random(R,N):-seed(S),N is (S mod R) +1, NewSeed is (125*S +1) mod 4091,asserta(seed(NewSeed)),!.
Back to top
main:-
write('Content-type:text/html\n\n'),
write('<?xml version="1.0" encoding="UTF-8"?><!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'),
write(' "DTD/xhtml1-strict.dtd">'),
format('<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">',[]),
write('<head><title>Guess the change: Prolog version</title>'),
write('<link rel="stylesheet" type="text/css" href = "../styles/change.css"></link></head><body>'),
format('<h1>Guess the Change</h1><div class = "about"><p> A "change" is a bellringing term. Each "change" is a different permutation of the bells.',[]),
write('Examples are <span class = "ex"> 12345678 </span>, <span class = "ex"> 13572468</span> or <span class = "ex">87654321</span>.'),
write('The game is very simple. The computer thinks of a change. You suggest a change,'),
write('and you will be told how many of the bells are in the same place as the one the computer is thinking of. On the basis of this information, you keep refining your guess until you come up with the correct change. </p>'),
write('<p> This program demonstrates a solution strategy, given a change. '),
write('The algorithm begins by choosing a random change, and then gradually refines its guess by choosing any new change which is consistent with all previous information. '),
write('This may not be the optimal strategy (for example, can we perform slightly better by considering the sets of changes included/excluded by a choice, and picking the change which is likely to give us the most information?), but it performs fairly well---an average of about 12 guesses for 8 bells--- and in general better than human guessers. '),
write('The use of a random change to start with has no effect on the overall performance of the algorithm
but guards against it being more biased towards a particular change.</p></div> '),
write('<div>'),
write('<form action="prologsolve.cgi" method="get"><p>Suggest a change(permutation of numbers 1 to n for 1 < n <= 9):<input type="text" name="change" value="12345678" maxlength="9" />'),
write('<input type="submit" value="solve" /></p></form> </div>'),
write('<div class="footer">'),
write('<hr />'),
write('<a href="src.cgi">Prolog source code</a>'),
write('<a href="../change">Play guess the change</a>'),
write('<a href="../">Home</a></div></body></html>').
Back to top