Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Игра пятнашки


aka ©   (19.06.17 13:21

В начале игры случайно расставили числа, а есть ли алгоритм проверки собираймый  вариант выпал или нет? Т.е. не собирать до варианты, где 15 стоит первее 14, а сразу по исходному массиву узнать на предмет собираймости?


Sha ©   (19.06.17 14:13[1]

Четность перестановки сохраняется при перемещении дырки по горизонтали
и инвертируется при перемещении дырки по вертикали.

Поэтому все собираемые перестановки должны иметь ту же четность,
что у исходной перестановки (при условии, что дырка в том же ряду).


SergP ©   (19.06.17 14:55[2]

https://www.youtube.com/watch?v=rQJMT9nbFhk&t=1905s


aka ©   (19.06.17 15:42[3]

Ну вроде работает правильно, если я все правильно понял из видео. Проверка в процедуре ParityTest

unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls, Menus;

type
 TMainForm = class(TForm)
   MainPanel: TPanel;
   InfoLabel: TLabel;
   MainMenu: TMainMenu;
   MItemGame: TMenuItem;
   ChItemNew: TMenuItem;
   procedure FormCanResize(Sender: TObject; var NewWidth,
     NewHeight: Integer; var Resize: Boolean);
   procedure FormCreate(Sender: TObject);
   procedure ChItemNewClick(Sender: TObject);
 private
   { Private declarations }
 public
   BOARDSIZE: Integer;
   EmptyNo: Integer;
   Dg: array[1..15] of TPanel;
   procedure FillBoard;
   procedure Mixed;
   procedure ParityTest;
   procedure GameOver;
   procedure DgClick(Sender: TObject);
 end;

var
 MainForm: TMainForm;
 
implementation

uses Math;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
 BOARDSIZE := 320;
 EmptyNo := 16;
 FillBoard;
 Mixed;
 ParityTest;
 GameOver;
end;

procedure TMainForm.DgClick(Sender: TObject);
var
 buf, tg: Integer;
begin
 tg := TPanel(Sender).Tag;

 if (EmptyNo = tg + 1) and (tg mod 4 <> 0) then begin
   buf := EmptyNo;
   EmptyNo := TPanel(Sender).Tag;
   TPanel(Sender).Tag := buf;
   TPanel(Sender).Left := TPanel(Sender).Left + BOARDSIZE div 4;
 end
 else
 if (EmptyNo = tg - 1) and (tg mod 4 <> 1) then begin
   buf := EmptyNo;
   EmptyNo := TPanel(Sender).Tag;
   TPanel(Sender).Tag := buf;
   TPanel(Sender).Left := TPanel(Sender).Left - BOARDSIZE div 4;
 end
 else
 if EmptyNo = TPanel(Sender).Tag + 4 then begin
   buf := EmptyNo;
   EmptyNo := TPanel(Sender).Tag;
   TPanel(Sender).Tag := buf;
   TPanel(Sender).Top := TPanel(Sender).Top + BOARDSIZE div 4;
 end
 else
 if EmptyNo = TPanel(Sender).Tag - 4 then begin
   buf := EmptyNo;
   EmptyNo := TPanel(Sender).Tag;
   TPanel(Sender).Tag := buf;
   TPanel(Sender).Top := TPanel(Sender).Top - BOARDSIZE div 4;
 end;

 GameOver;
end;

procedure TMainForm.FillBoard;
var
 i,L,T: Integer;
begin
 for i := 1 to 15 do begin
   Dg[i] := TPanel.Create(MainPanel);
   Dg[i].Parent := MainPanel;
   L := ((i-1) mod 4) * (BOARDSIZE div 4);
   T := ((i-1) div 4) * (BOARDSIZE div 4);
   Dg[i].SetBounds(L,T,BOARDSIZE div 4, BOARDSIZE div 4);
   Dg[i].Caption := IntToStr(i);
   Dg[i].Tag := i;
   Dg[i].OnClick := DgClick;
 end;
end;

procedure TMainForm.Mixed;
var
 i,j,n,R: Integer;
 B: array[1..15] of Boolean;
 fillflag: Boolean;
begin
 Randomize;

 for i := 1 to 15 do
   B[i] := False;

 n := 1;  
 while True do begin
   R := Random(15) + 1;
   if not B[R] then begin
     B[R] := True;
     Dg[n].Caption := IntToStr(R);
     Inc(n);
   end;

   fillflag := True;
   for i := 1 to 15 do begin
     if B[i] = False then fillflag := False;
   end;

   if fillflag then Break;
 end;

end;

procedure TMainForm.FormCanResize(Sender: TObject; var NewWidth,
 NewHeight: Integer; var Resize: Boolean);
begin
 MainPanel.Width := BOARDSIZE;
 MainPanel.Height := BOARDSIZE;
 MainPanel.Left := (MainForm.ClientWidth div 2) - (MainPanel.Width div 2);
 MainPanel.Top := (MainForm.ClientHeight div 2) - (MainPanel.Height div 2);
end;

procedure TMainForm.ParityTest;
var
 parCounter,i,j: Integer;
begin
 parCounter := 0;

 for i := 1 to 15 do begin
   for j := 1 to 15 do begin
     if (Dg[i].Tag > Dg[j].Tag) and (StrToInt(Dg[i].Caption) < StrToInt(Dg[j].Caption))
     then begin
       Inc(parCounter);
     end;
   end;
 end;

 if parCounter mod 2 = 0 then
   InfoLabel.Caption := 'Cобираймый вариант'
 else
   InfoLabel.Caption := 'Этот вариант вы не собирете';

end;

procedure TMainForm.GameOver;
var
 i: Integer;
 flag: Boolean;
begin
 flag := True;
 for i := 1 to 15 do begin
   if Dg[i].Tag <> StrToInt(Dg[i].Caption) then flag := False;
 end;

 if flag then ShowMessage('Game Over');
end;

procedure TMainForm.ChItemNewClick(Sender: TObject);
var
 i: Integer;
begin
 for i := 1 to 15 do
   Dg[i].Free;

 EmptyNo := 16;
 FillBoard;
 Mixed;
 ParityTest;
 GameOver;
end;

end.


xayam ©   (19.06.17 15:49[4]

delphi: 5-
русский: 2-
:)


aka ©   (19.06.17 16:05[5]


> xayam ©   (19.06.17 15:49) [4]

Согласен, сложное слово нужно было заменить синонимом.


dmk ©   (19.06.17 18:08[6]

Что значит "этот вариант вы не соберете"?
Насколько я помню, собираются все варианты. Она всегда решаема :)


SergP ©   (19.06.17 19:00[7]


> dmk ©   (19.06.17 18:08) [6]
>
> Что значит "этот вариант вы не соберете"?
> Насколько я помню, собираются все варианты.


Не все. Только половина...


SergP ©   (19.06.17 19:10[8]


> 'Cобираймый вариант'


> 'Этот вариант вы не собирете'


А ошибки лучше исправить, а то глаза режет...


Sha ©   (19.06.17 19:51[9]

Cобираймый -> собираемый


aka ©   (19.06.17 20:15[10]


> dmk ©   (19.06.17 18:08) [6]

Видео со второго поста посмотрите, очень интересно


Sha ©   (19.06.17 20:57[11]

> aka ©   (19.06.17 20:15) [10]
> Видео со второго поста посмотрите, очень интересно

На самом деле в [1] доказательство проще, т.к.:
1. в начальных условиях при правильном расположении имеем 0 транспозиций, при неправильном - 1
2. в процессе игры любое движение дырки по вертикали меняет ровно 3 пары, и не надо рассматривать кучу вариантов


SergP ©   (20.06.17 14:25[12]

если дырка находится в крайнем правом углу вроде как вычислить разрешимость варианта можно и так (если конечно, я ничего не напутал):
function check(a:array of integer):boolean;
var
i,m:integer;
begin
result:=true;
for i:=0 to 14  do while a[i]<>i+1 do
  begin
    m:=a[a[i]-1];
    a[a[i]-1]:=a[i];
    a[i]:=m;
    result:=not result;
  end;
end;


В таком случае количество итераций этого "двойного" цикла не будет превышать 14


Sha ©   (20.06.17 16:25[13]

Вот это, наверно, должно работать (не проверял):
function check(a: PIntegerArray): boolean;
var
 i, j, k: integer;
begin
 k:=0;
 for i:=0 to 13 do for j:=i+1 to 14 do k:=k xor (a[j]-a[i]);
 Result:=k>=0;
end;


Slider007 ©   (21.06.17 11:02[14]

В Википедии есть ответ на поставленный в первом сообщении вопрос.


Sha ©   (21.06.17 12:13[15]

человечество решило эту и многие другие задачи


Rouse_ ©   (21.06.17 15:55[16]


> SergP ©   (19.06.17 14:55) [2]
> https://www.youtube.com/watch?v=rQJMT9nbFhk&t=1905s

Шикарно, нам в МИРЭА в свое время как-то через чур усложненно это давали, я с первого раза даже и не въехал, а тут парень достаточно легко все по полкам разложил. Вот это правильный преподаватель :)


manaka ©   (05.07.17 21:26[17]


> В начале игры случайно расставили числа


Зачем? Случайным образом двигаем кости из изначально собранного варианта, таким образом перемешивая их. Получаем 100% собираемую расстановку.


Sha ©   (06.07.17 09:19[18]

Зачем? При отрицательном тесте проще переставить 2 последних )


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо