algorithm for tic-tac-toe
ZXNet echo conference «code.zx»
Press RESET immediately, All!
Someone on CC told me that there are difficulties with the subject...
This program doesn't play too badly, but not too well either,
I don’t know how to do it better.
You can try to run it on the Spectrum in hi-soft pascal, if not
it will work out
then CP/M has Borland Pascal. In hi-soft you can convert in the shell
zxword 2.5.
I tried to rewrite this on ASMA, but gave up... In the next letter there will be
asm.
> --------- begin of gomoku.pas -----------------------------------------
uses crt;
const edge = 0; us = 1; them = 2; none = 3;
gridsize = 15;
maxmoves = 200;
alphabet = 96;
null = ';
type squares = edge..none;
smallint = byte;{0..gridsize}
line = array[0..9] of squares;
var
grid : array [1..gridsize,1..gridsize] of squares;
name : array [squares] of char;
icol, irow : array [1..4] of -1..1;
play : array [1..maxmoves] of record
rowfield,colfield : smallint;
end;
v, vals : array [1..4] of integer;
i, j, r, c : byte; {x- and y-coord}
onboard : set of smallint;
move : word;
endgame: squares;
yourturn : boolean;
topvalue: integer;
response: char;
procedure tell;
var y : char;
begin
writeln('Welcome to Go-Moku!');
writeln;
end;procedure init;
var m : real;
begin
name[none] := '·';
name[us] := 'O';
name[them] := '*';
name[edge] := '-';
irow[1] := 0; icol[1] := -1; {left}
irow[2] := -1; icol[2] := -1; {up-left}
irow[3] := -1; icol[3] := 0; {up}
irow[4] := -1; icol[4] := 1; {up-right}
onboard := [1..gridsize];
end;
procedure whofirst(var youfirst : boolean);
var no : char;
begin
writeln;
write('do you want to move first (n=no) ?');
readln(no);
youfirst := upcase(no) <> 'N';
end;
procedure slab(r,c,compass: smallint; var l : line);
{forming a line of 10 cells with a center at R, C and a guide
vector COMPASS}
var i, j : integer;
k : smallint;
begin
i := r; j := c;
for k := 4 downto 0 do {top left of ruler}
begin
inc(i, irow[compass]);
inc(j, icol[compass]);
if (i in onboard) and (j in onboard) then
l[k] := grid[i,j] {end of the ruler within the board}
else
l[k] := edge; {end of the ruler outside the board}
end;
i := r; j := c;
for k := 5 to 9 do {bottom right of ruler}
begin
dec(i, irow[compass]);
dec(j, icol[compass]);
if (i in onboard) and (j in onboard) then l[k] := grid[i,j]
else l[k] := edge;
end;
end;
procedure remember(i, j : smallint);
beginplay[move].rowfield := i;
play[move].colfield := j;
end;
procedure dumpgame(m : word);
var n : word;
begin
for n := 1 to m do with play[n] do
begin
write(chr(colfield+alphabet),rowfield:2);
if odd(n) then write(' ')
else writeln;
end;
end;
function foursome (var span : line; self : squares) : integer;
{calculation of weight function}
var best : integer;
near : boolean;
i, s, firstone, last, gaps : word;
friendly : set of squares;
begin
best := 0; friendly := [none, self];
for i := 1 to 5 do {five potential fours}
begin
firstone := 0; last := 0; {final positions}
gaps := 0; near := false;
s := i; {starting position}
while (gaps < 4) and (s < i+4) do
begin
if span[s] = none then inc(gaps) {counting gaps in the ruler}
else if span[s] = self then
begin
last := s;
if firstone = 0 then firstone := s;
near := near or (s in [4,5]);
{neighboring chip is its own}
end
else {the line is blocked by an opponent's piece}
gaps := 4;
inc(s);
end;
{summation of weights}
s := sqr(4-gaps); {value range from 0 to 16}if (last - firstone) < (4 - gaps) then
inc(s); {plus 1 if there is no break in the line}
if near then inc(s); {plus 1 if there is a chip in the adjacent cell}
if [span[i-1], span[i+4]] <= friendly then
inc(s); {plus 1 if the ruler is not locked}
if s > best then best := s; {new max}
end;
foursome := best;
end;
function evaluate(r, c : smallint) : integer;
{calculation of the total score of the move to position R, C}
var thoughts, crosses, x : integer;
i, j, thisway : smallint;
span: line;
function max(a,b:integer):integer;
begin
if a > b then max := a
else max := b;
end;
begin
for thisway := 1 to 4 do {4th possible directions}
begin
slab(r,c,thisway,span);
thoughts := foursome(span,us) + 2; {preference to zeros}
crosses := foursome(span,them);
v[thisway] := max(noughts,crosses)-2;
end;
for i := 1 to 3 do {sorting >=}
for j := 1 to 4 - i do if v[j] < v[j+1] then
begin
x := v[j];
v[j] := v[j+1];
v[j+1] := x;
end;
{final score}
evaluate := v[1]*64 + v[2]*16 + v[3]*4 + v[4];
end;
procedure makemove(var r,c : smallint);
{search for the best move}
var bestcol, bestrow : smallint;
q,w : smallint;
e: integer;
begin
q := r; w := c;
topvalue := 0;
bestcol := 0; bestrow := 0;
if move = 1 then {first move - to the central cell}
begin bestrow := gridsize div 2 + 1;
bestcol := bestrow;
end
else
for q := 1 to gridsize do
for w := 1 to gridsize do
if grid[q,w] = none then
begin
e := evaluate(q,w);
if (e > topvalue) or (bestrow = 0) then
begin
topvalue := e;
bestcol := w;
bestrow := q;
vals := v;
end;
end;
c := bestcol;
r := bestrow;
end;
procedure getmove(var i,j : smallint);
var c : char;
ok : boolean;
cols : integer;
begin
writeln;
repeat
write('where do you move ?');
read(c);
readln(i);
cols := ord(c) - alphabet;
ok := (i in onboard) and (cols in onboard);
if not ok then writeln('no such position as