unit1.pas

九宫格的A*算法实现 可以选择两个估价函数

unit Unit1;

interface

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

type
  ptnode=^tnode;
  tnode=record
    s:string;
    g,h:integer;
    //num:节点于最终节点位置不同的字符个数
    //g:深度
    parent,next:ptnode;
    //next:链表中指向下一个节点的指针
    //parent:路径中的父节点
  end;
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    G1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Button1: TButton;
    N4: TMenuItem;
    E1: TMenuItem;
    StatusBar1: TStatusBar;
    RadioGroup1: TRadioGroup;
    Animate1: TAnimate;
    Label1: TLabel;
    Label2: TLabel;
    procedure G1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N3Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  str:string;
  a:array[1..9]of tpanel;
  step,step2,nodenum:integer;
  position:ptnode;//节点在open或closed中的位置
  path,lopen,lclosed:ptnode;
  ee:boolean;
implementation

uses about;

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
 for i:=1 to 9 do
  a[i]:=tpanel.Create(nil);
end;


procedure shifang(b:ptnode);
var temp:ptnode;
begin
 while b.next<>nil do
  begin
  temp:=b.next;
  b.next:=temp.next;
  dispose(temp);
  end;
end;

procedure newgame;
//初始化
var
  i,c:integer;
begin
 if ee=true then
 shifang(path);
 step:=0;
 form1.N2.Enabled:=true;
 form1.Label2.Caption:='0';
 form1.Button1.Enabled:=false;
 str:='';
 for i:=1 to 9 do
 begin
  repeat c:=Random(9) until pos(inttostr(c),str)=0;
  str:=str+inttostr(c);
 end;
  a[1]:=form1.Panel1;
  a[2]:=form1.Panel2;
  a[3]:=form1.Panel3;
  a[4]:=form1.Panel4;
  a[5]:=form1.Panel5;
  a[6]:=form1.Panel6;
  a[7]:=form1.Panel7;
  a[8]:=form1.Panel8;
  a[9]:=form1.Panel9;
  for i:=1 to 9 do
   begin
     if  str[i]='0' then
     begin
     a[i].BevelInner:=bvLowered;
     a[i].Caption:='';
     end
    else
     begin
     a[i].BevelInner:=bvNone;
     a[i].Caption:=str[i];
     end;
   end;
end;

procedure TForm1.G1Click(Sender: TObject);
begin
 newgame;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
 ee:=false;
 Randomize;
 newgame;
end;
procedure change(i,j:integer;var sr:string);
//交换字符和panel的位置，以实现空格移动
//其中j为原来空格的位置，i为待交换的数字位置
//交换后i为空格位置
var
 temp:char;
begin
 temp:=sr[i];
 sr[i]:=sr[j];
 sr[j]:=temp;
 a[i].Caption:='';
 a[j].Caption:=sr[j];
 a[i].BevelInner:=bvLowered;
 a[j].BevelInner:=bvNone;
end;

procedure TForm1.Panel1Click(Sender: TObject);
var
t:integer;
begin
if (sender as tpanel).BevelInner<>bvLowered then
 begin
  t:=(Sender as tpanel).Tag;
  //空格右移
  if (t mod 3<>1) and (str[t-1]='0') then
      begin change(t,t-1,str); step:=step+1;end;
  //空格左移
  if (t mod 3<>0) and (str[t+1]='0') then
      begin change(t,t+1,str);step:=step+1; end;
  //空格下移
  if ((t-1) div 3>0) and (str[t-3]='0')then
      begin  change(t,t-3,str);step:=step+1; end;
  //空格上移
  if ((t-1) div 3 <2) and (str[t+3]='0') then
      begin change(t,t+3,str);step:=step+1; end;

  label2.Caption:=inttostr(step);
  if str='123456780' then
   begin
   application.messagebox('你好厉害哦！','九宫格',mb_ok+mb_iconinformation);
   form1.N2.Enabled:=false;
   exit;
   end;
  if str='123456870' then
   begin
   application.messagebox('此次不可解！','九宫格',mb_ok+mb_iconinformation);
   form1.N2.Enabled:=false;
   exit;
   end;
 end;
end;

function countnum(ss:string):integer;
//计算ss串和'12345678'串中字符位置不同的个数
//返回值为该不同个数的4倍，作为估价函数
var
 i,n:integer;
 s:string;
begin
 n:=0;
 s:='12345678';
 for i:=1 to 8 do
  if pos(s[i],ss)<>i then
    n:=n+1;
 countnum:=4*n;
end;

function count(ss:string):integer;
//计算h2
var
 i,n,m:integer;
 s:string;
begin
 n:=0;
 s:='123456780';
 for i:=1 to 9 do
   begin
    m:=pos(s[i],ss);
    n:=n+(abs(m-i)mod 3)+(abs(m-i)div 3);
   end;
 count:=n;
end;

procedure changestr(i,j:integer;var ss:string);
//交换字符串中两个字符的位置
var
 temp:char;
begin
 temp:=ss[i];
 ss[i]:=ss[j];
 ss[j]:=temp;
end;

function search(a,q:ptnode):boolean;
//搜索q是否为表a中的节点 position为q在a中的位置的前一个节点
var
 p:ptnode;
 search1:boolean;
begin
 search1:=false;
 position:=a;
 p:=a.next;
 while (p<>nil)do
  if (q.s<>p.s) then
    begin
     p:=p.next;
     position:=position.next;
    end
   else break;
 if (p<>nil) then
   search1:=true;
 search:=search1;
end;

function generate(ss:string; p:ptnode):ptnode;
//生成节点
var
 q:ptnode;
