Форумчанин
Регистрация: 13.05.2017
Сообщений: 100
|
Помогите найти проблему
Написал прогу для решения судоку (для тех судоку, что имеют только одно решение)
Код:
uses crt;
type tarr=array [1..9,1..9] of integer;
var i,j,w,v,l:integer;
z:integer;
sudoku0:tarr;
psblline:array [1..9,0..9] of integer;
psblcolum:array [0..9,1..9] of integer;
solution,reversOn,rez_in_iter:boolean;
procedure vvod_from_file;
var sluga:text;
element_sud:char;
begin
assign(sluga,'sluga.text');reset(sluga);
for i:=1 to 9 do if not eof(sluga) then
for j:=1 to 10 do begin
read(sluga,element_sud);
if element_sud<>#10 then begin
if element_sud=#32 then z:=0 else z:=ord(element_sud)-48;
sudoku0[i,j]:=z end else break end else exit end;
procedure vyvod(var a:tarr);
var kolor:boolean;
begin
textbackground(white);textcolor(black);
window(1,1,21,1);write(#32:2);
for i:=1 to 9 do write(i:2);
window(1,2,2,11);
for i:=65 to 73 do write(chr(i):2);
textcolor(white);
kolor:=true;
for i:=0 to 2 do
for j:=0 to 2 do begin
window(3+6*j,2+3*i,8+6*j,5+3*i);
if kolor then textbackground(green) else textbackground(blue);
kolor:=not kolor;
for w:=1+3*i to 3+3*i do
for v:=1+3*j to 3+3*j do if a[w,v]<>0 then write(a[w,v]:2) else write(#32:2) end;
textbackground(black) end;
procedure clr;
begin window(1,1,80,24);clrscr end;
procedure vvod_psbl_numbers;
begin
for i:=1to 9 do begin psblline[i,0]:=9;psblcolum[0,i]:=9;
for j:=1 to 9 do begin psblline[i,j]:=j;psblcolum[j,i]:=j end;
for j:=1 to 9 do begin
if sudoku0[i,j]<>0 then
for w:=1 to psblline[i,0] do if sudoku0[i,j]=psblline[i,w] then begin psblline[i,w]:=psblline[i,psblline[i,0]];dec(psblline[i,0]);break end;
if sudoku0[j,i]<>0 then
for w:=1 to psblcolum[0,i] do if sudoku0[j,i]=psblcolum[w,i] then begin psblcolum[w,i]:=psblcolum[psblcolum[0,i],i];dec(psblcolum[0,i]);break end;end end end;
procedure revers;
var mat_of_zamena:array [1..9,0..9] of integer;
begin
for i:=1 to 9 do for j:=0 to 9 do mat_of_zamena[i,j]:=psblline[i,j];
for i:=1 to 9 do for j:=0 to 9 do psblline[i,j]:=psblcolum[j,i];
for i:=1 to 9 do for j:=0 to 9 do psblcolum[j,i]:=mat_of_zamena[i,j];
for i:=1 to 9 do for j:=1 to 9 do mat_of_zamena[i,j]:=sudoku0[i,j];
for i:=1 to 9 do for j:=1 to 9 do sudoku0[j,i]:=mat_of_zamena[i,j] end;
procedure reshenie;
var mas_of_colum,mas_of_kvadr:array [0..9] of integer;
rezult,num_line,num_colum,pok_of_sovp,krajline,krajcolum:integer;
begin
reversOn:=false;
repeat
rez_in_iter:=false;
repeat
solution:=false;
for i:=1 to 9 do begin
mas_of_colum[0]:=0;
for j:=1 to 9 do if sudoku0[i,j]=0 then
begin inc(mas_of_colum[0]);mas_of_colum[mas_of_colum[0]]:=j end;
for j:=1 to psblline[i,0] do begin
rezult:=0;
for w:=1 to mas_of_colum[0] do begin
mas_of_kvadr[0]:=0;
case i of
1,2,3:krajline:=1;
4,5,6:krajline:=4;
7,8,9:krajline:=7 end;
case mas_of_colum[w] of
1,2,3:krajcolum:=1;
4,5,6:krajcolum:=4;
7,8,9:krajcolum:=7 end;
for v:=krajline to krajline+2 do
for l:=krajcolum to krajcolum+2 do
if sudoku0[v,l]<>0 then begin inc(mas_of_kvadr[0]);mas_of_kvadr[mas_of_kvadr[0]]:=sudoku0[v,l] end;
pok_of_sovp:=0;
for v:=psblcolum[0,mas_of_colum[w]] downto 1 do
for l:=1 to mas_of_kvadr[0] do if psblcolum[v,mas_of_colum[w]]=mas_of_kvadr[l] then
begin z:=psblcolum[v,mas_of_colum[w]];psblcolum[v,mas_of_colum[w]]:=psblcolum[psblcolum[0,mas_of_colum[w]],mas_of_colum[w]];
psblcolum[psblcolum[0,mas_of_colum[w]],mas_of_colum[w]]:=z;dec(psblcolum[0,mas_of_colum[w]]);
mas_of_kvadr[l]:=mas_of_kvadr[mas_of_kvadr[0]];dec(mas_of_kvadr[0]);inc(pok_of_sovp);break end;
for v:=1 to psblcolum[0,mas_of_colum[w]] do if psblline[i,j]=psblcolum[v,mas_of_colum[w]] then
begin inc(rezult);num_line:=v;num_colum:=mas_of_colum[w];break end;
inc(psblcolum[0,mas_of_colum[w]],pok_of_sovp);
if rezult>1 then break end;
if rezult=1 then begin
sudoku0[i,num_colum]:=psblline[i,j];psblline[i,j]:=psblline[i,psblline[i,0]];
// psblline[i,psblline[i,0]]:=0;
dec(psblline[i,0]);
psblcolum[num_line,num_colum]:=psblcolum[psblcolum[0,num_colum],num_colum];
// psblcolum[psblcolum[0,num_colum],num_colum]:=0;
dec(psblcolum[0,num_colum]);
solution:=true;rez_in_iter:=true end;
end;
end;
until not solution;
if rez_in_iter then for i:=1 to 9 do if (psblline[i,0]<>0) then
begin revers;reversOn:=not reversOn;break end;
if not rez_in_iter and reversOn then revers;
until not rez_in_iter end;
begin
vvod_from_file;
vyvod(sudoku0);
vvod_psbl_numbers;
reshenie;
solution:=true;
for i:=1 to 9 do if psblline[i,0]<>0 then begin solution:=false;break end;
window(1,12,50,14);
if solution then write('Final solution! ') else write('This Sudoku has more than one solution. ');
clr;
vyvod(sudoku0);
readkey end.
И возникла такая проблема: программа находит решение только, если задействовать строки, в которых идет приравнивание к нулю (они помечены слешами). Но я не могу понять почему? Если эти строки не задействованы, то последние два возможных числа невозможно найти, так как в матрицах, где находятся возможные варианты, почему-то возникает ошибка.
Ошибка, кстати, возникает не всегда, а лишь иногда, когда вычеркнутых цифр довольно много. Вот ещё пример вводных данных, где возникает эта ошибка:
Код:
7
5 41
8
58
6 35
4 1 2
2 37 8 4
3 2
59 4
они должны находится в файле sluga.text в той же папке
|