unit1.~pas

九宫重排

   a,b:boolean;
 begin
    b:=true;
    for  j:=1  to 3 do
    begin
      for  k:=1  to 3 do
      begin
       if a1[j,k]<>a2[j,k] then
         begin
         b:=false;
         end;
     end;
    end;

   isequal:=b;
 end;
 procedure Tform1.append_open(nn:Tnode);
 var
 i:integer;
 begin
  //if nn.layer<=spinedit1.Value then
   // begin
    for i:=1 to 10000 do
   begin
     if open_ex[i].parent=-2  then begin open_ex[i]:=nn;break;end;
   end;
   //end;
 end;
  function Tform1.h(sa:Tnode;md:string):integer;
  var
  t:array[1..8,1..2] of byte;
  j,k,m,wn,pn:integer;
   begin
   m:=0;
   wn:=0;
   pn:=0;
   //t[0,1]:=2; t[0,2]:=2;
   t[1,1]:=1; t[1,2]:=1;// suan pn yong
   t[2,1]:=1; t[2,2]:=2;
   t[3,1]:=1; t[3,2]:=3;
   t[4,1]:=2; t[4,2]:=3;
   t[5,1]:=3; t[5,2]:=3;
   t[6,1]:=3; t[6,2]:=2;
   t[7,1]:=3; t[7,2]:=1;
   t[8,1]:=2; t[8,2]:=1;
   //suan wn
   if sa.status[1,1]<>1 then
     begin
     wn:=wn+1;
     if sa.status[1,2]<>2 then pn:=pn+1;
     if sa.status[2,1]<>8 then pn:=pn+1;
     end;
   if sa.status[1,2]<>2 then
     begin
     wn:=wn+1;
     if sa.status[1,1]<>1 then pn:=pn+1;
     if sa.status[2,2]<>0 then pn:=pn+1;
     if sa.status[1,3]<>3 then pn:=pn+1;
     end;
   if sa.status[1,3]<>3 then
     begin
     wn:=wn+1;
     if sa.status[1,2]<>2 then pn:=pn+1;
     if sa.status[2,3]<>4 then pn:=pn+1;
     end;
   if sa.status[2,1]<>8 then
     begin
     wn:=wn+1;
     if sa.status[1,1]<>1 then pn:=pn+1;
     if sa.status[2,2]<>0 then pn:=pn+1;
     if sa.status[3,1]<>7 then pn:=pn+1;
     end;

   if sa.status[2,2]<>0 then
     begin
     wn:=wn+1;
     if sa.status[1,2]<>2 then pn:=pn+1;
     if sa.status[2,1]<>8 then pn:=pn+1;
     if sa.status[2,3]<>4 then pn:=pn+1;
     if sa.status[3,2]<>6 then pn:=pn+1;
     end;
   if sa.status[2,3]<>4 then
     begin
     wn:=wn+1;
     if sa.status[1,3]<>3 then pn:=pn+1;
     if sa.status[2,2]<>0 then pn:=pn+1;
     if sa.status[3,3]<>5 then pn:=pn+1;
     end;
   if sa.status[3,1]<>7 then
     begin
     wn:=wn+1;
     if sa.status[2,1]<>8 then pn:=pn+1;
     if sa.status[3,2]<>6 then pn:=pn+1;
     end;
   if sa.status[3,2]<>6 then
     begin
     wn:=wn+1;
     if sa.status[3,3]<>5 then pn:=pn+1;
     if sa.status[2,2]<>0 then pn:=pn+1;
     if sa.status[3,1]<>7 then pn:=pn+1;
     end;
   if sa.status[3,3]<>5 then
     begin
     wn:=wn+1;
     if sa.status[2,3]<>4 then pn:=pn+1;
     if sa.status[3,2]<>6 then pn:=pn+1;
     end;
   for j:=1 to 3 do
     begin
     for k:=1 to 3 do
    begin
      if sa.status[j,k]<>0 then m:=m+(abs(t[sa.status[j,k]][1]-j)+abs(t[sa.status[j,k]][2]-k));
     end;
     end;
    //h:=m+sa.layer+wn;//;
   if md='df' then h:=-sa.layer;//-(sa.layer div 10);
   if md='wf' then h:=sa.layer+m+wn;//
  //h:=3*pn;
   end;
procedure TForm1.BitBtn2Click(Sender: TObject); /////second
begin
button2.Enabled:=true;
search('sou');
button1.Enabled:=true;
button2.Enabled:=false;
end;
procedure TForm1.sort;
var
ii,i,nn,m,p:integer;
tem:Tnode;
begin
  for i:=1 to 10000 do
   begin
    if open_ex[i].parent=-2 then begin ii:=i-1;break;end
   end;

  m:=2;
       for p:=1 to ii do
        begin
          for nn :=ii  downto m do
            begin
            if open_ex[nn].s<open_ex[nn-1].s then
                begin
                  tem:=open_ex[nn-1];
                  open_ex[nn-1]:=open_ex[nn];
                  open_ex[nn]:=tem;
                end;
            end;
            m:=m+1;
        end;


end;

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
//RadioGroup1.Visible:=false;
button3.Enabled:=true;
edit2.Text:='0';
bitbtn2.Enabled:=true;
wf_over:=false;
button2.Enabled:=true;
  draw(root);
 for i:=1 to 10000 do
  begin
   open_ex[i].parent:=-2;
   //open_ex[i].status:=(((0,0,0),(0,0,0),(0,0,0)));
  //new(open_ex[i].pchild);
    open_ex[i].s:=0;
     open_ex[i].children[1]:=0; open_ex[i].children[2]:=0;  open_ex[i].children[3]:=0; open_ex[i].children[4]:=0;

   close_ex[i].parent:=-2;
   //close_ex[i].status:=((0,0,0),(0,0,0),(0,0,0));
     close_ex[i].children[1]:=0;close_ex[i].children[2]:=0; close_ex[i].children[3]:=0; close_ex[i].children[4]:=0;
     close_ex[i].s:=0;
  end;
end;
procedure TForm1.reset;
var
i:integer;
begin
 for i:=1 to 10000 do
  begin
   open_ex[i].parent:=-2;
    open_ex[i].s:=0;
     open_ex[i].children[1]:=0; open_ex[i].children[2]:=0;  open_ex[i].children[3]:=0; open_ex[i].children[4]:=0;

   close_ex[i].parent:=-2;
     close_ex[i].children[1]:=0;close_ex[i].children[2]:=0; close_ex[i].children[3]:=0; close_ex[i].children[4]:=0;
     close_ex[i].s:=0;
  end;
end;

procedure TForm1.draw(a: T3x3);
begin

maskedit1.Text:=inttostr(a[1,1]);if maskedit1.Text='0' then begin maskedit1.Color:=rgb(0,0,255); end else begin  maskedit1.Color:=clwhite;end;
maskedit2.Text:=inttostr(a[1,2]);if maskedit2.Text='0' then begin maskedit2.Color:=rgb(0,0,255); end else begin  maskedit2.Color:=clwhite;end;
maskedit3.Text:=inttostr(a[1,3]);if maskedit3.Text='0' then begin maskedit3.Color:=rgb(0,0,255); end else begin  maskedit3.Color:=clwhite;end;
maskedit4.Text:=inttostr(a[2,1]);if maskedit4.Text='0' then begin maskedit4.Color:=rgb(0,0,255); end else begin  maskedit4.Color:=clwhite;end;
maskedit5.Text:=inttostr(a[2,2]);if maskedit5.Text='0' then begin maskedit5.Color:=rgb(0,0,255); end else begin  maskedit5.Color:=clwhite;end;
maskedit6.Text:=inttostr(a[2,3]);if maskedit6.Text='0' then begin maskedit6.Color:=rgb(0,0,255); end else begin  maskedit6.Color:=clwhite;end;
maskedit7.Text:=inttostr(a[3,1]);if maskedit7.Text='0' then begin maskedit7.Color:=rgb(0,0,255); end else begin  maskedit7.Color:=clwhite;end;
maskedit8.Text:=inttostr(a[3,2]);if maskedit8.Text='0' then begin maskedit8.Color:=rgb(0,0,255); end else begin  maskedit8.Color:=clwhite;end;
maskedit9.Text:=inttostr(a[3,3]);if maskedit9.Text='0' then begin maskedit9.Color:=rgb(0,0,255); end else begin  maskedit9.Color:=clwhite;end;
end;
  procedure Tform1.delay_c(ms:longint); //
    var
    t:longint;
    begin
    t:=gettickcount;
    while(gettickcount-t)<ms do
    application.ProcessMessages;
    end;
 procedure Tform1.pai; //
    var
    n:integer;
    begin
                for n:=steps downto 1 do
                 begin
                   delay_c(500);
                   draw(close_ex[path[n]].status);  //
                 end;
                  delay_c(500);
                  draw(target);
    end;

