November 02, 2008

Tic-Tac-Toe

某人和我讲说,blog要技术含量啊技术含量。
我想了想,于是把做的minimax implementation in prolog贴出来纪念。

我想也许以后我都不会再去写prolog的程序了。
虽然这个语言确实是很可爱。

第一个algorithm是用huristic找goodmove:
:- dynamic o/1.
:- dynamic x/1.

not(Z) :- Z,!,fail.
not(Z).

ordered_line(1,2,3). ordered_line(4,5,6). ordered_line(7,8,9).
ordered_line(1,4,7). ordered_line(2,5,8). ordered_line(3,6,9).
ordered_line(1,5,9). ordered_line(3,5,7).
line(A, B, C) :- ordered_line(A, B, C).
line(A, B, C) :- ordered_line(A, C, B).
line(A, B, C) :- ordered_line(B, A, C).
line(A, B, C) :- ordered_line(B, C, A).
line(A, B, C) :- ordered_line(C, A, B).
line(A, B, C) :- ordered_line(C, B, A).

full(A) :- x(A). full(A) :- o(A). empty(A) :- not(full(A)).

same(A, A).
different(A, B) :- not(same(A, B)).

move(A) :- good(A), empty(A), !.

/* Strategy */
good(A) :- win(A).
good(A) :- block_win(A).
good(A) :- split(A).
good(A) :- block_split(A).
good(A) :- build(A).

good(5). good(1). good(3). good(7). good(9).
good(2). good(4). good(6). good(8).

win(A) :- x(B), x(C), line(A,B,C).
block_win(A) :- o(B), o(C), line(A,B,C).
split(A) :- x(B), x(C), different(B,C), line(A,B,D), line(A,C,E), empty(D), empty(E).
block_split(A) :- o(B), o(C), different(B,C), line(A,B,D), line(A,C,E), empty(D), empty(E).
build(A) :- x(B), line(A,B,C), empty(C).

all_full :- full(1), full(2), full(3), full(4), full(5), full(6), full(7), full(8), full(9).

done :- ordered_line(A,B,C), x(A), x(B), x(C), write('Computer won.'), nl.
done :- ordered_line(A,B,C), o(A), o(B), o(C), write('Human won.'), nl. % should NOT happen
done :- all_full, write('It\'s a tie.'), nl.

equal(X,X).
checkmove(X) :-equal(X,1).
checkmove(X) :-equal(X,2).
checkmove(X) :-equal(X,3).
checkmove(X) :-equal(X,4).
checkmove(X) :-equal(X,5).
checkmove(X) :-equal(X,6).
checkmove(X) :-equal(X,7).
checkmove(X) :-equal(X,8).
checkmove(X) :-equal(X,9).
/*repeated asking if not valid move.*/
getmove :- repeat,write('What is your move? '), read(X), empty(X),checkmove(X),assert(o(X)).

makemove :- move(X), !, assert(x(X)).
makemove :- all_full.

printsquare(N) :- o(N), write(' o ').
printsquare(N) :- x(N), write(' x ').
printsquare(N) :- empty(N), write(' ').
printboard :-
write(' 1 | 2 | 3 '),
printsquare(1),write('|'), printsquare(2),write('|'), printsquare(3), nl,
write('---+---+--- ---+---+---'),nl,
write(' 4 | 5 | 6 '),
printsquare(4),write('|'), printsquare(5),write('|'), printsquare(6), nl,
write('---+---+--- ---+---+---'),nl,
write(' 7 | 8 | 9 '),
printsquare(7),write('|'), printsquare(8),write('|'),printsquare(9), nl.

clear :- x(A), retract(x(A)), fail.
clear :- o(A), retract(o(A)), fail.

% main goal:
play :- not(clear), repeat, printboard,getmove,printboard,write('Thinking...'),nl,makemove,printboard,done.


第二个algorithm是minimax的implementation:
话说写完这个我自己和电脑玩了很久。。

%%%defining global symbols
setflag(Name,X) :-
nonvar(Name), %only constants allowed
retract(flag(Name,Val)), %kill if defined
!,asserta(flag(Name,X)). %freeze & redefine
setflag(Name,X) :-
nonvar(Name), %only constants allowed
asserta(flag(Name,X)). %initial value

%%%strarting the game
new_game(XorO,S) :- setflag(theboard,[[b,b,b],[b,b,b],[b,b,b]]),
Searchdepth is 4,
setflag(sdepth,Searchdepth),
flag(theboard,B), %retrive the blank board
pprint(B),
begin(XorO,S,B,Searchdepth).

