Текущий архив: 2010.01.03;
Скачать: CL | DM;

Вниз

Игра пятнашки   Найти похожие ветки 

← →
AntonioBanderas   (2009-11-12 20:41) [0]

Вообще непонятно, как могут получатся пятнашки с одинаковыми цифрами, ведь не должны же.
Подскажите в чем моя ошибка?


 var
 MainF: TMainF;
 Visit: array[0..14] of Boolean;
 SIZE, NUM: Integer;

implementation

uses Math;

{$R *.dfm}

procedure GenRendomNum_1_15;
var
 NumOfCell: Word;
begin
 Randomize;
 NumOfCell := Random(15);

 if Visit[NumOfCell] = false then
 begin
   NUM := NumOfCell;
   Visit[NumOfCell] := true
 end else
   GenRendomNum_1_15;
end;

procedure TMainF.Init;
var
 i: Integer;
 Cell: TPanel;
begin
 SIZE := 50;
 //очистить доску
 for i := 0 to BoardPanel.ControlCount - 1 do
 begin
   BoardPanel.Controls[0].Free;
 end;

 //расставить фишки
 for i := 0 to 14 do
 begin
   Visit[i] := false;
   Cell := TPanel.Create(BoardPanel);
   Cell.SetBounds((i mod 4)*SIZE,(i div 4)*SIZE,SIZE,SIZE);
   GenRendomNum_1_15;
   Cell.Caption := IntToStr(Num+1);
   Cell.Parent := BoardPanel;
 end;
end;

procedure TMainF.N2Click(Sender: TObject);
begin
 Init;
end;


---

← →
Германн ©   (2009-11-12 20:48) [1]

Randomize нужно вызвать один и только один раз, например при старте программы

---

← →
AntonioBanderas   (2009-11-12 20:54) [2]

> Randomize нужно вызвать один и только один раз, например
> при старте программы


Согласан, забыл. Но ошибка не из-за этого

---

← →
Германн ©   (2009-11-12 21:16) [3]

>  Visit[i] := false;

Эту очистку вынеси в отдельный цикл.

---

← →
AntonioBanderas   (2009-11-12 21:21) [4]

> Германн ©   (12.11.09 21:16) [3]

И что будет? При первом Init уже не правильно получается.
Ну не понятно как он Visit пролетает.

---

← →
AntonioBanderas   (2009-11-12 21:29) [5]

> Германн ©   (12.11.09 21:16) [3]


Ну это моя большая невнимательность, все правильно.

---

← →
Думкин ©   (2009-11-13 06:04) [6]

> AntonioBanderas   (12.11.09 21:29) [5]

Самый нормальный способ получать случайные последовательнсти со значениями на отрезке чисел - это брать этот отрезок и перемешивать.

---

← →
Думкин ©   (2009-11-13 06:58) [7]

И для 15 надо понимать, что произвольный расклад может и не сойтись с вероятностью 1/2.

---

← →
Рамиль ©   (2009-11-13 08:54) [8]

> Думкин ©   (13.11.09 06:58) [7]

Насколько я помню, расклад сходится, если можно собрать четным количеством перестановок пар фишек. Или я забыл уже?

---

← →
Думкин ©   (2009-11-13 09:16) [9]

> Рамиль ©   (13.11.09 08:54) [8]

Начальная позиция - пустой правый нижний? Наверное. Не вникал. Но главное, что делятся на два класса.

---

← →
Думкин ©   (2009-11-13 09:21) [10]

Или имеется в виду, что вытянем в ряд и посмотрим четность перестановки? Наверное, так. Скорее всего так.

---

← →
Рамиль ©   (2009-11-13 09:28) [11]

Не, я не совсем прав.
http://alekstrade.hoter.ru/blog/1179/9955/%D0%9F%D1%8F%D1%82%D0%BD%D0%B0%D1%88%D0%BA%D0%B8
http://ru.wikipedia.org/wiki/%D0%9F%D1%8F%D1%82%D0%BD%D0%B0%D1%88%D0%BA%D0%B8

