|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
25.05.2011, 20:33 | #1 |
Регистрация: 26.06.2010
Сообщений: 5
|
Программа для решения Судоку
Здравствуйте, уважаемые. У меня проблемы с курсовой по технологии программирования. Пишем на Delphi 7.
Написать, собственно, надо прогу решающую судоку. Решать-то она у меня решает: воспользовалась материалами http://parsers.info/2009/03/reshaem-...hi-7-statejka/ , проблема не в этом. На форме есть выпадающий список, после нажатия на кнопку Решить, там появляются следующие строчки Исходное, Решение полностью, 1 цифра, 2 цифры, 3 цифры. Смысл в том, что если выбрать "1 цифра", то результатом будет исходное+ещё одна цифра. Эта цифра ставится в строку с самым большим числом пустых клеток, в столбец - так, чтобы с обоих сторон было примерно одинаковое (зависит от того четное кол-во пропусков или нет) число пустых клеток. С этим у меня 1 проблема: нажимаю в списке на "1 цифра", и все цифры исчезают(( никак не могу разобраться... 2 проблема заключается в "режиме проверки". Идея такая: соответствующая кнопка не активна. если все клетки заполнены, то она актина. нажимаем на неё и происходит проверка по строкам, столбцам и "малым" квадратам. Затем в лэйблах выводится сообщение "Повтор в строках: *номера строк*". Пробовала реализовать - получилась чушь)) ПОМОГИТЕ хоть чем нибудь!!!)) вот код: unit umain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TSudoku = array[1..9,1..9] of 0..9; type TForm1 = class(TForm) Button1: TButton; cmbMode: TComboBox; Button2: TButton; Button3: TButton; Button4: TButton; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); procedure EditKeyPress(Sender: TObject; var Key: Char); procedure ReadInSud; procedure Button1Click(Sender: TObject); procedure cmbModeChange(Sender: TObject); procedure sudFill(s:TSudoku); procedure FormPaint(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var v:integer; p:TPoint; s,Sud,Sp,Sudp:TSudoku; Ans:array of TSudoku; CEdits:array[1..9,1..9] of TEdit; var Form1: TForm1; cmbMode:TComboBox; implementation {$R *.dfm} //Проверка повтора в строке function sudInLine(s:TSudoku;p:TPoint;v:inte ger):boolean; var i:1..9; begin Result:=True; for i:=1 to 9 do if p.y<>i then if s[p.X,i]=v then Exit; Result:=False; end; //Проверка повтора в столбце function sudInRow(s:TSudoku;p:TPoint;v:integ er):boolean; var i:1..9; begin Result:=True; for i:=1 to 9 do if p.x<>i then if s[i,p.Y]=v then Exit; Result:=False; end; //проверка повтора в "малом" квадрате function sudInSq(s:TSudoku;p:TPoint;v:intege r):boolean; var ix,iy:0..8; lx,ly:0..8; begin lx:=0; ly:=0; if p.x in [1,2,3] then lx:=1; if p.x in [4,5,6] then lx:=4; if p.x in [7,8,9] then lx:=7; lx:=lx-1; if p.y in [1,2,3] then ly:=1; if p.y in [4,5,6] then ly:=4; if p.y in [7,8,9] then ly:=7; ly:=ly-1; Result:=True; for ix:=1 to 3 do for iy:=1 to 3 do if (p.x<>lx+ix) and (p.y<>ly+iy) then if s[lx+ix,ly+iy]=v then Exit; Result:=False; end; //Обобщение всех проверок function sudInAny(s:TSudoku;p:TPoint;v:integ er):boolean; begin Result:=sudInLine(s,p,v) or sudInRow(s,p,v) or sudInSq(s,p,v); end; //поиск пустой клетки function IsNextUnknown(s:TSudoku;var p:TPoint):boolean; var ix,iy:1..9; begin Result:=False; for ix:=1 to 9 do for iy:=1 to 9 do if s[ix,iy]=0 then begin Result:=True; p.X:=ix; p.Y:=iy; Exit; end; end; //обновление function sudMod(s:TSudoku;p:TPoint;v:integer ):TSudoku; var st:TSudoku; begin st:=s; st[p.x,p.y]:=v; Result:=st; end; // запоминание решения procedure sudAddAns(s:TSudoku); var l:integer; begin l:=Length(ans); SetLength(ans,l+1); ans[l]:=s; end; //Рекурсия function DoRec(s:TSudoku):boolean; var i:integer; p:TPoint; begin Result:=True; if IsNextUnknown(s,p) then begin // запуск рекурсии for i:=1 to 9 do if not sudInAny(s,p,i) then if DoRec(sudMod(s,p,i)) then Exit; end else begin sudAddAns(s); // сохранение результата end; if Length(ans)<>1 then //т.к. нужно только одно решение Result:=False; end; |
25.05.2011, 20:34 | #2 |
Регистрация: 26.06.2010
Сообщений: 5
|
//ввод в массив
procedure TForm1.ReadInSud; var ix,iy:integer; CEdit:TEdit; begin for iy:=1 to 9 do for ix:=1 to 9 do begin CEdit:=CEdits[ix,iy]; if CEdit.Text='' then Sud[ix,iy]:=0 else Sud[ix,iy]:=StrToInt(CEdit.Text); end; end; //проверка на валидность function IsValidSudoku(s:TSudoku):boolean; var ix,iy:integer; p:TPoint; begin for ix:=1 to 9 do for iy:=1 to 9 do begin p.X:=ix; p.Y:=iy; if s[ix,iy] <> 0 then if sudInAny(s,p,s[ix,iy]) then begin Result:=False; Exit; end; end; Result:=True; end; // создание 81-ого поля procedure TForm1.FormCreate(Sender: TObject); var ix,iy:integer; begin for iy:=1 to 9 do for ix:=1 to 9 do begin CEdits[ix,iy]:=TEdit.Create(self); with CEdits[ix,iy] do begin Parent:=self; Left:= (ix - 1) * 30 + 5; Top:= (iy - 1) * 30 + 5; Width:= 25; Color:= self.Color; MaxLength:= 1; Ctl3D:= False; OnKeyPress:=EditKeyPress; end; end; end; // автоматический переброс курсора procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char); var ci:integer; ix,iy:integer; CEdit:TEdit; begin for iy:=1 to 9 do for ix:=1 to 9 do if Sender is TEdit then if (Sender as TEdit)=CEdits[ix,iy] then CEdit:=CEdits[ix,iy]; if (Sender as TEdit)=CEdits[9,9] then Exit; if Pos(Key,'0123456789'#8) = 0 then Key:= #0; if Key <> #8 then begin ci:=CEdit.ComponentIndex; (self.Components[ci+1] as TEdit).SetFocus; end; end; // кнопка "решить" procedure TForm1.Button1Click(Sender: TObject); var kLines,maxL,i,maxLp,maxLi,w,ix,iy:i nteger; Lines:array [1..9] of 0..9; begin ans:=nil; ReadInSud; if not IsValidSudoku(sud) then begin ShowMessage('Повтор в исходном'); Exit; end; DoRec(sud); // просто копии for ix:=1 to 9 do for iy:=1 to 9 do begin Sp[ix,iy]:=S[ix,iy]; Sudp[ix,iy]:=Sud[ix,iy]; end; // сколько в каждой строке пустых клеток for ix:=1 to 9 do begin kLines:=0; for iy:=1 to 9 do if Sudp[ix,iy]=0 then kLines:=kLines+1; Lines[ix]:=kLines; end; // поиск строки с максимальным числом пустых клеток maxL:=Lines[1]; maxLi:=1; for i:=2 to 9 do if Lines[i]>maxL then begin maxL:=Lines[i]; // макс. число пустых клеток maxLi:=i; // соответствующая строка end; maxLp:=maxL div 2; // проставление 1ой цифры // строки в которых ничего не ставится for ix:=1 to 9 do if ix<>maxLi then for iy:=1 to 9 do if (Sudp[ix,iy]<>Sp[ix,iy]) then Sp[ix,iy]:=0; if (maxl*2<>maxLp) then maxLp:=maxLp+1; iy:=1; while (maxLp<>1) do begin if Sudp[maxLi,iy]=0 then maxLp:=maxLp-1; iy:=iy+1; end; w:=iy; //строка в которой проставляется цифра for iy:=1 to 9 do if iy<>w then if (Sudp[MaxLi,iy]<>Sp[maxLi,iy]) then Sp[maxLi,iy]:=0; {for ix:=1 to 9 do for iy:=1 to 9 do begin S[ix,iy]:=Sp[ix,iy]; Sudp[ix,iy]:=Sp[ix,iy]; end;} sudAddAns(Sp); cmbMode.Clear; cmbMode.Items.Add('Исходное'); cmbMode.Items.Add('Решение полностью'); for i:=1 to 1 do cmbMode.Items.Add(IntToStr(i)+' цифра'); for i:=2 to 3 do cmbMode.Items.Add(IntToStr(i)+' цифры'); cmbMode.ItemIndex:=0; end; //вывод на поле procedure TForm1.sudFill(s:TSudoku); var ix,iy:integer; begin for iy:=1 to 9 do for ix:=1 to 9 do if (S[ix,iy]=0)then CEdits[ix,iy].Text:='' else CEdits[ix,iy].Text:=IntToStr(S[ix,iy]); end; procedure TForm1.cmbModeChange(Sender: TObject); begin if cmbMode.ItemIndex = 0 then SudFill(sud) else SudFill(ans[cmbMode.ItemIndex-1]); end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Pen.Width:=3; Canvas.MoveTo(2,2); Canvas.LineTo(272,2); Canvas.LineTo(272,266); Canvas.LineTo(2,266); Canvas.LineTo(2,2); Canvas.Pen.Width:=2; Canvas.MoveTo(2,88+2); Canvas.LineTo(272,88+2); Canvas.MoveTo(2,88*2+2); Canvas.LineTo(272,88*2+2); Canvas.MoveTo(90+2,2); Canvas.LineTo(90+2,266); Canvas.MoveTo(90*2+2,2); Canvas.LineTo(90*2+2,266); end; procedure TForm1.Button3Click(Sender: TObject); begin // end; //Режим проверки procedure TForm1.Button2Click(Sender: TObject); begin // end; procedure TForm1.Button4Click(Sender: TObject); begin // end; end. Исходник: http://hdd.tomsk.ru/desk/rcbyjifv |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Алгоритм решения судоку | Alistan | Общие вопросы C/C++ | 5 | 27.04.2011 16:00 |
Программа для решения судоку | e1teck | Общие вопросы C/C++ | 1 | 11.03.2011 09:23 |
алгоритм решения судоку на паскале. | pchol | Фриланс | 3 | 15.02.2010 19:18 |
Программа для решения ур-ия ax+b=0 | Crish | Паскаль, Turbo Pascal, PascalABC.NET | 4 | 13.09.2009 00:42 |
Метод перебора для нахождения решения "Судоку" | ДЖО | Помощь студентам | 23 | 04.06.2008 22:29 |