begin
 new(q);
 q.s:=ss;
 q.g:=p.g+1;
 if form1.radiogroup1.itemindex =0 then
   q.h:=countnum(ss)
 else q.h:=count(ss);
 q.parent:=p;
 generate:=q;
end;

procedure extend(var open,closed,p1:ptnode);
//扩展节点
var
 p,qq:ptnode;
 prior:ptnode;//要插入的位置的前一个节点的指针
begin
  if search(open,p1) then
    begin
     if (p1.g<position.next.g) then
       begin
         p:=position.next;
         p1.next:=p.next;
         position.next:=p1;
         dispose(p);
       end
     else dispose(p1);
    end
  else if search(closed,p1) then
          begin
           if (p1.h<position.next.h) then
           //if (p1.g<position.next.g) then
             begin
              p:=position.next;
              p1.next:=p.next;
              position.next:=p1;
              p1.parent:=p.parent;
              qq:=closed.next;
              while qq<>nil do
                if qq.parent=p then
                  qq.parent:=p1;
              dispose(p);
             end
           else dispose(p1);
          end
       else begin
             prior:=open;
             p:=open.next;
             while (p<>nil) do
                if ((p.h+p.g)<(p1.h+p1.g)) then
                 begin
                  prior:=prior.next;
                  p:=p.next;
                 end
                else break;
            p1.next:=prior.next;
            prior.next:=p1;
            end;
end;

procedure TForm1.N2Click(Sender: TObject);
//自动完成
var
 p,node,present:ptnode;//p：临时指针
 str1:string;
 zeroposition:integer;
begin
 if ee=true then shifang(path);
 animate1.FileName:='starcross.avi';
 nodenum:=0;
 animate1.visible:=true;
 animate1.Active:=true;
 G1.Enabled:=false;
 N2.Enabled:=false;
 RadioGroup1.Enabled:=false;
 step:=0;
 label2.Caption:=inttostr(step);
 new(lclosed);
 lclosed.next:=nil;
 new(lopen);
 new(p);//lopen,lclosed均带头节点
 lopen.next:=p;
 p.s:=str;
 p.next:=nil;
 p.g:=0;
 p.parent:=nil;
 if radiogroup1.itemindex =0 then
   p.h:=countnum(str)
 else p.h:=count(str);
 while (lopen.next<>nil) do
   begin
    if(lopen.next.s<>'123456780')and(lopen.next.s<>'123456870') then
     begin
      application.ProcessMessages;
      nodenum:=nodenum+1;
      statusbar1.Panels[1].Text:=inttostr(nodenum);
      p:=lopen.next;
      lopen.next:=p.next;
      p.next:=lclosed.next;
      lclosed.next:=p;
      str1:=p.s;
      zeroposition:=pos('0',str1);
       if (zeroposition mod 3)<>1 then
         begin
          changestr(zeroposition,zeroposition-1,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if (zeroposition mod 3)<>0 then
         begin
          changestr(zeroposition,zeroposition+1,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if ((zeroposition-1)div 3)>0 then
         begin
          changestr(zeroposition,zeroposition-3,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if ((zeroposition-1)div 3)<2 then
         begin
          changestr(zeroposition,zeroposition+3,str1);
          present:=generate(str1,p);
          if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
     end
   else break;

   end;
if (lopen.next.s='123456780') then
   begin
      new(path);
      path.next:=nil;
      new(node);
      node.s:=lopen.next.s;
      node.h:=lopen.next.h;
      node.g:=lopen.next.g;
      node.parent:=lopen.next.parent;
      node.next:=path.next;
      path.next:=node;
      step2:=1;
      if path.next.parent=nil then
      begin
      application.messagebox('自动步进完成','九宫格',mb_ok+mb_iconinformation);
      animate1.visible:=false;
      animate1.Active:=false;
      exit;
      end
      else begin
            while path.next.parent.s<>str do
             begin
               new(node);
               node.s:=path.next.parent.s;
               node.h:=path.next.parent.h;
               node.g:=path.next.parent.g;
               node.parent:=path.next.parent.parent;
               node.next:=path.next;
               path.next:=node;
               step2:=step2+1;
             end;
            button1.Enabled:=true;
            application.MessageBox('请点下一步','九宫格',mb_ok+mb_iconinformation);
            label2.Caption:='0/'+inttostr(step2);
            ee:=false;
           end;
   end
 else
   application.messagebox('此次不可解！','九宫格',mb_ok+mb_iconinformation);
 shifang(lopen);
 shifang(lclosed);
 G1.Enabled:=true;
 N2.Enabled:=true;
 RadioGroup1.Enabled:=True;
 animate1.visible:=false;
 animate1.Active:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 p:ptnode;
 i:integer;
begin
 step:=step+1;
 label2.Caption:=inttostr(step)+'/'+inttostr(step2);
 p:=path.next;
 path.next:=p.next;
for i:=1 to 9 do
   begin
     if p.s[i]='0' then
     begin
     a[i].BevelInner:=bvLowered;
     a[i].Caption:='';
     end
    else
     begin
     a[i].BevelInner:=bvNone;
     a[i].Caption:=p.s[i];
     end;
   end;
 if p.s='123456780' then
  begin
    form1.Button1.Enabled:=false;
    application.messagebox('自动步进完成','九宫格',mb_ok+mb_iconinformation);
  end;
  dispose(p);
  ee:=true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if lopen<>nil then dispose(lopen);
 if lclosed<>nil then dispose(lclosed);
 if ee=true then shifang(path);
 if path<>nil then dispose(path);
end;

procedure TForm1.N3Click(Sender: TObject);
begin
 application.CreateForm(Tfrm_about,frm_about);
 frm_about.showmodal;
 frm_about.Free ;
end;

procedure TForm1.E1Click(Sender: TObject);
begin
  close;
end;

end.