% Written 2006 Markus Triska triska@gmx.at % Public domain code. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The game board is represented as a list of terms col(Num,Free,TP,TN,Ps): Num: column number Free: yes/no, whether a piece can be placed "on top" (= at the end) TP: Colour of topmost piece TN: max. number of consecutive topmost pieces of same colour Ps: Pieces in this column - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ empty(.). empty_board(N, M, Board) :- length(Board, M), length(Es, N), maplist(empty, Es), make_columns(Board, 1, Es). make_columns([], _, _). make_columns([col(N0,yes,empty,0,Empty)|Cs], N0, Empty) :- N1 is N0 + 1, make_columns(Cs, N1, Empty). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% win(Player, Board) :- ( member(col(_,_,Player,N,_), Board), N >= 4 ; un_col(Board, Board1), ( four_in_a_row(Board1, Player) ; diagonal(Board1, Player) ) ). un_col([], []). un_col([col(_,_,_,_,Cs)|Rest], [Cs|Css]) :- un_col(Rest, Css). four_in_a_row([Col1,Col2,Col3,Col4|Cs], Player) :- ( four_in_a_row(Col1, Col2, Col3, Col4, Player) ; four_in_a_row([Col2,Col3,Col4|Cs], Player) ). four_in_a_row([C1|Cs1], [C2|Cs2], [C3|Cs3], [C4|Cs4], P) :- \+ empty(C1), \+ empty(C2), \+ empty(C3), \+ empty(C4), ( C1 == P, C2 == P, C3 == P, C4 == P ; four_in_a_row(Cs1, Cs2, Cs3, Cs4, P) ). diagonal(Board, Player) :- Board = [_,_,_,_|_], ( diagonal_down(Board, Player) ; diagonal_up(Board, Player) ; Board = [_|Rest], diagonal(Rest, Player) ). diagonal_down([Col1,Col2,Col3,Col4|_], Player) :- Col2 = [_|Rot2], Col3 = [_,_|Rot3], Col4 = [_,_,_|Rot4], four_in_a_row(Col1, Rot2, Rot3, Rot4, Player). diagonal_up([Col1,Col2,Col3,Col4|_], Player) :- Col1 = [_,_,_|Rot1], Col2 = [_,_|Rot2], Col3 = [_|Rot3], four_in_a_row(Rot1, Rot2, Rot3, Col4, Player). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% insert_piece_([P|Ps], Player, Is, Free) :- ( empty(P) -> Is = [Player|Ps], ( Ps = [] -> Free = no ; Free = yes ) ; Is = [P|Rest], insert_piece_(Ps, Player, Rest, Free) ). play_column([Col0|Cols0], Column, Player, [Col|Cols]) :- Col0 = col(CN0,_,TP0,TN0,Cs0), ( CN0 =:= Column -> insert_piece_(Cs0, Player, Cs, Free), Cols = Cols0, ( TP0 == Player -> TN is TN0 + 1 ; TN = 1 ), Col = col(CN0,Free,Player,TN,Cs) ; Col = Col0, play_column(Cols0, Column, Player, Cols) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Minimax algorithm with alpha-beta pruning - x is the maximizing player. For all possible moves, compute the best move o could do, then take the maximum (i.e., make it hard for o). The "best move o could do" is computed analogously, by making it hard for x. If no decision (win) is reached within Depth moves, assign 0. Some heuristic evaluation assigning a value in (-1, 1) would be better. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ opponent(x, o). opponent(o, x). max_player(x). max_depth(4). possible_moves([], []). possible_moves([col(Num,Free,_,_,_)|Cols], Ms) :- ( Free == yes -> Ms = [Num|MsRest], possible_moves(Cols, MsRest) ; possible_moves(Cols, Ms) ). play(Player, Board0, Column) :- possible_moves(Board0, Moves0), max_depth(Depth), Alpha is -Depth - 1, Beta is Depth + 1, assess_moves(Moves0, Depth, Alpha, Beta, Player, Board0, Moves1), choose(Player, Moves1, Column). key_eq(G, G-_). choose(Player, Moves, Move) :- best_value(Moves, Player, V), sublist(key_eq(V), Moves, Choices), length(Choices, LC), Index is random(LC), nth0(Index, Choices, _-Move). assess_moves([], _, _, _, _, _, []). assess_moves([M|Ms], Depth, Alpha0, Beta0, Player, Board0, [A-M|AMs]) :- assess_move(Depth, Alpha0, Beta0, Player, Board0, M, A), ( max_player(Player) -> Alpha1 is max(Alpha0, A), Beta1 is Beta0 ; Alpha1 is Alpha0, Beta1 is min(Beta0, A) ), ( Beta1 < Alpha1 -> AMs = [] ; assess_moves(Ms, Depth, Alpha1, Beta1, Player, Board0, AMs) ). assess_move(0, _, _, _, _, _, 0) :- !. assess_move(Depth, Alpha, Beta, Player, Board0, Move, A) :- play_column(Board0, Move, Player, Board1), ( win(Player, Board1) -> ( max_player(Player) -> A is 1 + Depth % favour early wins ; A is -1 - Depth ) ; possible_moves(Board1, Moves), ( Moves == [] -> A = 0 ; D1 is Depth - 1, opponent(Player, Opp), assess_moves(Moves, D1, Alpha, Beta, Opp, Board1, Ms), best_value(Ms, Opp, A) ) ). best_value(Moves, Player, Value) :- keysort(Moves, Ms), ( max_player(Player) -> last(Ms, Value-_) ; Ms = [Value-_|_] ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% transpose(M, T) :- M = [F|_], transpose(F, M, T). transpose([], _, []). transpose([_|Rs], Ms, [Ts|Rest]) :- take_firsts(Ms, Ts, Ms1), transpose(Rs, Ms1, Rest). take_firsts([], [], []). take_firsts([[F|Rest]|Ls], [F|Fs], [Rest|Rests]) :- take_firsts(Ls, Fs, Rests). display_board(Board0) :- un_col(Board0, Board1), maplist(reverse, Board1, Board2), transpose(Board2, Ts), maplist(print_line, Ts), nl. print_line(Line) :- format("\n\t"), maplist(print_col, Line). print_col(Col) :- format("~w ", [Col]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% play :- empty_board(6, 7, Board0), alternate(x, Board0). alternate(Player, Board0) :- ( play(Player, Board0, Column) -> play_column(Board0, Column, Player, Board1), format("\n\n~w plays:\n", [Player]), display_board(Board1), ( win(Player, Board1) -> format("~w wins\n", [Player]) ; opponent(Player, Opp), alternate(Opp, Board1) ) ; format("draw\n") ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PostScript definitions. Sample instructions, with these definitions loaded: /x 4 drop /o 4 drop /x 3 drop /x wins - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ postscript --> "360 7 div dup scale 0.05 setlinewidth \ /Helvetica-Bold 0.7 selectfont \ 0 0 moveto 7 0 lineto stroke \ 0 1 7 { dup 0 moveto 6 lineto stroke } for \ gsave 0.5 6.2 translate \ 1 1 7 { 1 string cvs dup stringwidth pop -2 div 0 moveto show \ 1 0 translate } for grestore \ \ /heights [7 { 0 } repeat] def \ /player { /x eq { 1 0 0 } { 0 0 1 } ifelse setrgbcolor \ newpath 0.5 0.5 0.4 0 360 arc fill } bind def \ /drop { gsave 1 sub /c exch def c heights c get translate \ player grestore heights c heights c get 1 add put } bind def \ \ /nonumbers { 1 setgray 0 6 7 1 rectfill } bind def \ /wins { nonumbers gsave 0.5 6 translate player \ 1 0.2 moveto (wins) show grestore } bind def \ /draw { nonumbers 0.5 6.2 moveto 0 setgray (draw) show } bind def". show :- empty_board(6, 7, Board0), open(pipe('gs -dNOPROMPT -g600x600 -r120 -q'), write, Out, [buffer(false)]), tell(Out), phrase(postscript, Ps), format("~s\n", [Ps]), call_cleanup((interact(x, Board0);false), close(Out)). user_input(Board, Char) :- get_single_char(Char0), ( Char0 == (0' ) -> Char = c ; between(0'1, 0'7, Char0) -> Char1 is Char0 - 0'0, ( play_column(Board, Char1, x, _) -> Char = Char1 ; user_input(Board, Char) ) ; user_input(Board, Char) ). interact(Player, Board0) :- ( \+ play(Player, Board0, _) -> format("draw\n") ; user_input(Board0, Char), ( Char == c -> play(Player, Board0, Column) ; Column = Char ), play_column(Board0, Column, Player, Board1), format("/~w ~w drop\n", [Player,Column]), ( win(Player, Board1) -> format("/~w wins\n", [Player]) ; opponent(Player, Opp), interact(Opp, Board1) ) ). %?- show.