Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
program sudoku;
uses crt;
type BoardArray = array[0..8,0..8] of integer;
var BD, BD2 :BoardArray; cx, cy :integer;
procedure DisplayBoard(BD :BoardArray);
var i, j :integer;
begin
writeln('+-------+-------+-------+');
for i := 0 to 8 do
begin
write('|');
for j := 0 to 8 do
begin
if BD[i,j] <> 0 then write(BD[i,j] :2)
else write(' ');
if j mod 3 = 2 then write(' |');
end;
writeln;
if i mod 3 = 2 then writeln('+-------+-------+-------+')
end
end;
procedure Initialize(var BD :BoardArray);
var i, j, k, temp :integer;
begin
for i := 0 to 8 do
for j := 0 to 8 do
BD[i,j] := 0;
for k := 0 to 8 do
BD[0,k] := k + 1;
for k := 1 to 1000 do
begin
j := random(9);
temp := BD[0,1];
BD[0,1] := BD[0,j];
BD[0,j] := temp
end
end;
function ValidFill(BD :BoardArray; p, q, x :integer) :boolean;
var i, j :integer; flag :boolean;
begin
flag := TRUE;
for i := 0 to 8 do
flag := flag and (BD[i,q] <> x);
for j := 0 to 8 do
flag := flag and (BD[p,j] <> x);
for i := p div 3 * 3 to (p div 3 + 1) * 3 - 1 do
for j := q div 3 * 3 to (q div 3 + 1) * 3 - 1 do
flag := flag and (BD[i,j] <> x);
ValidFill := flag
end;
function CompareBoard(BD1, BD2 :BoardArray) :boolean;
var flag :boolean; i, j :integer;
begin
flag := TRUE;
for i := 0 to 8 do
for j := 0 to 8 do
flag := flag and (BD1[i,j] = BD2[i,j]);
CompareBoard := flag
end;
procedure BackwardFill(var BD :BoardArray; p, q, x :integer);
var temp, i, j :integer;
begin
if x < 10 then
begin
if ValidFill(BD,p,q,x) then
begin
BD[p,q] := x;
if (p < 8) or (q < 8) then BackwardFill(BD,p + (q + 1) div 9,(q + 1) mod 9,1);
end
else BackwardFill(BD,p,q,x + 1)
end
else
begin
i := p - (9 - q) div 9;
j := (q + 8) mod 9;
temp := BD[i,j];
BD[i,j] := 0;
BackwardFill(BD,i,j,temp + 1)
end
end;
procedure BackwardFillv2(BD2 :BoardArray; var BD3 :BoardArray; p, q, x :integer);
var temp :integer;
begin
if x < 10 then
begin
if ValidFill(BD3,p,q,x) then
begin
BD3[p,q] := x;
repeat
p := p - (9 - q) div 9;
q := (q + 8) mod 9
until (p < 0) or (BD3[p,q] = 0);
if p >= 0 then BackwardFillv2(BD2,BD3,p,q,1)
end
else BackwardFillv2(BD2,BD3,p,q,x + 1);
end
else
begin
repeat
p := p + (q + 1) div 9;
q := (q + 1) mod 9
until (p > 8) or (BD2[p,q] = 0);
if p <= 8 then
begin
temp := BD3[p,q];
BD3[p,q] := 0;
BackwardFillv2(BD2,BD3,p,q,temp + 1);
end
end;
end;
procedure GenerateBoard(var BD :BoardArray);
var BD2, BD3 :BoardArray; i, j, p, q, r, s, x, temp, count, empty, diff :integer;
begin
randomize;
repeat
clrscr;
writeln('Please choose the difficulty: ');
writeln('1. Easy');
writeln('2. Medium');
writeln('3. Difficult');
write('Enter your choice: '); readln(diff);
writeln;
case diff of
1: writeln('You have chosen Easy. Pree <Enter> to start the game.');
2: writeln('You have chosen Medium. Pree <Enter> to start the game.');
3: writeln('You have chosen Difficult. Pree <Enter> to start the game.')
end
until diff in [1..3];
readln;
clrscr;
diff := diff * 6 + random(7) + 27;
Initialize(BD);
BackwardFill(BD,1,0,1);
BD2 := BD;
count := 0;
empty := 0;
repeat
temp := random(81 - count) + 1;
count := count + 1;
r := -1;
s := 8;
repeat
repeat
r := r + (s + 1) div 9;
s := (s + 1) mod 9
until BD2[r,s] <> 0;
temp := temp - 1
until temp = 0;
temp := BD2[r,s];
BD2[r,s] := 0;
BD3 := BD2;
for i := 0 to 8 do
for j := 0 to 8 do
if BD2[i,j] = 0 then
begin
p := i;
q := j
end;
BackwardFillv2(BD2,BD3,p,q,1);
for i := 8 downto 0 do
for j := 8 downto 0 do
if BD2[i,j] = 0 then
begin
p := i;
q := j
end;
x := BD3[p,q];
BD3[p,q] := 0;
BackwardFillv2(BD2,BD3,p,q,x + 1);
if CompareBoard(BD2,BD3) then empty := empty + 1
else BD2[r,s] := temp;
until empty = diff;
BD := BD2;
end;
procedure GetMove(var BD :BoardArray; BD2 :BoardArray; var cx, cy :integer);
var key :char; fill :boolean; x, y :integer;
begin
fill := FALSE;
repeat
x := cx div 3 * 8 + 3 + cx mod 3 * 2;
y := cy div 3 * 4 + 2 + cy mod 3;
gotoxy(x,y);
key := readkey;
case key of
#00: case ReadKey of
#72: cy := (cy + 8) mod 9;
#75: cx := (cx + 8) mod 9;
#77: cx := (cx + 1) mod 9;
#80: cy := (cy + 1) mod 9;
#83: begin
if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := 0;
write(' ');
fill := TRUE
end
end
end;
#08: begin
if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := 0;
write(' ');
fill := TRUE
end
end;
#49..#57: if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := ord(key) - 48;
write(BD[cy,cx]);
fill := TRUE
end
end;
until fill
end;
function CheckBoard(BD :BoardArray) :boolean;
var i, j :integer; count :array[1..9] of integer;
begin
exit (FALSE)
end;
begin
GenerateBoard(BD);
DisplayBoard(BD);
textcolor(11);
BD2 := BD;
cx := 0;
cy := 0;
repeat
GetMove(BD,BD2,cx,cy);
gotoxy(1,15);
until CheckBoard(BD);
gotoxy(1,15);
textcolor(7);
writeln('Congtratulation! You clear the board!');
readln
end.
Advertisements
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.
AcceptLearn more
