Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 2 KB
program opjdsa;
var t:array[1..9,1..9]of byte;
v:array[1..9,1..9,1..9]of boolean;
f:text;
i,j,k:integer;
procedure beir(x,y:byte);
var a,b,i,j:integer;
begin
for i:=1 to 9 do v[i,y,t[x,y]]:=false;
for i:=1 to 9 do v[x,i,t[x,y]]:=false;
a:=((x-1) div 3)*3+1;
b:=((y-1) div 3)*3+1;
for i:=a to a+2 do for j:=b to b+2 do v[i,j,t[x,y]]:=false;
end;
function kitolt:boolean;
var i,j,k,ss,sd,i2,j2,sd2:integer;
b:boolean;
begin
b:=false;
for i:=1 to 9 do for j:=1 to 9 do
begin
if t[i,j]=0 then
begin
ss:=0; k:=1;
while (ss<2)and(k<=9) do
begin
if v[i,j,k] then begin ss:=ss+1; sd:=k; end;
k:=k+1;
end;
if ss<=1 then
begin
t[i,j]:=sd;
beir(i,j);
b:=true;
end;
end;
end;
for i:=1 to 9 do
begin
for j:=1 to 9 do
begin
ss:=0; k:=1;
while (ss<2)and(k<=9) do
begin
if (v[i,k,j])and(t[i,k]=0) then begin ss:=ss+1; sd:=k; end;
k:=k+1;
end;
if ss=1 then
begin
t[i,sd]:=j;
beir(i,sd);
b:=true;
end;
end;
end;
for i:=1 to 9 do
begin
for j:=1 to 9 do
begin
ss:=0; k:=1;
while (ss<2)and(k<=9) do
begin
if (v[k,i,j])and(t[k,i]=0) then begin ss:=ss+1; sd:=k; end;
k:=k+1;
end;
if ss=1 then
begin
t[sd,i]:=j;
beir(sd,i);
b:=true;
end;
end;
end;
for i2:=0 to 2 do
for j2:=0 to 2 do
for k:=1 to 9 do
begin
ss:=0;
for i:=i2*3+1 to i2*3+3 do
for j:=j2*3+1 to j2*3+3 do
if (t[i,j]=0)and(v[i,j,k]) then
begin
ss:=ss+1;
sd:=i; sd2:=j;
end;
if ss=1 then
begin
t[sd,sd2]:=k;
beir(sd,sd2);
b:=true;
end;
end;
kitolt:=b;
end;
begin
assign(f,'sudoku1.be');
reset(f);
for i:=1 to 9 do readln(f,t[i,1],t[i,2],t[i,3],t[i,4],t[i,5],t[i,6],t[i,7],t[i,8],t[i,9]);
close(f);
for i:=1 to 9 do for j:= 1 to 9 do for k:=1 to 9 do v[i,j,k]:=true;
for i:=1 to 9 do for j:=1 to 9 do if t[i,j]>0 then beir(i,j);
while kitolt do;
assign(f,'sudoku1.ki');
rewrite(f);
for i:=1 to 9 do begin for j:=1 to 9 do write(f,t[i,j],' ');writeln(f);end;
close(f);
end.
