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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2016, 13:31   #11
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Нет, интерес я не утратил - я просто был занят. Спасибо всем кто откликнулся - буду пробовать Ваши методы. У меня есть время больше месяца на эту программу.
Armageddets вне форума Ответить с цитированием
Старый 26.12.2016, 00:23   #12
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Armageddets Посмотреть сообщение
буду пробовать Ваши методы
какие "методы"? )

в пост #9 Аватар выложил полностью ГОТОВЫЙ рабочий код.
Можно брать и пользоваться.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 06.01.2017, 13:38   #13
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Все работает. Громадное спасибо! Я бы не додумался сделать так - это точно.
Armageddets вне форума Ответить с цитированием
Старый 22.11.2019, 02:07   #14
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,758
По умолчанию

Цитата:
Сообщение от Аватар Посмотреть сообщение
Интересно стало)) Рекурсивно случайным подбором вполне хорошо. Вот прикидка. В принципе так и решать можно, задав значения в нужные клетки вместо тех девяти фиксированных. Для решения случайность и не обязательна, просто перебором можно из допустимых значений. Можно и приспособить для проверки - единственное решение или нет. Для составителей это должно быть актуально.
Код:
var Sudoku: array[0..8,0..8] of Integer;

function Recursive(pRow,pCol: Integer): Boolean;
var i,j,i1,j1,xCount: Integer;
    xUsed,xFor: array[1..9] of Integer;
begin
  Result:=False;
  for i:=1 to 9 do xUsed[i]:=i;
  for i:=(pRow div 3)*3 to (pRow div 3)*3+2 do
    for j:=(pCol div 3)*3 to (pCol div 3)*3+2 do if Sudoku[i,j]>0 then xUsed[Sudoku[i,j]]:=0;
  for i:=0 to 8 do if Sudoku[i,pCol]>0 then xUsed[Sudoku[i,pCol]]:=0;
  for j:=0 to 8 do if Sudoku[pRow,j]>0 then xUsed[Sudoku[pRow,j]]:=0;
  while True do begin
    xCount:=0;
    for i:=1 to 9 do if xUsed[i]>0 then begin Inc(xCount); xFor[xCount]:=i; end;
    if xCount=0 then Exit;
    Sudoku[pRow,pCol]:=xFor[Random(xCount)+1];
    i1:=-1; j1:=-1;
    for i:=0 to 8 do begin
      for j:=0 to 8 do if Sudoku[i,j]=0 then begin i1:=i; j1:=j; Break; end;
      if i1<>-1 then Break;
    end;
    Result:=(i1=-1) or Recursive(i1,j1);
    if Result then Exit;
    xUsed[Sudoku[pRow,pCol]]:=0;
    Sudoku[pRow,pCol]:=0;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var i,j: Integer;
    s: String;
function FixNumber(Count: Integer; Casually: Boolean = True): Integer;
begin
  if Casually then begin
    Result:=StrToInt(s[Random(Count)+1]);
    s:=StringReplace(s,IntToStr(Result),'',[]);
  end  
  else Result:=10-Count;
end;
begin
  Randomize;
  s:='123456789';
  for i:=0 to 8 do
    for j:=0 to 8 do begin
      if      (i=0) and (j=0) then Sudoku[i,j]:=FixNumber(9)
      else if (i=0) and (j=8) then Sudoku[i,j]:=FixNumber(8)
      else if (i=1) and (j=4) then Sudoku[i,j]:=FixNumber(7)
      else if (i=4) and (j=1) then Sudoku[i,j]:=FixNumber(6)
      else if (i=4) and (j=4) then Sudoku[i,j]:=FixNumber(5)
      else if (i=4) and (j=7) then Sudoku[i,j]:=FixNumber(4)
      else if (i=7) and (j=4) then Sudoku[i,j]:=FixNumber(3)
      else if (i=8) and (j=0) then Sudoku[i,j]:=FixNumber(2)
      else if (i=8) and (j=8) then Sudoku[i,j]:=FixNumber(1)
                              else Sudoku[i,j]:=0;
    end;
  Recursive(0,1);
  for i:=0 to 8 do
    for j:=0 to 8 do StringGrid1.Cells[j,i]:=IntToStr(Sudoku[i,j]);
end;
интересно.
Alar вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Судоку FILA Общие вопросы Delphi 2 20.09.2013 22:48
Судоку на C++ Logg Помощь студентам 0 20.01.2013 15:39
Переделать обычное судоку в судоку чёт-нечёт Dark Illusion Общие вопросы Delphi 0 28.03.2012 20:33
судоку sergio11 C# (си шарп) 8 09.04.2011 21:33
Судоку zmey31313 Софт 7 13.05.2010 16:12