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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.05.2011, 20:33   #1
Atlika
 
Регистрация: 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;
Atlika вне форума Ответить с цитированием
Старый 25.05.2011, 20:34   #2
Atlika
 
Регистрация: 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
Atlika вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм решения судоку 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