level 9
jyinuo1999
楼主
Const
StackSize=64;
type
TState=array[1..3] of integer;
TStateStruc=Record
State:TState;
BranchCode:integer;
end;
var
a,b:TState;
Stack:array[1..StackSize] of TStateStruc;
StackTop:integer;
FoundNewState:boolean;
i:integer;
function Equal(State1,State2:TState):boolean;
begin
if (State1[1]=State2[1]) and
(State1[2]=State2[2]) and
(State1[3]=State2[3]) then
Equal:=True
else
Equal:=false;
end;
procedure Push(AState:TState;ACode:integer);
begin
StackTop:=StackTop+1;
Stack[StackTop].State:=AState;
Stack[StackTop].BranchCode:=ACode;
end;
procedure pop(var AState:TState;var ACode:integer);
begin
AState:=Stack[StackTop].State;
ACode:=Stack[StackTop].BranchCode;
StackTop:=StackTop-1;
end;
procedure CreateNewState(State:TState;var NewState:TState;Code:integer);
begin
NewState:=State;
Case Code of
1:if State[1]>=(5-State[2]) then
begin
NewState[1]:=State[1]-(5-State[2]);
NewState[2]:=5;
end
else
begin
NewState[2]:=State[2]+State[1];
NewState[1]:=0;
end;
2:if State[1]>=(3-State[3]) then
begin
NewState[1]:=State[1]-(3-State[3]);
NewState[3]:=3;
end
else
begin
NewState[3]:=State[3]+State[1];
NewState[1]:=0;
end;
3:if State[2]>=(8-State[1]) then
begin
NewState[2]:=State[2]-(8-State[1]);
NewState[1]:=8;
end
else
begin
NewState[2]:=State[2]+State[1];
NewState[2]:=0;
end;
4:if State[2]>=(3-State[3]) then
begin
NewState[2]:=State[2]-(3-State[3]);
NewState[3]:=3;
end
else
begin
NewState[3]:=State[2]+State[3];
NewState[2]:=0;
end;
5:if State[3]>=(8-State[1]) then
begin
NewState[3]:=State[3]-(8-State[1]);
NewState[1]:=8;
end
else
begin
NewState[1]:=State[3]+State[1];
NewState[3]:=0;
end;
6:if State[3]>=(5-State[2]) then
begin
NewState[3]:=State[3]-(5-State[2]);
NewState[2]:=5;
end
else
begin
NewState[2]:=State[2]+State[3];
NewState[3]:=0;
end;
end;
end;
function InStack(AState:TState):boolean;
var
i:integer;
begin
InStack:=false;
for i:=1 to StackTop do
if Equal(Stack[i].State,AState) then
begin
InStack:=true;
Break;
end;
end;
begin
a[1]:=8;a[2]:=0;a[3]:=0;
i:=1;
StackTop:=0;
while not ((a[1]=4) and (a[2]=4) and (a[3]=0)) do
begin
FoundNewState:=false;
while (not FoundNewState) and (i<=6) do
begin
CreateNewState(a,b,i);
if InStack(b) or Equal(a,b) then
i:=i+1
else
FoundNewState:=true;
end;
if FoundNewState then
begin
Push(a,i);
a:=b;
i:=1;
end
else
begin
pop(a,i);
i:=i+1;
end;
end;{while}
push(a,i);
writeln('********');
for i:=1 to StackTop do
with Stack[i] do
Writeln(State[1],',',State[2],',',State[3]);
readln;
end.
2015年04月23日 04点04分
1
StackSize=64;
type
TState=array[1..3] of integer;
TStateStruc=Record
State:TState;
BranchCode:integer;
end;
var
a,b:TState;
Stack:array[1..StackSize] of TStateStruc;
StackTop:integer;
FoundNewState:boolean;
i:integer;
function Equal(State1,State2:TState):boolean;
begin
if (State1[1]=State2[1]) and
(State1[2]=State2[2]) and
(State1[3]=State2[3]) then
Equal:=True
else
Equal:=false;
end;
procedure Push(AState:TState;ACode:integer);
begin
StackTop:=StackTop+1;
Stack[StackTop].State:=AState;
Stack[StackTop].BranchCode:=ACode;
end;
procedure pop(var AState:TState;var ACode:integer);
begin
AState:=Stack[StackTop].State;
ACode:=Stack[StackTop].BranchCode;
StackTop:=StackTop-1;
end;
procedure CreateNewState(State:TState;var NewState:TState;Code:integer);
begin
NewState:=State;
Case Code of
1:if State[1]>=(5-State[2]) then
begin
NewState[1]:=State[1]-(5-State[2]);
NewState[2]:=5;
end
else
begin
NewState[2]:=State[2]+State[1];
NewState[1]:=0;
end;
2:if State[1]>=(3-State[3]) then
begin
NewState[1]:=State[1]-(3-State[3]);
NewState[3]:=3;
end
else
begin
NewState[3]:=State[3]+State[1];
NewState[1]:=0;
end;
3:if State[2]>=(8-State[1]) then
begin
NewState[2]:=State[2]-(8-State[1]);
NewState[1]:=8;
end
else
begin
NewState[2]:=State[2]+State[1];
NewState[2]:=0;
end;
4:if State[2]>=(3-State[3]) then
begin
NewState[2]:=State[2]-(3-State[3]);
NewState[3]:=3;
end
else
begin
NewState[3]:=State[2]+State[3];
NewState[2]:=0;
end;
5:if State[3]>=(8-State[1]) then
begin
NewState[3]:=State[3]-(8-State[1]);
NewState[1]:=8;
end
else
begin
NewState[1]:=State[3]+State[1];
NewState[3]:=0;
end;
6:if State[3]>=(5-State[2]) then
begin
NewState[3]:=State[3]-(5-State[2]);
NewState[2]:=5;
end
else
begin
NewState[2]:=State[2]+State[3];
NewState[3]:=0;
end;
end;
end;
function InStack(AState:TState):boolean;
var
i:integer;
begin
InStack:=false;
for i:=1 to StackTop do
if Equal(Stack[i].State,AState) then
begin
InStack:=true;
Break;
end;
end;
begin
a[1]:=8;a[2]:=0;a[3]:=0;
i:=1;
StackTop:=0;
while not ((a[1]=4) and (a[2]=4) and (a[3]=0)) do
begin
FoundNewState:=false;
while (not FoundNewState) and (i<=6) do
begin
CreateNewState(a,b,i);
if InStack(b) or Equal(a,b) then
i:=i+1
else
FoundNewState:=true;
end;
if FoundNewState then
begin
Push(a,i);
a:=b;
i:=1;
end
else
begin
pop(a,i);
i:=i+1;
end;
end;{while}
push(a,i);
writeln('********');
for i:=1 to StackTop do
with Stack[i] do
Writeln(State[1],',',State[2],',',State[3]);
readln;
end.