---

← →
AntonioBanderas   (2009-11-14 23:47) [12]

> Рамиль ©   (13.11.09 09:28) [11]

Если я правильно понял то процедура RealityMove определит сходимость, или я неправильно понял?
Полный код модуля:

unit Main;

interface

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

type
 TMainF = class(TForm)
   BoardPanel: TPanel;
   MainMenu: TMainMenu;
   MGame: TMenuItem;
   NewGame: TMenuItem;
   ExitGame: TMenuItem;
   MHelp: TMenuItem;
   About: TMenuItem;
   StatusBar: TStatusBar;
   InfoLabel: TLabel;
   procedure Init;
   procedure NewGameClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure MoveCell(Sender: TObject);
   procedure AboutClick(Sender: TObject);
   procedure ExitGameClick(Sender: TObject);
   procedure FormResize(Sender: TObject);
   procedure GameEnd;
   procedure RealityMove;
   procedure FormPaint(Sender: TObject);
 private

 public

 end;

var
 MainF: TMainF;
 Visit: array[0..14] of Boolean;
 SIZE, NUM: Integer;
 Empty, EmptyX, EmptyY: Integer;
 HaosCount, MoveCount: Integer;

implementation

uses Math, AboutB;

{$R *.dfm}

procedure TMainF.FormCreate(Sender: TObject);
begin
 Randomize;
end;

procedure GenRendomNum_1_15;
var
 NumOfCell: Word;
begin
 NumOfCell := Random(15);

 if Visit[NumOfCell] = false then
 begin
   NUM := NumOfCell;
   Visit[NumOfCell] := true
 end else
   GenRendomNum_1_15;
end;

procedure TMainF.RealityMove;
var
 i, j: Integer;
 CurCell: Integer;
begin
 HaosCount := 0;
 for i := 0 to 14 do
 begin
   CurCell := StrToInt(TPanel(BoardPanel.Controls[i]).Caption);
   for j := i to 14 do
   begin
     if CurCell < StrToInt(TPanel(BoardPanel.Controls[j]).Caption) then
     begin
       HaosCount := HaosCount + 1;
     end;
   end;
 end;

 if (HaosCount mod 2) <> 0 then
   InfoLabel.Caption := "Данная расстановка не решаема, попробуете?"
 else
   InfoLabel.Caption := "";

 StatusBar.Panels[0].Text := " Беспорядков = "+IntToStr(HaosCount);  
end;

procedure TMainF.GameEnd;
var
 i: Integer;
 EndFlag: Boolean;
begin
 EndFlag := true;
 for i := 0 to 14 do
 begin
   if (StrToInt(TPanel(BoardPanel.Controls[i]).Caption)-1) <> TPanel(BoardPanel.Controls[i]).Tag
     then  EndFlag := false;
 end;

 if EndFlag then
   InfoLabel.Caption := "Игра окончена";
end;

procedure TMainF.MoveCell(Sender: TObject);
var
 Buf, BufX, BufY: Integer;
begin
 MoveCount := MoveCount + 1;
 StatusBar.Panels[1].Text := " Ходов = "+IntToStr(MoveCount);

 Buf := TPanel(Sender).Tag;
 TPanel(Sender).Tag := Empty;
 Empty := Buf;

 //Move to Top
 if ((Sender as TPanel).Left = EmptyX) and ((Sender as TPanel).Top = EmptyY + SIZE)
 then begin
    BufY := TPanel(Sender).Top;
    TPanel(Sender).Top := EmptyY;
    EmptyY := BufY;
    GameEnd;
    Exit;
 end;

 //Move to Bottom
 if ((Sender as TPanel).Left = EmptyX) and ((Sender as TPanel).Top = EmptyY - SIZE)
 then begin
    BufY := TPanel(Sender).Top;
    TPanel(Sender).Top := EmptyY;
    EmptyY := BufY;
    GameEnd;
    Exit;
 end;

 //Move to Right
 if ((Sender as TPanel).Top = EmptyY) and ((Sender as TPanel).Left = EmptyX - SIZE)
 then begin
    BufX := TPanel(Sender).Left;
    TPanel(Sender).Left := EmptyX;
    EmptyX := BufX;
    GameEnd;
    Exit;
 end;

 //Move to Left
 if ((Sender as TPanel).Top = EmptyY) and ((Sender as TPanel).Left = EmptyX + SIZE)
 then begin
    BufX := TPanel(Sender).Left;
    TPanel(Sender).Left := EmptyX;
    EmptyX := BufX;
    GameEnd;
 end;

end;

procedure TMainF.Init;
var
 i: Integer;
 Cell: TPanel;
begin
 SIZE := 50;
 
 Empty := 15;
 EmptyX := 3*SIZE;
 EmptyY := 3*SIZE;

 for i := 0 to BoardPanel.ControlCount - 1 do
 begin
   BoardPanel.Controls[0].Free;
 end;

 for i := 0 to 14 do
 begin
   Visit[i] := false;
 end;

 for i := 0 to 14 do
 begin
   Cell := TPanel.Create(BoardPanel);
   Cell.SetBounds((i mod 4)*SIZE,(i div 4)*SIZE,SIZE,SIZE);
   GenRendomNum_1_15;
   Cell.Caption := IntToStr(NUM+1);
   Cell.Tag := i;
   Cell.Parent := BoardPanel;
   Cell.OnClick := MoveCell;
 end;

 RealityMove;
end;

procedure TMainF.NewGameClick(Sender: TObject);
begin
 InfoLabel.Caption := "";
 StatusBar.Panels[1].Text := " Ходов = 0";
 Init;
end;

procedure TMainF.AboutClick(Sender: TObject);
begin
 AboutBox.ShowModal;
end;

procedure TMainF.ExitGameClick(Sender: TObject);
begin
 Application.Terminate;
end;

procedure TMainF.FormResize(Sender: TObject);
begin
 BoardPanel.Left := (ClientWidth div 2) - (BoardPanel.Width div 2);
 BoardPanel.Top := 100;
end;

procedure TMainF.FormPaint(Sender: TObject);
begin
 InfoLabel.Left := (ClientWidth div 2) - (InfoLabel.Width div 2);
 InfoLabel.Top := 15;
end;

end.



---

← →
V   (2009-11-15 09:00) [13]


var j:array[1..16] of shortint;

procedure zap;
const fi:array[1..16] of byte=(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,0);
var ttt:array[1..16] of shortint;
     d,n,t,chq:integer; p:boolean;
begin
randomize;
 Repeat
 n:=1;
  for i:=1 to 16 do begin j[i]:=0; ttt[i]:=0; end;
  repeat
    repeat
     t:=random(15)+1;
     p:=false;
     for i:=1 to 16 do if j[i]=t then begin p:=true; break; end;
    until p=false;
    j[n]:=t; ttt[n]:=j[n]; n:=n+1;
  until n>=16;
  n:=1; chq:=0;
 repeat
  repeat
   if ttt[n]<>fi[n] then begin d:=ttt[n]; ttt[n]:=ttt[d]; ttt[d]:=d;
   chq:=chq+1; end;
  until ttt[n]=fi[n];
  n:=n+1;
  until n>=16;
 until chq mod 2=0; // если 1, то не будет собираться
end;

Писал давно, лет 10 назад, еще на паскале...
Тут заполнится массив j цифрами от 1 до 15 перемешанными, и собираться будет пятнашка, если их вот так расположить...
j[1] j[2] j[3] j[4]
j[5] j[6] j[7] j[8]
j[9] j10 j11] j[12]
j13 j14] j15

---

Страницы: 1 вся ветка

Текущий архив: 2010.01.03;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.017 c