Tic-tac-toe: Difference between revisions

Content added Content deleted
m (syntax highlighting fixup automation)
(→‎{{header|Pascal}}: Changed the input loop lest the program accept the move 0 or a move to assigned position. In addition, formatted the code according to JEDI Code Format.)
Line 9,582: Line 9,582:
I would expect this version should compile with most Pascal variants including Delphi, but YMMR.
I would expect this version should compile with most Pascal variants including Delphi, but YMMR.


<syntaxhighlight lang="pascal">program tic(Input, Output);
<syntaxhighlight lang="pascal">program Tic(Input, Output);


type
type
Contents = (Unassigned, Human, Computer);
Contents = (Unassigned, Human, Computer);
var
var
best_i, best_j: Integer; { best solution a depth of zero in the search }
BestI, BestJ: integer; { best solution a depth of zero in the search }
b: array[0..2, 0..2] of Contents; {zero based so modulus works later}
B: array[0..2, 0..2] of Contents; {zero based so modulus works later}
player: Contents;
Player: Contents;


procedure displayBoard;
procedure DisplayBoard;
var
var
i, j: Integer;
I, J: integer;
t: array [Contents] of char;
T: array [Contents] of char;
begin
begin
t[Unassigned] := ' ';
T[Unassigned] := ' ';
t[Human] := 'O';
T[Human] := 'O';
t[Computer] := 'X';
T[Computer] := 'X';
for i := 0 to 2 do begin
for I := 0 to 2 do
for j := 0 to 2 do begin
begin
write(t[b[i][j]]);
for J := 0 to 2 do
begin
if j <> 2 then write(' | ');
end;
Write(T[B[I, J]]);
writeln();
if J <> 2 then
if i < 2 then writeln('---------');
Write(' | ');
end;
WriteLn;
if I < 2 then
WriteLn('---------');
end;
end;
writeln();
WriteLn;
writeln();
WriteLn;
end;
end;


function swapPlayer (Player: Contents): Contents;
function SwapPlayer(Player: Contents): Contents;
begin
begin
if Player = Computer then swapPlayer := Human else swapPlayer := Computer;
if Player = Computer then
SwapPlayer := Human
end;
else
SwapPlayer := Computer;
end;


function checkWinner: Contents;
function CheckWinner: Contents;
var
var
i: Integer;
I: integer;
begin
begin
checkWinner := Unassigned; (* no winner yet *)
CheckWinner := Unassigned; { no winner yet }
for i := 0 to 2 do begin
for I := 0 to 2 do
begin
(* first horizontal solution *)
{ first horizontal solution }
if ((checkWinner = Unassigned) and (b[i][0] <> Unassigned)) and ((b[i][1] = b[i][0]) and (b[i][2] = b[i][0])) then
if (CheckWinner = Unassigned) and (B[I, 0] <> Unassigned) and
checkWinner := b[i][0]
(B[I, 1] = B[I, 0]) and (B[I, 2] = B[I, 0]) then
else
(* now vertical solution *)
CheckWinner := B[I, 0]
else
if ((checkWinner = Unassigned) and (b[0][i] <> Unassigned)) and ((b[1][i] = b[0][i]) and (b[2][i] = b[0][i])) then
{ now vertical solution }
checkWinner := b[0][i];
if (CheckWinner = Unassigned) and (B[0, I] <> Unassigned) and
end; (* now check the paths of the two cross line slants that share the middle position *)
if (checkWinner = Unassigned) and (b[1][1] <> Unassigned) then begin
(B[1, I] = B[0, I]) and (B[2, I] = B[0, I]) then
CheckWinner := B[0, I];
if ((b[1][1] = b[0][0]) and (b[2][2] = b[0][0])) then checkWinner := b[0][0]
end;
else if ((b[1][1] = b[2][0]) and (b[0][2] = b[1][1])) then checkWinner := b[1][1];
{ now check the paths of the two cross line slants that share the middle position }
if (CheckWinner = Unassigned) and (B[1, 1] <> Unassigned) then
begin
if (B[1, 1] = B[0, 0]) and (B[2, 2] = B[0, 0]) then
CheckWinner := B[0, 0]
else if (B[1, 1] = B[2, 0]) and (B[0, 2] = B[1, 1]) then
CheckWinner := B[1, 1];
end;
end;
end;
end;


{ Basic strategy test - is this te best solution we have seen }
{ Basic strategy test - is this te best solution we have seen }
function saveBest(CurScore, CurBest: Contents) : boolean;
function SaveBest(CurScore, CurBest: Contents): boolean;
begin
begin
if CurScore = CurBest then saveBest := false
if CurScore = CurBest then
SaveBest := False
else if (Curscore = Unassigned) and (CurBest = Human) then saveBest := false
else if (Curscore = Computer) and ((CurBest = Unassigned) or (CurBest = Human)) then saveBest := false
else if (CurScore = Unassigned) and (CurBest = Human) then
else saveBest := true;
SaveBest := False
else if (CurScore = Computer) and ((CurBest = Unassigned) or
end;
(CurBest = Human)) then
SaveBest := False
else
SaveBest := True;
end;




