8数码 A*

终于初步学会了A*，也把这个一直留着的8数码AC掉了。
A*的速度的确很快很强大。。。写得这么丑的代码都那么快。。。

PS：我用的启发函数是每个数字当前位置到目标位置的曼哈顿距离之和。

过两天有空写个 A* 的详细解释，也算对这几天研究的一个总结。

program number8;
const
　maxState = 100000;
　Mask: array [0..9] of Longint = (1000000000, 100000000, 10000000, 1000000, 100000, 10000, 1000, 100, 10, 1);
　Ori: array [1..8, 1..2] of Longint = ((1, 1), (1, 2), (1, 3), (2, 3), (3, 3), (3, 2), (3, 1), (2, 1));

type
　TOpenState = record
　　P, F, G: Longint
　end;
　
　TClosedState = record
　　State, P: Longint
　end;

var
　State: array [1..3, 1..3] of Longint;
　i, j: Longint;
　a, b: Longint;
　OpenCount, CloseCount: Longint;
　Open: array [1..maxState] of TOpenState;
　Closed: array [1..maxState] of TClosedState;
　Current, CurrentG: Longint;
　
procedure Swap(a, b: Longint);
var
　T: TOpenState;
　
begin
　T := Open[a];
　Open[a] := Open[b];
　Open[b] := T;
　Closed[Open[a].P].P := a;
　Closed[Open[b].P].P := b
end;

procedure Decrease_Key(t, dstF, dstG: Longint);
var
　u: Longint;
　
begin
　u := t;
　Open[u].F := dstF;
　Open[u].G := dstG;
　while (u > 1) and (Open[u div 2].F > Open[u].F) do
　　begin
　　　Swap(u, u div 2);
　　　u := u div 2
　　end
end;

function Extract_Min: Longint;
var
　u: Longint;
　
begin
　Closed[Open[1].P].P := 0;
　Current := Closed[Open[1].P].State;
　Extract_Min := Open[1].G;
　Open[1] := Open[OpenCount];
　dec(OpenCount);
　u := 1;
　while True do
　　if (u * 2 <= OpenCount) and (Open[u * 2].F < Open[u].F) then
　　　begin
　　　　Swap(u, u * 2);
　　　　u := u * 2
　　　end
　　else if (u * 2 + 1 <= OpenCount) and (Open[u * 2 + 1].F < Open[u].F) then
　　　begin
　　　　Swap(u, u * 2 + 1);
　　　　u := u * 2 + 1
　　　end
　　else
　　　break
end;

function CalculateH: Longint;
var
　i, j: Longint;
　
begin
　CalculateH := 0;
　for i := 1 to 3 do
　　for j := 1 to 3 do
　　　if State[i, j] <> 0 then
　　　　inc(CalculateH, abs(i - Ori[State[i, j], 1]) + abs(j - Ori[State[i, j], 2]))
end;

procedure Expand(a, b, da, db: Longint);
var
　i, j: Longint;
　NowF, NowState: Longint;
　Flag: Boolean;
　
begin
　State[a, b] := State[da, db];
　State[da, db] := 0;
　Flag := False;
　NowState := 0;
　for i := 1 to 3 do
　　for j := 1 to 3 do
　　　inc(NowState, State[i, j] * Mask[(i - 1) * 3 + j]);
　NowF := CurrentG + 1 + CalculateH;
　for i := 1 to CloseCount do
　　if Closed[i].State = NowState then
　　　begin
　　　　Flag := True;
　　　　if (Closed[i].P <> 0) and (NowF <= Open[Closed[i].P].F) then
　　　　　Decrease_Key(Closed[i].P, NowF, CurrentG + 1)
　　　end;
　if not Flag then
　　begin
　　　inc(CloseCount);
　　　inc(OpenCount);
　　　Closed[CloseCount].State := NowState;
　　　Closed[CloseCount].P := OpenCount;
　　　Open[OpenCount].P := CloseCount;
　　　Open[OpenCount].F := MaxLongint;
　　　Decrease_Key(OpenCount, NowF, CurrentG + 1)
　　end;
　State[da, db] := State[a, b];
　State[a, b] := 0
end;

begin
　fillchar(Open, sizeof(Open), 0);
　fillchar(Closed, sizeof(Closed), 0);
　OpenCount := 1;
　CloseCount := 1;
　readln(Closed[1].State);
　Closed[1].P := 1;
　Open[1].G := 0;
　Open[1].P := 1;
　while OpenCount > 0 do
　　begin
　　　CurrentG := Extract_Min;
　　　if Current = 123804765 then
　　　　begin
　　　　　writeln(CurrentG);
　　　　　halt
　　　　end;
　　　for i := 1 to 3 do
　　　　for j := 1 to 3 do
　　　　　begin
　　　　　　State[i, j] := Current mod Mask[(i - 1) * 3 + j - 1] div Mask[(i - 1) * 3 + j];
　　　　　　if State[i, j] = 0 then
　　　　　　　begin
　　　　　　　　a := i;
　　　　　　　　b := j
　　　　　　　end
　　　　　end;
　　　if a > 1 then
　　　　Expand(a, b, a - 1, b);
　　　if a < 3 then
　　　　Expand(a, b, a + 1, b);
　　　if b > 1 then
　　　　Expand(a, b, a, b - 1);
　　　if b < 3 then
　　　　Expand(a, b, a, b + 1)
　　end
end.