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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 08.05.2020, 16:53   #1
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию Алгоритм решения головоломки

Доброго времени суток, уважаемые эксперты.
Есть головоломка где нужно расставить шарики (аналог однопалубных кораблей в морском бое). Снизу и справа пишется как в японском кроссворде количество шариков в столбце или строке. Так же на поле помимо шариков есть стрелочки, которые указывают в каком направлении есть шарик дальше по строке или столбцу или диагонали. Прикасаться шарики не могут. Задание картинкой прикладываю ниже.

Не могу придумать алгоритм решения. Если делать через бектрекинг - это очень долго и сложно. Может есть варианты попроще? Не приходит ничего на ум, к сожалению. Если же только бектрекинг, то может есть варианты его упрощения? Вариант с подставлением сразу правильного ответа - не подходит по заданию.

Саму головоломку уже реализовал, а вот над авто решением думаю.

Заранее спасибо за советы.
Изображения
Тип файла: jpg BX4j5oJbR4E.jpg (120.1 Кб, 1 просмотров)

Последний раз редактировалось Armageddets; 08.05.2020 в 17:13.
Armageddets вне форума Ответить с цитированием
Старый 09.05.2020, 05:46   #2
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Тоже ничего особо годного не пришло в голову. Если делать так, как сказано в тексте? Сначала вычеркнуть все клеточки, где шарика точно быть не может. Для всех строк, в которых по одному шарику и стоят горизонтальные стрелки, вычеркнуть клеточки за стрелкой. Тоже самое для столбцов. Затем второй случай, когда у стрелочки возможны два варианта расположения шарика, то вычеркнуть заведомо неподходящие соседние клетки. Затем начинать поиск решения через бектрекинг. Выбрать ту стрелочку, у которой осталось минимальное количество вариантов расстановки шарика. Продолжать поиск, пока не будут выбраны шарики для всех стрелок. Думаю, что на этот момент останется мало свободных клеток для расстановки оставшихся шариков.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 09.05.2020, 20:53   #3
Алексей1153
фрилансер
Форумчанин
 
Регистрация: 11.10.2019
Сообщений: 947
По умолчанию

можно попробовать методом в лоб: имеется 49 переменных (клеток)
для них составляется 14 уравнений (7 для строк + 7 для столбцов). Уравнения решаются каким-нибудь методом. Имеются также уточняющие условия (стрелки, соприкосновения) - для выбора из нескольких решений нужного

Последний раз редактировалось Алексей1153; 09.05.2020 в 20:55.
Алексей1153 вне форума Ответить с цитированием
Старый 19.05.2020, 12:17   #4
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Спасибо за советы. Начал делать алгоритм бек трекинга. Начинают шарики расставляться. Первые 3 становятся, а на четвертом нет места для него подходящего и он возвращает алгоритм на шаг назад, после чего третий шарик стает почему-то на то же место и четвертый опять не может никуда стать.

Помогите найти ошибку, если есть время. У меня подозрение на:
1) либо я когда делаю доступным ход для первых шариков при нахождении стрелок где-то напартачил
2) либо в самом алгоритме бек трекинга беда. Может мне дополнительная проверка нужна для скачка не на 1 шаг назад, а на целых 2 и более. То есть с логикой алгоритма натупил.

Вот алгоритм бек трекинга (весь проект тоже прилагаю):