begin(x,x,B,Searchdepth) :- %matches if human goes first
write('What is your move?'),tab(2),read(M),check(M,x).
begin(x,o,B,Searchdepth) :-
write('What is your move?'),tab(2),read(M),check(M,o).

begin(o,o,B,Searchdepth) :- %matches if computer goes first
computermoves(B,o,Searchdepth).
begin(o,x,B,Searchdepth) :- %matches if computer goes first
computermoves(B,x,Searchdepth).

%%%user interface rule
check(M,x) :- number(M),M>=1,M=<9 br="" enter="" x=""> write('Invalid move.Try again.'),nl,
write('What is your move?'),tab(2),read(N),check(N,x).
check(M,o) :- number(M),M>=1,M=<9 br="" enter="" o=""> write('Invalid move.Try again.'),nl,
write('What is your move?'),tab(2),read(N),check(N,o).

enter(M,x) :-
flag(sdepth,SD),flag(theboard,B), %recover the board
Row is ((M+2)//3),Col is ((M+2)mod 3)+1,
install(x,[Row,Col],B,NewB), %place 'x'
pprint(NewB),
endgamecheck(NewB), %did he win?
computermoves(NewB,o,SD).
enter(M,o) :-
flag(sdepth,SD),flag(theboard,B),
Row is ((M+2)//3),Col is ((M+2)mod 3)+1,
install(o,[Row,Col],B,NewB), %place 'x'
pprint(NewB),
endgamecheck(NewB), %did he win?
computermoves(NewB,x,SD).

computermoves(Board,x,Searchdepth) :-
choosemove(x,Board,Searchdepth,Movechoice,Maxvalue),
%find the best move;Maxvalue is the largest of choices

install(x,Movechoice,Board,NewB), %compute board
setflag(theboard,NewB), %store new board
write('Thinking...'),nl,pprint(NewB),
endgamecheck(NewB),
write('What is your move?'),tab(2),read(M),check(M,o).
computermoves(Board,o,Searchdepth) :-
choosemove(o,Board,Searchdepth,Movechoice,Maxvalue),
%find the best move;Maxvalue is the largest of choices

install(o,Movechoice,Board,NewB), %compute board
setflag(theboard,NewB), %store new board
write('Thinking...'),nl,pprint(NewB),
endgamecheck(NewB),
write('What is your move?'),tab(2),read(M),check(M,x).

%%%choosing the best move
choosemove(XorO,B,SD,[],10000) :-terminalwin(B).
choosemove(XorO,B,SD,[],-10000) :-terminalloss(B).
choosemove(XorO,B,SD,Posn,Best) :-
NewSD is SD-1, %1 step deeper
genposns(B,Posnlist), %all possible moves from here
evalmovelist(XorO,B,NewSD,Posnlist,Valuelist), %a value for each
bestmove(XorO,Posnlist,Valuelist,Posn,Best). %pick the best


%%%where can we move
genposns(B,Posnlist) :-setof(P,openposn(B,P),Posnlist),!.
genposns(B,[]). %if 'setof' fails,Posnlist should be empty

openposn(B,[R,C]) :- row(R),column(C),install(o,[R,C],B,B1).
row(1). row(2). row(3). column(1). column(2). column(3).

%%%putting an x or o on the board
install(XorO,[1,Col],[BdRow|Rest],[New|Rest]) :-
!,installinrow(XorO,Col,BdRow,New). %move into row
install(XorO,[Row,Col],[BdRow|Rest],[BdRow|New]) :-
Next is Row-1,install(XorO,[Next,Col],Rest,New).

installinrow(XorO,1,[b|Rest],[XorO|Rest]) :-!.
installinrow(XorO,Col,[FirstCol|Rest],[FirstCol|New]) :-
Next is Col-1,installinrow(XorO,Next,Rest,New).

%%%ealuate a list of moves
evalmovelist(XorO,B,SD,[],[]). %empty base case

evalmovelist(XorO,B,SD,[Pos], [Val]):- %1 element list
evalmove(XorO, B, SD, Pos, Val).

evalmovelist(XorO, B, SD, [Pos|P], [Val|V]):-
evalmovelist(XorO, B, SD, P, V), %do the rest of it,
evalmove(XorO, B, SD, Pos, Val). %now the 1st element

evalmove(XorO, B, 0, Pos, Val):- %Basecase; at search limit.
!, install(XorO, Pos, B, B1), %Freeze choice,place the x or o and compute static value
staticvalue(B1, Val).

evalmove(XorO, B, SD, Pos, Val):-
install(XorO, Pos, B, B1), %place the x or o
toggle(XorO, OorX), %move from the resulting choices
choosemove(OorX, B1, SD, Ignore, Val).

toggle(x, o):-!. %Given x or o in one argument, it binds
toggle(o, x):-!. %the other argument to the opposite token

%%%selecting the best from the list
bestmove(XorO,[],[],[],0) :-!. %non possible, give it a zero

bestmove(XorO,[Move],[Value],Move,Value) :-!. %only one, it is the best

bestmove(o,[M1|Othermoves],[V1|Othervalues],M,V) :-
bestmove(o,Othermoves,Othervalues,M,V),
V

>=
V1,!.
bestmove(o,[M1|Othermoves],[V1|Othervalues],M1,V1). %else best is the first


bestmove(x,[M1|Othermoves],[V1|Othervalues],M,V) :-
bestmove(x,Othermoves,Othervalues,M,V), %best=best of the rest if
V
=<
V1,!. %the best of the rest is =<1st .="" br="" freeze="">bestmove(x,[M1|Othermoves],[V1|Othervalues],M1,V1). %else best is the first

%%%evaluate the current board

staticvalue(B,10000) :- terminalwin(B),!.
staticvalue(B,-10000) :-terminalloss(B),!.
staticvalue(B,V) :-
extractrcd(B,RCDlist),evallist(RCDlist,V).

extractrcd([[SQ11,SQ12,SQ13],[SQ21,SQ22,SQ23],[SQ31,SQ32,SQ33]],
[[SQ11,SQ12,SQ13],[SQ21,SQ22,SQ23], % 1st 2 rows
[SQ31,SQ32,SQ33],[SQ11,SQ21,SQ31], % 3rd row ,1st col
[SQ12,SQ22,SQ32],[SQ13,SQ23,SQ33], % last 2 cols
[SQ11,SQ22,SQ33],[SQ13,SQ22,SQ31]]). % 2 diagonals

evallist([L],V) :-!,eval(L,V). %only first list,evaluate it
evallist([L1|Lr],V) :-evallist(Lr,V1),
eval(L1,V2),
V is V1+V2.
eval([b,b,b],0) :-!.
eval(L,V) :-numberof(x,L,Nx),numberof(o,L,No),
val(Nx,No,V).
numberof(Char,[],0).
numberof(Char,[Char|Y],N) :-numberof(Char,Y,Nrest),
N is Nrest+1,!.
numberof(Char,[X|Y],N) :-numberof(char,Y,N).

val(Nx,No,0) :-Nx
>0,No>
0,!.
val(Nx,0,V) :- !, V is -(Nx ** 3). %V is -Nx^3
val(0,No,V) :- !, V is (No ** 3).

%%%recognizing the end
endgamecheck(B) :- terminalwin(B),!,
write('Computer win.'),nl,abort.
endgamecheck(B) :- terminalloss(B),!,
write('Human win'),nl,abort. %should not happen.
endgamecheck(B) :- fullboard(B),!,
write('It is a tie.'),nl,abort.
endgamecheck(B).

terminalwin(B) :-extractrcd(B,RCDlist),
o3(RCDlist).

o3([[o,o,o] | Rest]) :- !.
o3([Head | Rest]) :- o3(Rest).

terminalloss(B) :- extractrcd(B, RCDlist),
x3(RCDlist).

x3([[x,x,x] | Rest]) :- !.
x3([Head | Rest]) :- x3(Rest).

fullboard([Row1,Row2,Row3]) :- not(member(b,Row1)),
not(member(b,Row2)),
not(member(b,Row3)).

%%%printing out the board
pprint([[S11,S12,S13],[S21,S22,S23],[S31,S32,S33]]) :-
tab(2), write(' 1 | 2 | 3 '),tab(5), pprintrow(S11,S12,S13),nl,
tab(2),type2,tab(5), type2,nl,
tab(2), write(' 4 | 5 | 6 '),tab(5), pprintrow(S21,S22,S23),nl,
tab(2),type2,tab(5), type2,nl,
tab(2), write(' 7 | 8 | 9 '),tab(5), pprintrow(S31,S32,S33),nl.

type1 :- tab(5), write('|'), tab(5), write('|'), tab(5).
type2 :- write('---+---+---').

pprintrow(C1, C2, C3) :- write(' '),
pprintchar(C1),
write(' | '),
pprintchar(C2),
write(' | '),
pprintchar(C3),
write(' ').

pprintchar(b) :- write(' '), !.
pprintchar(Char) :- write(Char).

%%%some definition
not(Z) :-Z,!,fail.
not(Z).

member(X,[X|Tail]).
member(X,[Head|Tail]) :- member(X,Tail).

No comments: