eightnumberfrm.pas

此软件是八数码软件

unit EightNumberFrm;

interface                           

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

type
  TEightNumber = class(TForm)
    AStar1Btn: TButton;
    EditStart11: TEdit;
    EditStart12: TEdit;
    EditStart13: TEdit;
    EditStart21: TEdit;
    EditStart22: TEdit;
    EditStart23: TEdit;
    EditStart31: TEdit;
    EditStart32: TEdit;
    EditStart33: TEdit;
    AStar1Memo: TMemo;
    BFSBtn: TButton;
    BFSMemo: TMemo;
    AllNumberImage: TImage;
    ControlBtn: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    PaintBoxBlank: TPaintBox;
    PaintBoxNumber: TPaintBox;
    SetStartTargetBtn: TButton;
    EditTarget11: TEdit;
    EditTarget12: TEdit;
    EditTarget13: TEdit;
    EditTarget21: TEdit;
    EditTarget22: TEdit;
    EditTarget23: TEdit;
    EditTarget31: TEdit;
    EditTarget32: TEdit;
    EditTarget33: TEdit;
    AStar2Memo: TMemo;
    AStar2Btn: TButton;
    CompareBtn: TButton;
    AStar1RoadLabel: TLabel;
    AStar2RoadLabel: TLabel;
    BFSRoadLabel: TLabel;
    AStar1VisitedLabel: TLabel;
    AStar2VisitedLabel: TLabel;
    BFSVisitedLabel: TLabel;
    HelpBtn: TButton;
    AboutBtn: TButton;
    StatusBar: TStatusBar;
    CloseBtn: TButton;
    StartLabel: TLabel;
    TargetLabel: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    function IsTarget(n: integer): boolean;
    function Depth(n: integer): integer;
    function HValue1(n: integer): integer;
    function HValue2(n: integer): integer;
    function FValue1(n: integer): integer;
    function FValue2(n: integer): integer;
    procedure AStar1BtnClick(Sender: TObject);
    function IsAncestor(m, n: integer): boolean;
    function AStarExist(): integer;
    procedure Adjust(sn:integer);
    function AStar(method: integer):integer;
    procedure AStar1ResultOutput();
    procedure AStar2ResultOutput();
    procedure Initialize();
    function BFS(): integer;
    procedure BFSBtnClick(Sender: TObject);
    procedure BFSResultOutput();
    function BFSExist(): integer;
    procedure MoveUp(row,col,movenumber: integer);
    procedure MoveDown(row,col,movenumber: integer);
    procedure MoveLeft(row,col,movenumber: integer);
    procedure MoveRight(row,col,movenumber: integer);
    procedure ControlBtnClick(Sender: TObject);
    procedure InitializeImage();
    procedure ImageRepaint();
    procedure AStar1ShowResult();
    procedure AStar2ShowResult();
    procedure BFSShowResult();
    procedure EditStart11KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart11Enter(Sender: TObject);
    procedure EditStart12Enter(Sender: TObject);
    procedure EditStart12KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart13Enter(Sender: TObject);
    procedure EditStart13KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart21Enter(Sender: TObject);
    procedure EditStart21KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart22Enter(Sender: TObject);
    procedure EditStart22KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart23Enter(Sender: TObject);
    procedure EditStart23KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart31Enter(Sender: TObject);
    procedure EditStart31KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart32Enter(Sender: TObject);
    procedure EditStart32KeyPress(Sender: TObject; var Key: Char);
    procedure EditStart33Enter(Sender: TObject);
    procedure EditStart33KeyPress(Sender: TObject; var Key: Char);
    procedure SetStartTargetBtnClick(Sender: TObject);
    function ContraryOrderStart():Integer;
    function ContraryOrderTarget():Integer;
    function IsWrongEditStartInput(): boolean;
    function IsWrongEditTargetInput(): boolean;
    procedure FormActivate(Sender: TObject);
    procedure EditTarget11Enter(Sender: TObject);
    procedure EditTarget11KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget12Enter(Sender: TObject);
    procedure EditTarget12KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget13Enter(Sender: TObject);
    procedure EditTarget13KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget21Enter(Sender: TObject);
    procedure EditTarget21KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget22Enter(Sender: TObject);
    procedure EditTarget22KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget23Enter(Sender: TObject);
    procedure EditTarget23KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget31Enter(Sender: TObject);
    procedure EditTarget31KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget32Enter(Sender: TObject);
    procedure EditTarget32KeyPress(Sender: TObject; var Key: Char);
    procedure EditTarget33Enter(Sender: TObject);
    procedure EditTarget33KeyPress(Sender: TObject; var Key: Char);
    procedure MemorizeAStar1Road();
    procedure MemorizeAStar2Road();
    procedure MemorizeBFSRoad();
    procedure AStar2BtnClick(Sender: TObject);
    procedure CompareBtnClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure AboutBtnClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

//定义3×3的数组，用于记录结点中8个数字和空格（0）的位置
type
NumberPosition = array [1..3,1..3] of Byte;

//定义1×4的数组，用于记录结点的父亲结点下标和儿子结点下标
type
FourElementInt = array [1..4] of integer;

//定义1×4的数组，用于空格移动方向
type
FourElementShortInt = array [1..4] of ShortInt;

//定义1×500的数组，用于记录某结点的所有祖先结点下标
type
AncestorArray = array [1..500] of integer;

//定义1×200的数组，用于记录从初始结点到目标结点的路径
type
PathArray = array [1..200] of integer;

//******************************************//
//********区分父亲结点和父结点的概念********//
//  m是n父亲结点表示m经过一个转换可以达到n  //
//  m是n父结点表示n的指针prior域指向m       //
//******************************************//
type
  node = record      //描述每个状态结点
     status        : NumberPosition;     //记录8个数字和空格（0）的位置
     prior         : integer;            //指向的父结点的下标的指针
     flag          : Byte;               //flag为0表示结点在Open表，可以展开
                                         //flag为1表示结点在Close表，不能展开
     value         : integer;            //评价函数f=g＋h的值
     x,y           : Byte;               //空格的行坐标和列坐标
     parentcount   : Byte;               //结点的父亲个数
     parent        : FourElementInt;     //记录结点的父亲下标的数组
     childcount    : Byte;               //结点的儿子个数
     child         : FourElementInt;     //记录结点的儿子下标的数组
end;

var
  EightNumber : TEightNumber;
  Queue : array [1..100000] of node;       //存储所有生成的结点的数组

implementation

uses HelpFrm, AboutFrm;

var
  AStarQueueTop    : integer;              //当前结点在数组Queue中的下标,用于A星算法中
  BFSHead          : integer;              //当前结点在数组Queue中的下标,用于BFS算法中
  BFSTail          : integer;              //新增结点在数组Queue中的下标,用于BFS算法中
  target           : NumberPosition;       //目标状态
  MoveX,MoveY      : FourElementShortInt;  //MoveX和MoveY分别表示空格向上、左、下、右移动
  ancestor         : AncestorArray;        //祖先数组，用于判断一个结点是否另外一个结点的祖先
  AStar1Path       : PathArray;            //A星算法1路径数组，用于记录从初始结点到目标结点的路径
  AStar1PathTop    : integer;              //记录A星算法1搜索到的路径的结点总数，作为AStar1Path数组的指针
  AStar2Path       : PathArray;            //A星算法2路径数组，用于记录从初始结点到目标结点的路径
  AStar2PathTop    : integer;              //记录A星算法2搜索到的路径的结点总数，作为AStar2Path数组的指针
  BFSPath          : PathArray;            //BFS算法路径数组，用于记录从初始结点到目标结点的路径
  BFSPathTop       : integer;              //记录BFS算法搜索到的路径的结点总数，作为BFSPath数组的指针
{$R *.dfm}


