Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.05.2017, 15:50   #1
tutejshy
Форумчанин
 
Регистрация: 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 в той же папке
tutejshy вне форума Ответить с цитированием
Старый 16.05.2017, 17:22   #2
tutejshy
Форумчанин
 
Регистрация: 13.05.2017
Сообщений: 100
По умолчанию

Все, проблема решена самостоятельно!
tutejshy вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
C# Помогите найти проблему Dvoika C# (си шарп) 2 06.05.2016 10:59
Помогите решить проблему: Найти из заданного пользователём массива самое большое число (размер массива вводит пользователь) Kokosaki Паскаль, Turbo Pascal, PascalABC.NET 16 29.12.2015 21:21
Помогите найти проблему вкоде Fly090 Паскаль, Turbo Pascal, PascalABC.NET 3 21.12.2014 10:56
помогите найти проблему в коде mato Помощь студентам 3 05.06.2009 22:58