{ Basic strategy - recursive depth first serach of possible moves
{ Basic strategy - recursive depth first search of possible moves
if computer can win save it, otherwise block if need be, else do deeper.
if computer can win save it, otherwise block if need be, else do deeper.
At each level modify the board for the next call, but clean up as go back up,
At each level modify the board for the next call, but clean up as go back up,
by remembering the modified position on the call stack. }
by remembering the modified position on the call stack. }
function test_move (val: Contents; depth: Integer): Contents;
function TestMove(Val: Contents; Depth: integer): Contents;
var
var
i, j: Integer;
I, J: integer;
score, best, changed: Contents;
Score, Best, Changed: Contents;
begin
begin
best := Computer;
Best := Computer;
changed := Unassigned;
Changed := Unassigned;
score := checkWinner();
Score := CheckWinner;
if score <> Unassigned then begin
if Score <> Unassigned then
begin
if score = val then test_move := Human else test_move := Computer;
if Score = Val then
end else begin
for i := 0 to 2 do for j := 0 to 2 do begin
TestMove := Human
else
if b[i][j] = Unassigned then begin
changed := val;
TestMove := Computer;
end
b[i][j] := val; (* the value for now and try wioth the other player *)
else
score := test_move(swapPlayer(val), depth + 1);
begin
if (score <> Unassigned) then score := swapPlayer(score);
b[i][j] := Unassigned;
for I := 0 to 2 do
if saveBest(score, best) then begin
for J := 0 to 2 do
begin
if depth = 0 then begin { top level, so remember actual position }
best_i := i;
if B[I, J] = Unassigned then
best_j := j;
begin
Changed := Val;
B[I, J] := Val;
{ the value for now and try wioth the other player }
Score := TestMove(SwapPlayer(Val), Depth + 1);
if Score <> Unassigned then
Score := SwapPlayer(Score);
B[I, J] := Unassigned;
if SaveBest(Score, Best) then
begin
if Depth = 0 then
begin { top level, so remember actual position }
BestI := I;
BestJ := J;
end;
Best := Score;
end;
end;
best := score;
end;
end;
end;
end;
if Changed <> Unassigned then
end;
TestMove := Best
if (changed <> Unassigned) then test_move := best else test_move := Unassigned;
else
TestMove := Unassigned;
end;
end;
end;
end;


function playGame(whom:Contents): string;
function PlayGame(Whom: Contents): string;
var
var
i, j, k, move: Integer;
I, J, K, Move: integer;
win: Contents;
Win: Contents;
begin
begin
win := Unassigned;
Win := Unassigned;
for i := 0 to 2 do for j := 0 to 2 do b[i][j] := Unassigned;
for I := 0 to 2 do
for J := 0 to 2 do

B[I, J] := Unassigned;
writeln('The board positions are numbered as follows:');
writeln('1 | 2 | 3');
WriteLn('The board positions are numbered as follows:');
writeln('---------');
WriteLn('1 | 2 | 3');
writeln('4 | 5 | 6');
WriteLn('---------');
writeln('---------');
WriteLn('4 | 5 | 6');
writeln('7 | 8 | 9');
WriteLn('---------');
writeln('You have O, I have X.');
WriteLn('7 | 8 | 9');
WriteLn('You have O, I have X.');
writeln();
WriteLn;

k := 1;
K := 1;
repeat {rather a for loop but can not have two actions or early termination in Pascal}
repeat {rather a for loop but can not have two actions or early termination in Pascal}
if Whom = Human then
begin
repeat
Write('Your move: ');
ReadLn(Move);
if (Move < 1) or (Move > 9) then
WriteLn('Opps: enter a number between 1 - 9.');
Dec(Move);
{humans do 1 -9, but the computer wants 0-8 for modulus to work}
I := Move div 3; { convert from range to corridinated of the array }
J := Move mod 3;
if B[I, J] <> Unassigned then
WriteLn('Opps: move ', Move + 1, ' was already done.')
until (Move >= 0) and (Move <= 8) and (B[I, J] = Unassigned);
B[I, J] := Human;
end;
if Whom = Computer then
begin
{ randomize if computer opens, so its not always the same game }
if K = 1 then
begin
begin
if whom = Human then begin
BestI := Random(3);
repeat begin
BestJ := Random(3);
write('Your move: ');
end
readln(move);
else
Win := TestMove(Computer, 0);
if (move < 1) or (move > 9) then writeln('Opps: enter a number between 1 - 9')
B[BestI, BestJ] := Computer;
else move := pred(move); {humans do 1 -9, but the computer wants 0-8 for modulus to work}
end until ((move >= 0) and (move <= 8));
WriteLn('My move: ', BestI * 3 + BestJ + 1);
end;
i := move div 3; { convert from range to corridinated of the array }
j := move mod 3;
DisplayBoard;
Win := CheckWinner;
if b[i][j] = Unassigned then b[i][j] := Human;
end;
if Win <> Unassigned then
if whom = Computer then begin
begin
if Win = Human then
(* randomize if computer opens, so its not always the same game *)
if k = 1 then begin
PlayGame := 'You win.'
else
best_i := random(3); {Pascal random returns positive integers from 0 to func arg}
best_j := random(3);
PlayGame := 'I win.';
end else
end
else
win := test_move(Computer, 0);
begin
b[best_i][best_j] := Computer;
writeln('My move: ', best_i * 3 + best_j + 1);
Inc(K); { "for" loop counter actions }
end;
Whom := SwapPlayer(Whom);
end;

displayBoard();
until (Win <> Unassigned) or (K > 9);
if Win = Unassigned then
win := checkWinner();
PlayGame := 'A draw.';
if win <> Unassigned then begin
end;
if win = Human then playGame := 'You win.' else playGame := 'I win.';
end else begin
k := succ(k); { "for" loop counter actions }
whom := swapPlayer(whom);
end;
end;
until (win <> Unassigned) or (k > 9);
if win = Unassigned then playGame := 'A draw.';
end;


begin
begin
Randomize;
randomize();
player := Human;
Player := Human;
while (true) do
while True do
begin
begin
writeln(playGame(player));
WriteLn(PlayGame(Player));
writeln();
WriteLn;
player := swapPlayer(player);
Player := SwapPlayer(Player);
end
end
end.</syntaxhighlight>
end.</syntaxhighlight>


Retrieved from "https://rosettacode.org/wiki/Tic-tac-toe"