Код:
procedure TForm2.N3Click(Sender: TObject);
var i,j,n,m,q,w,ii,jj,t:Integer; u,o:Boolean;  Stroka,Stolbec,XX,YY:array[1..7] of Integer;  Start,Stop:TPoint;
S:array[1..7,1..7,1..10] of integer; Way:array[1..10] of TPoint;
begin

  for i:=1 to 7 do
  for j:=1 to 7 do
  map[i,j]:=0;

  {
  for i:=1 to 7 do
  for j:=1 to 7 do
  if original[i,j]=1 then
  map[i,j]:=original[i,j];
  }

  for i:=1 to 10 do //ochistka shagov
  begin
  Way[i].X:=-1;
  Way[i].Y:=-1;
  end;

  for i:=1 to 7 do
  for j:=1 to 7 do
  for q:=1 to 10 do
  if original[i,j]>2 then
  S[i,j,q]:=-1 else s[i,j,q]:=0;
  //if original[i,j]<>1 then S[i,j,q]:=original[i,j] else S[i,j,q]:=0;

  //schitaem tsifri
  for j:=1 to 7 do
  begin
     n:=0; //v stroke sharikov
     m:=0; //v stolbtse sharikov
     for i:=1 to 7 do
     begin
       //schitaem shariki v strokah
       if original[i,j]=1 then inc(n);
       //schitaem shariki v stolbtsah
       if original[j,i]=1 then inc(m);
     end;
  //sharikov v stoke i stolbtse
  Stroka[j]:=n;
  Stolbec[j]:=m;
  //sharikov v stoke i stolbtse - vremennie peremennie
  YY[j]:=n;
  XX[j]:=m;
  end;


  //probegaem po kletkam so strelkami i po napravleniyu stavim dostupnie hodi
  //probegaem po strelkam i po ih napravleniyu stavim shariki
  m:=0; //skolko strelok
  for j:=1 to 7 do
  begin
  n:=0;
  u:=false;
    //probegaem po strelkam i po ih napravleniyu stavim shariki
    for i:=1 to 7 do
    if original[i,j]>2 then
    begin
    Inc(m); //skolko strelok
      //opredelyaem napravlenie strelki
      case original[i,j] of
      3:begin //vpravo
        Start.X:=i+1;
        Stop.X:=7;
        Start.Y:=j;
        Stop.Y:=j;
        end;
      4:begin //vniz
        Start.X:=i;
        Stop.X:=7;
        Start.Y:=j+1;
        Stop.Y:=7;
        end;
      5:begin //vlevo
        Start.X:=i-1;
        Stop.X:=0;
        Start.Y:=j;
        Stop.Y:=j;
        end;
      6:begin //vverh
        Start.X:=i;
        Stop.X:=i;
        Start.Y:=j-1;
        Stop.Y:=0;
        end;
      7:begin //vverh vpravo
        Start.X:=i+1;
        Stop.X:=7;
        Start.Y:=j-1;
        Stop.Y:=0;
        end;
      8:begin //vniz vpravo
        Start.X:=i+1;
        Stop.X:=7;
        Start.Y:=j+1;
        Stop.Y:=7;
        end;
      9:begin //vniz vlevo
        Start.X:=i-1;
        Stop.X:=0;
        Start.Y:=j+1;
        Stop.Y:=7;
        end;
      10:begin //vverh vlevo
        Start.X:=i-1;
        Stop.X:=0;
        Start.Y:=j-1;
        Stop.Y:=0;
        end;
      end;

      //u:=false; //ne postavili
      n:=0;

      //obnulyaem vse hodi, krome naydennih
      for ii:=1 to 7 do
      for jj:=1 to 7 do
      s[ii,jj,m]:=-1;

      while (n<100) and (u=false) do
      begin
        q:=Start.X;
        w:=Start.Y;
        while (q<>Stop.X) and (w<>Stop.Y) and (n<100) do
        begin
          if (map[q,w]=0) and (original[q,w]=0) then
          begin
          S[q,w,m]:=0;
          end
          else
          begin
          if q>=Stop.X then Dec(q) else Inc(q);
          if w>=Stop.Y then Dec(w) else Inc(w);
          end;
        Inc(n);
        end;
      Inc(n);
      end;


    end;

  end;

  /////////////////////////////////////////////////////////////////////////////////////

  //pitaemsya stavit shariki v bektrekinge
  n:=1; //kakoy sharik stavim (kakoy shag)
  while (n<=4) do //stavim vozle strelok
  begin
    u:=false; //ne postavili
    //ishem kletku gde mozhno postavit
    for j:=1 to 7 do
    for i:=1 to 7 do
    if (u=False) and (S[i,j,n]=0) and (XX[i]>0) and (YY[j]>0) then
    begin
       //proveryaem mozhno li v radiuse 1 kletki stavit
       o:=True;
       for q:=i-1 to i+1 do
       for w:=j-1 to j+1 do
       if (q>0) and (w>0) and (q<8) and (w<8) and (map[q,w]=1) then o:=False; //nelzya stavit

       if o=True then
       begin
       Way[n].X:=i;
       Way[n].Y:=j;
       s[i,j,n]:=1;
       XX[i]:=XX[i]-1;
       YY[j]:=YY[j]-1;
       map[i,j]:=1;
       Inc(n);
       u:=True;
       end;
    end;

    //esli takoy net - idem na 1 shag nazad
    if u=False then
    begin

      //ochistka hodov na tekushem urovne
      for j:=1 to 7 do
      for i:=1 to 7 do
      if s[i,j,n]=1 then s[i,j,n]:=0;

      if n>1 then
      begin
      Dec(n);
      map[Way[n].X,Way[n].Y]:=0;
      XX[Way[n].X]:=XX[Way[n].X]+1;
      YY[Way[n].Y]:=YY[Way[n].Y]+1;
      Way[n].X:=-1;
      Way[n].Y:=-1;
      end;

    end;
    //probuem nayti kakuyuto kletku
    //esli vse kletki uzhe stavilis - idem eshe na shag vverh a vse nizhnie sagi obnulyautsya (ta, tsifra svoya)
    Timer1Timer(Self);
  end;
Вложения
Тип файла: zip Шарики логические.zip (1.45 Мб, 1 просмотров)
Armageddets вне форума Ответить с цитированием
Старый 20.05.2020, 07:16   #5
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Чуть-чуть изменил код. Теперь первые 4 шарика ставятся на поле. Удалил таймер и сделал отрисовку по требованию. Чуть-чуть изменил графику. Вместо цифр используется свой тип, чтобы код легче читался. Закомментированный код не менял. Баги конечно же могли остаться.
Вложения
Тип файла: zip Шарики логические.zip (8.0 Кб, 3 просмотров)
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 20.05.2020, 17:20   #6
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Спасибо огромное!
Armageddets вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм решения головоломки Акари (Akari LightUp Фонари) Armageddets Общие вопросы Delphi 4 18.06.2017 10:51
Подскажите алгоритм решения Nickolay0512 Общие вопросы C/C++ 12 07.10.2014 23:26
Алгоритм решения задачи Amet13 Помощь студентам 1 21.04.2012 13:16
Алгоритм решения сравнений outaccess Помощь студентам 0 02.05.2011 14:55
Алгоритм решения Naruto63 Помощь студентам 6 20.09.2009 22:47