 |
Download Source Code
/*index.pl
* Function: consulting and explanation
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 27-06-2006
*/
:- consult('checkers.pl'),
consult('checkersAB.pl'),
consult('makeBoard.pl'),
consult('moves.pl'),
consult('playgame.pl'),
consult('testing.pl'),
consult('toUMIRTX.pl').
% Default board configuration.
startstate([[0/0,0/2,1/1,1/3,2/0,2/2,3/1,3/3,4/0,4/2,5/1,5/3,6/0,6/2,7/1,7/3,8/0,8/2,9/1,9/3], [0/8,0/6,1/9,1/7,2/8,2/6,3/9,3/7,4/8,4/6,5/9,5/7,6/8,6/6,7/9,7/7,8/8,8/6,9/9,9/7],white]).
:- write('predicates:'),nl,
write('a game of checkers can be started using: initgame/1. with arg. Minimaxdepth'),nl,
write('to make a move give a list containing all the positions (X/Y) that the white piece visits'),nl,nl,
write('a game from a certain position can be started using: playgame/2 with args. State, Minimaxdepth.'),nl,
write('a minimax test can be run using: testingM/1 with arg. Starting depth'),nl,
write('a alpha-Beta test can be run using: testingAB/1 with arg. Starting depth'),nl,
write('to test a different case edit code in testing.pl'),nl,
write('All tests stop at depth 7'),nl,nl,
write('Any state can be printed using: makeBoard/1 with arg. State'),nl,
write('a state is a list containing a list of white pieces, a list of black pieces and a turn (white/black)'),nl,
write('for an example type: teststate3(Pos)'),nl
/* playgame.pl
* Function: Main interface for the checkers game.
* Passes moves to robot.
* Gets user input for game.
* Checks user input for legality. #Not implemented yet!
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 27-06-2006
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Game main file. %
% This is the interface for playing Checkers %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% beginning of the game
initgame(MMDepth) :-
startstate(Pos),
makeBoard(Pos), nl,
write('Your move:'), nl,
read(Move),
playmove(Pos, Move, NewPos),
makeBoard(NewPos), nl,
playgame(NewPos,MMDepth).
% calling of black move and calling of minimax
playgame([White,Black,black], MMDepth) :-
(endOfGame([White,Black,black]), !,
write('End of game!'));
(alphabeta([White,Black,black], -100, 100, NewPos, _, MMDepth),
% here we write the move to a file
toUMIRTX([White,Black,black], NewPos),
makeBoard(NewPos), nl,
playgame(NewPos, MMDepth)).
% reading of the human White move
playgame([White,Black,white], MMDepth) :-
(endOfGame([White,Black,black]), !,
write('End of game!'));
(write('Your move:'), nl,
read(Move),
% legal/1 not implemented yet, should check the white move.
% legal(Move),
playmove0([White,Black,white], Move, NewPos),
makeBoard(NewPos), nl,
playgame(NewPos, MMDepth)).
% End of game check.
endOfGame([[], [_|_], _]) :-
write('Black wins!'), nl.
endOfGame([[_|_], [], _]) :-
write('White wins!'), nl.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% reading of moves and making a new state %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% playmove0 is a wrapper around playmove to make multiple strikes possible.
% Base case: white only makes one move or one strike in his turn.
playmove0([White,Black,white], [OldPiece, NewPiece], [NWhite,NBlack,black]) :-
playmove([White,Black,white], [OldPiece, NewPiece], [NWhite,NBlack,white]).
% Case that white makes multiple strikes in one turn.
playmove0([White,Black,white], [OldPiece, NewPiece | RestPiece], NewPos) :-
playmove([White,Black,white], [OldPiece, NewPiece], TempPos),
playmove0(TempPos, [NewPiece | RestPiece], NewPos).
% extra predicate to exit the game without crashing it
% not implemented in the right way yet.
playmove(_, exit, _) :-
abort, !.
playmove([White,Black,white], [OldX/OldY, NewX/NewY], [NWhite,NBlack,white]) :-
select(OldX/OldY, White, TempWhite),
2 is NewX - OldX,
2 is NewY - OldY,
BlackX is NewX - 1,
BlackY is NewY - 1,
select(BlackX/BlackY, Black, NBlack),
append([NewX/NewY], TempWhite, NWhite).
playmove([White,Black,white], [OldX/OldY, NewX/NewY], [NWhite,NBlack,white]) :-
select(OldX/OldY, White, TempWhite),
2 is OldX - NewX,
2 is NewY - OldY,
BlackX is NewX + 1,
BlackY is NewY - 1,
select(BlackX/BlackY, Black, NBlack),
append([NewX/NewY], TempWhite, NWhite).
playmove([White,Black,white], [OldX/OldY, NewX/NewY], [NWhite,NBlack,white]) :-
select(OldX/OldY, White, TempWhite),
2 is NewX - OldX,
2 is OldY - NewY,
BlackX is NewX - 1,
BlackY is NewY + 1,
select(BlackX/BlackY, Black, NBlack),
append([NewX/NewY], TempWhite, NWhite).
playmove([White,Black,white], [OldX/OldY, NewX/NewY], [NWhite,NBlack,white]) :-
select(OldX/OldY, White, TempWhite),
2 is OldX - NewX,
2 is OldY - NewY,
BlackX is NewX + 1,
BlackY is NewY + 1,
select(BlackX/BlackY, Black, NBlack),
append([NewX/NewY], TempWhite, NWhite).
playmove([White,Black,white], [OldPiece, NewPiece], [NWhite,Black,black]) :-
select(OldPiece, White, TempWhite),
append([NewPiece], TempWhite, NWhite).
/* checkers.pl
* Function: MiniMax implementation for checkers ('dammen').
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 27-06-2006
*/
:- dynamic stateCounterM/1.
:- retractall(stateCounterM(_)), assert(stateCounterM(0)).
stateCountupM :-
stateCounterM(X),
retractall(stateCounterM(_)),
Y is X + 1,
assert(stateCounterM(Y)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MiniMax algorithm. %
% Adapted from I. Bratko; 'PROLOG Programming for Artificial Intelligence.' %
% Robot is black and always the Maximizer. %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% minimax(Pos, BestSucc, Val, Depth):
% Pos is a position, Val is its minimax value;
% best move from Pos leads to position BestSucc
% Depth is maximum recursion depth.
minimax(Pos, _, Val, 0) :- % Max recursion depth reached:
stateCountupM,
staticval(Pos, Val), !. % evaluate value.
minimax(Pos, _, Val, _) :-
stateCountupM,
moves(Pos, []), % No more possible moves:
staticval(Pos, Val), !. % evaluate value.
minimax(Pos, BestSucc, Val, Depth) :- % Get best succesor using MiniMax principle.
stateCountupM,
moves(Pos, PosList),!, % Return all posible legal moves.
best(PosList, BestSucc, Val, Depth). % Get the move with the best value.
best([Pos], Pos, Val, Depth) :- % Only 1 possible move, return move as best.
NewDepth is Depth - 1,
minimax(Pos, _, Val, NewDepth),!.
best([Pos1|PosList], BestPos, BestVal, Depth) :-
NewDepth is Depth - 1,
minimax(Pos1, _, Val1, NewDepth),
best(PosList, Pos2, Val2, Depth),
betterof(Pos1, Val1, Pos2, Val2, BestPos, BestVal).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% End of MiniMax algorithm.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* checkersAB.pl
* Function: MiniMax implementation for checkers ('dammen').
* Implementing alpha-beta pruning
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 28-06-2006
*/
:- dynamic stateCounterAB/1.
:- retractall(stateCounterAB(_)), assert(stateCounterAB(0)).
stateCountupAB :-
stateCounterAB(X),
retractall(stateCounterAB(_)),
Y is X + 1,
assert(stateCounterAB(Y)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Alpha-Beta MiniMax algorithm. %
% Adapted from I. Bratko; 'PROLOG Programming for Artificial Intelligence.' %
% Robot is black and always the Maximizer. %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Max recursion depth reached:
alphabeta(Pos, _, _, _, Val, 0) :-
stateCountupAB,
staticval(Pos, Val), !. % evaluate value.
alphabeta(Pos, _, _, _, Val, _) :-
stateCountupAB,
moves(Pos, []), % No more possible moves:
staticval(Pos, Val), !. % evaluate value.
alphabeta(Pos, A, B, GoodPos, Val, Depth) :-
stateCountupAB,
moves(Pos, PosList), !,
boundedbest(PosList, A, B, GoodPos, Val, Depth).
boundedbest([Pos|PosList], A, B, GoodPos, GoodVal, Depth) :-
NewDepth is Depth - 1,
alphabeta(Pos, A, B, _, Val, NewDepth),
goodenough(PosList, A, B, Pos, Val, GoodPos, GoodVal, Depth).
% No other candidate, return Pos.
goodenough([], _, _, Pos, Val, Pos, Val, _) :- !.
goodenough(_, A, B, Pos, Val, Pos, Val, _) :-
(min_to_move(Pos), % Max attained upper bound.
Val > B, !);
(max_to_move(Pos), % Min attained lower bound.
Val < A, !).
goodenough(PosList, A, B, Pos, Val, GoodPos, GoodVal, Depth) :-
% Refine bounds.
newbounds(A, B, Pos, Val, NewA, NewB),
boundedbest(PosList, NewA, NewB, Pos1, Val1, Depth),
betterof(Pos, Val, Pos1, Val1, GoodPos, GoodVal).
newbounds(A, B, Pos, Val, Val, B) :-
min_to_move(Pos),
Val > A, !. % Max increased lower bound.
newbounds(A, B, Pos, Val, A, Val) :-
max_to_move(Pos),
Val < B, !. % Min decreased upper bound.
newbounds(A, B, _, _, A, B). % Bounds unchanged.
%%%%%%%%%%%%%%%%%%%%%%%%%%%
% End of MiniMax algorithm. %
%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* moves.pl
* Function: predicates needed for MiniMax and Alpha-Beta Minimax
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 28-06-2006
*/
% Better of predicate:
betterof(Pos0, Val0, _, Val1, Pos0, Val0) :-
(min_to_move(Pos0), % Next turn Min will move.
Val0 > Val1, !) % Max moving now and favors highest value.
;
(max_to_move(Pos0), % Next turn Max will move.
Val0 < Val1, !). % Min moving now and favors lowest value.
betterof(_, _, Pos1, Val1, Pos1, Val1). % Otherwise Val1 is prefered.
% Moves predicate:
moves(Pos, PosList) :-
findall(NewPos, move0(Pos,NewPos), PosList).
% Cut ensures that strikes are always done first if possible.
move0(Pos, NewPos) :-
(strikemove0(Pos, NewPos), !);
normalmove(Pos, NewPos).
% Min/Max turn to move predicates:
min_to_move([_, _, white]).
max_to_move([_, _, black]).
% Static Value predicates:
staticval([[], [_|_], _], 100). % Black wins: high value
staticval([[_|_], [], _], -100). % White wins: low value
staticval([White, Black, _], Val) :- % Heuristics:
length(White, WhitePieces), % 2 * piece difference
length(Black, BlackPieces), % 1 * hekstelling difference
WhitePieces =< 8,
BlackPieces =< 8,
hekstelling(White, White, HValWhite),
hekstelling(Black, Black, HValBlack),
Val is 2 * (BlackPieces - WhitePieces) + (HValBlack - HValWhite).
staticval([White, Black, _], Val) :- % Heuristics:
length(White, WhitePieces), % 2 * piece difference
length(Black, BlackPieces), % 1 * hekstelling difference
Val is 2 * (BlackPieces - WhitePieces).
/* Hekstelling heuristic. Checks every piece to see if it's the centre of a
* hekstelling. Voor a full 'hekstelling' Val is increased by 2, for a half
* Val is increased by 1.
* See also: http://www.xs4all.nl/~dezlaren/opgaven/techniek.htm
*/
% Base case.
hekstelling([], _, 0).
% Full hekstelling, bottomleft to topright diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 + 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 - 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
X4 is X1 - 1,
Y4 is Y1 + 1,
member(X4/Y4, List2),
Val is OldVal + 2, !.
% Full hekstelling, bottomleft to topright diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 + 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 - 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
X4 is X1 + 1,
Y4 is Y1 - 1,
member(X4/Y4, List2),
Val is OldVal + 2, !.
% Full hekstelling, bottomright to topleft diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 - 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 + 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
X4 is X1 - 1,
Y4 is Y1 - 1,
member(X4/Y4, List2),
Val is OldVal + 2, !.
% Full hekstelling, bottomright to topleft diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 - 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 + 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
X4 is X1 + 1,
Y4 is Y1 + 1,
member(X4/Y4, List2),
Val is OldVal + 2, !.
% Half hekstelling, bottomleft to topright diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 + 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 - 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
Val is OldVal + 1, !.
% Half hekstelling, bottomright to topleft diagonal:
hekstelling([X1/Y1 | List], List2, Val) :-
hekstelling(List, List2, OldVal),
X2 is X1 - 1,
Y2 is Y1 + 1,
member(X2/Y2, List2),
X3 is X1 + 1,
Y3 is Y1 - 1,
member(X3/Y3, List2),
Val is OldVal + 1, !.
% Piece is not the centre of a hekstelling:
hekstelling([_/_ | List], List2, Val) :-
hekstelling(List, List2, Val).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Move predicates. %
% move(+Pos, -NewPos). %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Wrapper around strike moves. Made to make multiple strikes in one turn
% possible.
strikemove0([White, Black, black], [NewWhite, NewBlack, white]) :-
strikemove([White, Black, black], [TempWhite, [StrikePiece|RestBlack], black], []),
strikemove1([TempWhite, [StrikePiece], black], [NewWhite, TempBlack, black], RestBlack),
append(TempBlack, RestBlack, NewBlack).
strikemove0([White, Black, white], [NewWhite, NewBlack, black]) :-
strikemove([White, Black, white], [[StrikePiece|RestWhite], TempBlack, white], []),
strikemove1([[StrikePiece], TempBlack, white], [TempWhite, NewBlack, white], RestWhite),
append(TempWhite, RestWhite, NewWhite).
strikemove1([White,Black,Turn], [White,Black,Turn], RestPieces) :-
\+ strikemove([White,Black,Turn], _, RestPieces).
strikemove1(Pos, NewPos, RestPieces) :-
strikemove(Pos, TempPos, RestPieces),
strikemove1(TempPos, NewPos, RestPieces).
% White strike moves:
strikemove([White,Black,white],[[X3/Y3|RestWhite],RestBlack,white], RestPieces) :-
select(X1/Y1, White, RestWhite),
X2 is X1 + 1,
Y2 is Y1 + 1,
X3 is X2 + 1,
Y3 is Y2 + 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, Black, RestBlack),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, White),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,white],[[X3/Y3|RestWhite],RestBlack,white], RestPieces) :-
select(X1/Y1, White, RestWhite),
X2 is X1 + 1,
Y2 is Y1 - 1,
X3 is X2 + 1,
Y3 is Y2 - 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, Black, RestBlack),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, White),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,white],[[X3/Y3|RestWhite],RestBlack,white], RestPieces) :-
select(X1/Y1, White, RestWhite),
X2 is X1 - 1,
Y2 is Y1 + 1,
X3 is X2 - 1,
Y3 is Y2 + 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, Black, RestBlack),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, White),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,white],[[X3/Y3|RestWhite],RestBlack,white], RestPieces) :-
select(X1/Y1, White, RestWhite),
X2 is X1 - 1,
Y2 is Y1 - 1,
X3 is X2 - 1,
Y3 is Y2 - 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, Black, RestBlack),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, White),
\+ member(X3/Y3, RestPieces).
% Black strike moves:
strikemove([White,Black,black],[RestWhite,[X3/Y3|RestBlack],black], RestPieces) :-
select(X1/Y1, Black, RestBlack),
X2 is X1 + 1,
Y2 is Y1 + 1,
X3 is X2 + 1,
Y3 is Y2 + 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, White, RestWhite),
\+ member(X3/Y3, White),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,black],[RestWhite,[X3/Y3|RestBlack],black], RestPieces) :-
select(X1/Y1, Black, RestBlack),
X2 is X1 + 1,
Y2 is Y1 - 1,
X3 is X2 + 1,
Y3 is Y2 - 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, White, RestWhite),
\+ member(X3/Y3, White),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,black],[RestWhite,[X3/Y3|RestBlack],black], RestPieces) :-
select(X1/Y1, Black, RestBlack),
X2 is X1 - 1,
Y2 is Y1 + 1,
X3 is X2 - 1,
Y3 is Y2 + 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, White, RestWhite),
\+ member(X3/Y3, White),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, RestPieces).
strikemove([White,Black,black],[RestWhite,[X3/Y3|RestBlack],black], RestPieces) :-
select(X1/Y1, Black, RestBlack),
X2 is X1 - 1,
Y2 is Y1 - 1,
X3 is X2 - 1,
Y3 is Y2 - 1,
X2 >= 0 , X2 =< 9,
X3 >= 0 , X3 =< 9,
Y2 >= 0 , Y2 =< 9,
Y3 >= 0 , Y3 =< 9,
select(X2/Y2, White, RestWhite),
\+ member(X3/Y3, White),
\+ member(X3/Y3, Black),
\+ member(X3/Y3, RestPieces).
% White normal move:
normalmove([White,Black,white], [[NewX/NewY|Rest],Black,black]):-
select(X/Y,White,Rest),
((NewX is X + 1,NewX =< 9);
(NewX is X - 1, NewX >= 0)),
NewY is Y + 1,
NewY =< 9,
\+ member(NewX/NewY,Black),
\+ member(NewX/NewY,White).
% Black normal move:
normalmove([White,Black,black], [White,[NewX/NewY|Rest],white]):-
select(X/Y,Black,Rest),
((NewX is X + 1,NewX =< 9);
(NewX is X - 1, NewX >= 0)),
NewY is Y - 1,
\+ member(NewX/NewY,Black),
\+ member(NewX/NewY,White).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% End of Move predicates. %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* makeBoard.pl
* Function: to draw a checkers board from state.
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 26-06-2006
*/
% counter needed for sorting
init :- retractall(counter(_)),
assert(counter(9)).
countup :-
counter(Count),
retractall(counter(Count)),
Newcount is Count - 1,
assert(counter(Newcount)).
% wrapper
makeBoard([White,Black,_]):-
init,
makestate(White,State1,'W'),
makestate(Black,State2,'B'),
append(State1,State2,State),
sorter(State,Sorted),
draw(Sorted).
% convert the state to make it suiteble for writing
makestate(StateIn,StateOut,Side):-
makestate(StateIn,[],StateOut,Side).
makestate([],X,X,_).
makestate([Head|Tail],List,Out,Side):-
makestate(Tail,[Head/Side|List],Out,Side).
% ***************
% * Sorting *
% ***************
% wrapper
sorter(In,Out):-
sorting(In,[],Out).
sorting([],X,X).
sorting(List,Out,End):-
counter(Count),
getRow(Count,List,[],Row,Rest),
sort2(Row,SortedRow),
append(Out,SortedRow,NewOut),
countup,
sorting(Rest,NewOut,End).
% select a row from state
getRow(Count,List,Row,EndRow,Rest):-
select(X/Count/Side, List,Rest2),
getRow(Count,Rest2,[X/Count/Side|Row],EndRow,Rest).
getRow(_,List,Row,Row,List).
% Bouble sort (by Bratko)
sort2(List,Out):-
swap(List,List1),!,
sort2(List1,Out).
sort2(X,X).
swap([X1/Y1/Side1,X2/Y2/Side2|Rest],[X2/Y2/Side2,X1/Y1/Side1|Rest]):-
X1 > X2.
swap([Z|Rest],[Z|Rest1]):-
swap(Rest,Rest1).
% printing of the sorded state
draw(State):-
nl,
write('9 '),
draw(State,0,9).
draw(_,end,end):-
nl,
write(' 0123456789').
draw(State,X,Y):-
member(X/Y/Side,State),
write(Side),
checkLine(X,Y,NewX,NewY),
draw(State,NewX,NewY).
draw(State,X,Y):-
write('.'),
checkLine(X,Y,NewX,NewY),
draw(State,NewX,NewY).
checkLine(X,Y,NewX,Y):-
Y >= 0,
X =< 8,
NewX is X + 1.
checkLine(X,Y,0,NewY):-
Y >= 1,
X = 9,
nl,
NewY is Y - 1,
write(NewY),
write(' ').
checkLine(X,Y,end,end):-
Y = 0,
X = 9.
/* toUMIRTX.pl
* Function: write a file containing moves for the robot and pieces to be moved
* to garbage.
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 28-06-2006
*/
state1([[3/3, 5/5, 7/5], [8/6], black]).
state2([[3/3], [4/6], white]).
toUMIRTX([White,Black1,_], [White,Black2,_]):-
% a non-strike move
select(X1/Y1,Black1,_),
\+ member(X1/Y1, Black2),
select(X2/Y2,Black2,_),
\+ member(X2/Y2,Black1),
tell('moves.txt'),
write(X1/Y1), write(';'), write(X2/Y2),
told.
toUMIRTX([White1,Black1,_], [White2,Black2,_]):-
% strike move
append(White2,Strikes,White1),
select(X1/Y1,Black1,_),
\+ member(X1/Y1, Black2),
select(X2/Y2,Black2,_),
\+ member(X2/Y2,Black1),
append([X1/Y1;X2/Y2],Strikes,Writes),
tell('moves.txt'),
write_to_file(Writes),
told.
write_to_file([]).
write_to_file([Head|Tail]) :-
write(Head),
write(','),
write_to_file(Tail).
/* testing.pl
* Function: testing MiniMax and Alpha-Beta Minimax efficiency.
*
* Authors: Tom Lauriks, 0350621, tlauriks@gmail.com
* Carsten van Weelden, 0518824, cweelden@science.uva.nl
*
* Date: 29-06-2006
*/
% Some states used in testing.
teststate1([[8/4, 0/0, 0/2, 1/1, 1/3, 2/0, 2/2, 3/1, 3/3, 4/0, 4/2, 5/1, 5/3, 6/0, 6/2, 7/1, 7/3, 8/0, 8/2, 9/1], [0/8, 0/6, 1/9, 1/7, 2/8, 2/6, 3/9, 3/7, 4/8, 4/6, 5/9, 5/7, 6/8, 6/6, 7/9, 7/7, 8/8, 8/6, 9/9, 9/7], black]).
teststate2([[3/3, 5/5, 7/5],[6/6, 8/6],black]).
teststate3([[1/0, 1/2, 2/1, 2/3, 3/2, 2/5], [3/6, 2/7, 4/7, 3/8,5/8,6/9, 5/6], black]).
teststate4([[0/4,1/1,2/0,2/2,2/4,3/1,3/3,4/0,4/2,5/1,5/3,6/0,6/2,6/4,7/1,8/0,8/4,9/1,9/3],
[0/8,0/6,1/7,1/5,2/8,2/6,3/9,3/7,4/8,4/6,5/9,5/7,6/8,6/6,7/7,8/8,8/6,9/9,9/7],black]).
teststate5([[3/3, 5/5],[6/6],black]).
teststate6([[1/1],[2/2,4/4,6/6],white]).
testingM(8).
testingM(StartDepth) :-
write('Testing at depth: '),
write(StartDepth),nl,
time(test(_,_,StartDepth)),
NewD is StartDepth + 1,
testingM(NewD).
testingAB(8).
testingAB(StartDepth) :-
write('Testing at depth: '),
write(StartDepth),nl,
time(test(_,_,-100,100,StartDepth)),
NewD is StartDepth + 1,
testingAB(NewD).
test(BestSucc, Val,A,B,MMDepth) :-
retractall(stateCounterAB(_)),
assert(stateCounterAB(0)),
teststate3(Pos),
alphabeta(Pos,A,B,BestSucc,Val, MMDepth),
stateCounterAB(X),
write('State counter: '),
write(X).
test(BestSucc, Val,MMDepth) :-
retractall(stateCounterM(_)),
assert(stateCounterM(0)),
teststate3(Pos),
minimax(Pos,BestSucc,Val, MMDepth),
stateCounterM(X),
write('State counter: '),
write(X).
|
 |