procedure TForm1.Button2Click(Sender: TObject);
begin
wf_over:=true;
Button2.Enabled:=false;
bitbtn2.Enabled:=false;
Button1.Enabled:=true;
//RadioGroup1.Visible:=false;
end;

function TForm1.init:boolean;
var
m,j,k:BYTE;
begin
 M:=0;
 root[1,1]:=strtoint(maskedit1.Text);
 root[1,2]:=strtoint(maskedit2.Text);
 root[1,3]:=strtoint(maskedit3.Text);
 root[2,1]:=strtoint(maskedit4.Text);
 root[2,2]:=strtoint(maskedit5.Text);
 root[2,3]:=strtoint(maskedit6.Text);
 root[3,1]:=strtoint(maskedit7.Text);
 root[3,2]:=strtoint(maskedit8.Text);
 root[3,3]:=strtoint(maskedit9.Text);
 FOR J:=1 TO 3 DO
  BEGIN
    for  K:= 1 to 3 do
    begin
     m:=m+ROOT[J,K];
    end;
  END;
 if m<>36 then
  begin
   showmessage('棋局有错误，请检查!');
   init:=false;
  end else begin
   init:=true;
   end;
end;


procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  if RadioGroup1.ItemIndex=0 then button4.Visible:=true;
  if RadioGroup1.ItemIndex<>0 then button4.Visible:=false;
end;

procedure TForm1.Button4Click(Sender: TObject);
    begin
 steps:=steps-1;
 if steps<=0 then begin  draw(target);showmessage('ok');exit;end;
 
 draw(close_ex[path[steps]].status);  //
 
end;
procedure TForm1.rand;
 begin
 search('rand');
 draw(rand3x3);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
rand;
button1.Enabled:=false;
end;

procedure TForm1.search(model:string);
var
j,k,i,m,n,p:integer;
flag:byte;
rs:integer;// 随即排序的次数
label l1;
begin
//Timer1.Enabled:=true;;
if init=false then exit;
Button1.Enabled:=false;
if model='sou' then button3.Enabled:=false;
    
    reset;
     flag:=2;
     i:=1;
       open_ex[1].parent:=-1;
       if model='sou' then  open_ex[1].status:=root;
       if model='rand' then  open_ex[1].status:=target;
       open_ex[1].layer:=1;
       randomize;
       rs:=200+random(1000);
      l1:  if wf_over=true then begin showmessage('sorry!');exit; wf_over:=false;end;
            op_cl;
        //expand root
       for i:=1 to 10000 do
         begin
         application.ProcessMessages;
         if close_ex[i].parent=-2 then
            begin


                if model='sou' then  flag:=expand(i-1,'wf');
                if model='rand' then
                   begin

                     flag:=expand(i-1,'df');
                     if close_ex[i-1].layer>rs then begin rand3x3:=close_ex[i-1].status;exit;end;
                   end;
              if model='sou' then edit2.Text:=inttostr(close_ex[i-1].layer);
            break;
            end;
         end;

          if flag=2 then goto l1;
          if flag=3  then begin showmessage('本棋局无解!'); EXIT;END;
     if flag=1  then
      begin
          button3.Enabled:=true;
          showmessage('找到答案！');
             for m:=1 to 200 do
               begin
                if path[m]=1 then
                 begin
                 steps:=m;
                 break;
                 end;
             end;
         if  radiogroup1.ItemIndex=1 then pai;
     END;
end;



procedure TForm1.N2Click(Sender: TObject);
begin
form3.ShowModal;

end;

end.