program sudoku7 (input, output);
{Vereinbarungen}
type
menge = set of 1..10;
var
i, j, k, l, z : 1..10;
n : 1..100;
bh : array [1..9] of integer;
vm : array [1..99, 1..3] of integer;
qs, qk, kq, ks, kz : array [1..9, 1..9] of integer;
m1, m2, m3 : menge;
begin
{Allgemeine Vorbesetzungen}
m1 := [1, 2, 3];
m2 := [4, 5, 6];
m3 := [7, 8, 9];
for i := 1 to 9 do
for j := 1 to 9 do
begin
qs[i, j] := 0;
kq[i, j] := 0;
kz[i, j] := 0;
ks[i, j] := 0;
if (i in m1) and (j in m1) then qk[i, j] := 1;
if (i in m1) and (j in m2) then qk[i, j] := 2;
if (i in m1) and (j in m3) then qk[i, j] := 3;
if (i in m2) and (j in m1) then qk[i, j] := 4;
if (i in m2) and (j in m2) then qk[i, j] := 5;
if (i in m2) and (j in m3) then qk[i, j] := 6;
if (i in m3) and (j in m1) then qk[i, j] := 7;
if (i in m3) and (j in m2) then qk[i, j] := 8;
if (i in m3) and (j in m3) then qk[i, j] := 9;
end;
{Besetzung von QS samt Buchhaltung
n zählt die besetzten Felder,
i ist die Zeilennummer in QS,
j ist die Spaltennummer in QS,
k ist die Kleinqudratnummer in QS,
z ist das Zeichen in QS[i,j]}
{Besetzung der ersten 9 Zeichen in Zeile 1 von QS}
for n := 1 to 9 do
begin
i := 1;
j := n;
z := n;
qs[i, j] := z;
k := qk[i, j];
kz[i, z] := 1;
ks[j, z] := 1;
kq[k, z] := 1;
vm[n, 1] := z;
vm[n, 2] := i;
vm[n, 3] := j;
bh[z] := 1;
end;
{Beginn der iterativen Besetzung von QS ab Zeile 2}
i := 2;
j := 1;
k := qk[i, j];
z := 1;
n := 9;
while n < 100 do
begin {n}
while (kz[i, z] + ks[j, z] + kq[k, z]) > 0 do
z := z + 1;
if z < 10 then
begin {Besetzen von QS[i,j] mit z samt Buchhaltung}
qs[i, j] := z;
k := qk[i, j];
kz[i, z] := 1;
ks[j, z] := 1;
kq[k, z] := 1;
bh[z] := bh[z] + 1;
n := n + 1;
vm[n, 1] := z;
vm[n, 2] := i;
vm[n, 3] := j;
if j < 9 then
j := j + 1
else
begin
i := i + 1;
j := 1;
z := 1;
end;
k := qk[i, j];
end {Besetzen von QS[i,j] mit z samt Buchhaltung}
else
begin {Frühere Besetzung ändern}
n := n - 1;
z := vm[n, 1];
i := vm[n, 2];
j := vm[n, 3];
bh[z] := bh[z] - 1;
qs[i, j] := 0;
k := qk[i, j];
kz[i, z] := 0;
ks[j, z] := 0;
kq[k, z] := 0;
if z = 9 then
begin
n := n - 1;
z := vm[n, 1];
i := vm[n, 2];
j := vm[n, 3];
end
else
z := z + 1;
end; {Frühere Besetzung ändern}
end {n};
for i := 1 to 9 do
begin
for j := 1 to 9 do
begin
Write(qs[i, j], ' ');
if j in [3, 6] then
Write(' ');
end;
writeln;
if i in [3, 6] then
writeln;
end;
Read(i);
end.