/////////////////////////////////////////////////////////////////////////////////////
////Adjust过程调整参数指定的结点后裔的指针prior域和评价函数值value域
////调用原因：展开某结点得到的新结点和Close表中的结点相同，则调整指针和评价函数值
////入口：function----AStar(method:integer):integer
////参数：某一结点在Queue数组中的下标
/////////////////////////////////////////////////////////////////////////////////////
procedure TEightNumber.Adjust(sn: integer);
var i: integer; //循环变量
    head,tail: integer; //数组指针
    adjustment: array [1..100] of integer;   //adjustment数组记录所有可能需要调整指针域的sn的后裔的下标
    ccount: integer; //adjustment数组当前结点的儿子数目
begin
    //初始化adjustment数组，令其所有元素全部归零
    //Low(adjustment)和High(adjustment)分别代表adjustment数组的下标的下限和上限，
    //此处实质为1和100，这样做的好处是增加兼容性和易修改性
    for i := Low(adjustment) to High(adjustment) do
    begin
        adjustment[i] := 0;
    end;//end of for i

    head := 0;
    tail := 1;
    adjustment[1] := sn;

    //在此算法中的每一个时刻，head结点都是tail结点的父亲结点
    while ( head <> tail ) do
    begin
        head := head + 1;
        ccount := Queue[adjustment[head]].childcount;

        //adjustment数组的当前结点有儿子，则处理儿子结点
        if ( ccount > 0 ) then
        begin
           for i := 1 to ccount do
           begin
              tail := tail + 1;   //新增结点
              adjustment[tail] := Queue[adjustment[head]].child[i];    //将儿子结点放入adjustment数组

              //如果儿子结点指针指向sn后裔树中的父亲结点
              if ( Queue[adjustment[tail]].prior = head ) then
              begin
                 Queue[adjustment[tail]].value := HValue1( adjustment[tail] ) + Depth( adjustment[tail] );
              end//end of if ( Queue[adjustment[tail]].prior = head )----如果儿子结点指针指向sn后裔树中的父亲结点

              else  //如果儿子结点指针指向sn后裔树外的父亲结点
              begin
                 //如果调整指针可以减少耗散值，则调整指针
                 if ( Depth( tail ) > Depth ( head ) + 1 ) then
                 begin
                    Queue[adjustment[tail]].prior := head;
                    Queue[adjustment[tail]].value := HValue1( adjustment[tail] ) + Depth( adjustment[tail] );
                 end //end of if ( Depth( tail ) > Depth ( head ) + 1 )----如果调整指针可以减少耗散值

                 else //如果调整指针不能可以减少耗散值，则撤销结点
                 begin
                    tail := tail - 1;
                 end; //end of else----如果调整指针不能可以减少耗散值，则撤销结点

              end;//end of else----//如果儿子结点指针指向sn后裔树外的父亲结点

           end;//end of for i

        end;//end of if ( ccount > 0 )----adjustment数组的当前结点有儿子

    end;//end of while

end;


//////////////////////////////////////////////////////////////////////////////////////////////////////////////
////AStar过程根据A星算法求出从初始结点到目标结点的耗散值最小的路径，记录在AStar1Path或者AStar1Path全局数组中
////入口：procedure----MemorizeAStar1Road调用AStar(1)
////      procedure----MemorizeAStar2Road调用AStar(2)
////参数：method,method只取1和2，
////      method=1表示启发式函数为"不在位"的将牌数
////      method=2表示启发式函数为将牌"不在位"的距离和
////返回值：最后一个展开的结点的下标
//////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TEightNumber.AStar(method:integer):integer;
var  i,j,k : integer; //循环变量
     min : integer;  //Open表中所有结点的评价函数的最小值
     ChooseNumber : integer;  //即将要展开的结点下标
     ChooseX,ChooseY : integer;  //即将要展开的结点的空格的行列坐标