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

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

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

Ну вроде работает правильно, если я все правильно понял из видео. Проверка в процедуре 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.


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

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

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

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

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


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

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


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


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

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

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

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

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

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

если дырка находится в крайнем правом углу вроде как вычислить разрешимость варианта можно и так (если конечно, я ничего не напутал):
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

Вот это, наверно, должно работать (не проверял):
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;


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

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

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

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

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


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

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

>Sha ©   (06.07.17 09:19) [18]
> Зачем? При отрицательном тесте проще переставить 2 последних )

затем

> login(mobile)   (23.11.18 22:21) [19]
> затем

нельзя просто так взять и встрять