和八皇后问题同样有名的，是马的遍历问题。 中国象棋的棋盘(9*10的棋盘)，指定起点位置放上一只马。要求马不重复地跳完棋盘每个格子一次，最后刚好落在指定终点上。 如果指定起点和指定终点形成一个马步，则遍历后刚好能回到起点。 算法和八皇后问题的最后一个程序一样，采用了改进的拉斯维加斯算法(j.t.chang's LV)。 例如下面是从(1,1)遍历棋盘到(3,2)的一种解法： 01 04 35 80 89 28 37 26 31 82 79 90 03 36 33 30 23 38 05 02 81 34 29 88 27 32 25 78 83 18 87 20 57 24 39 22 17 06 77 84 09 86 21 58 55 76 49 08 19 72 59 56 65 40 07 16 75 10 85 66 41 54 43 48 13 50 73 60 71 44 67 64 15 74 11 46 51 62 69 42 53 12 47 14 61 70 45 52 63 68 {    中国象棋的棋盘上，指定起点，放一只马，马不重复跳完棋盘各格一次，最后落在指定终点上。  } Const  maxx = 9;        maxy = 10;        dn = maxx*maxy;        dx :array[1..8] of integer = (1,2,-1,-2,-2,-1, 1, 2);        dy :array[1..8] of integer = (2,1, 2, 1,-1,-2,-2,-1); Type        point_rec = record            x, y : integer;        end; var     a : array[-1..maxx+2,-1..maxy+2] of integer;     Stk : array[1..dn] of point_rec;     i,j :integer;     tab:array[1..maxx,1..maxy] of integer;     test:boolean;     tmpx,tmpy:integer; procedure Init; var i,j,k:integer; begin     for i:=-1 to maxx+2 do        for j:=-1 to maxy+2 do           if (i>0) and (i<maxx+1) and (j>0) and (j<maxy+1) then  a[i,j]:=0             else a[i,j]:=-1;     fillchar (tab,sizeof(tab),0);     for i:=1 to maxx do       for j:=1 to maxy do         for k := 1 to 8 do               if  a[i+dx[k],j+dy[k]]=0 then  tab[i,j]:=tab[i,j]+1; end; procedure print(x0,y0,x1,y1:integer); var i,j: integer;    begin       write(maxx,'*',maxy);       writeln('(':4,x0,',',y0,') -> (',x1,',',y1,')');       for j:=1 to maxy do          begin               for i:=1 to maxx do                    write(a[i,j]:5);              writeln;           end;      writeln;    readln; end; procedure HorseLV(x0,y0,x1,y1:integer); var     i,j,x,y,k,m,t,stop,r: integer; begin      if odd(dn) and odd(x0+y0) then          begin              writeln('No path at (',x0,',',y0,') ');              exit;          end;       if odd(dn) then         begin             if  odd(x1+y1) then                begin                    writeln('No path.');                    exit;                end;         end        else  if not ( odd(x0+y0) xor   odd(x1+y1) )  then                   begin                       writeln('No path.');                       exit;                   end;       init;       stop :=0;       i := 1;    x := x0;  y := y0;       a[x,y] := 1;       Stk[i].x := x;       Stk[i].y := y;       for k:=1 to 8 do         if a[x+dx[k],y+dy[k]]<>-1 then                tab[x+dx[k],y+dy[k]] := tab[x+dx[k],y+dy[k]] -1;       while i < dn  do         begin            m:=0;            for k:=1 to 8 do              if  (a[x+dx[k],y+dy[k]]=0) then                 begin                      m:=m+1;                      if m = 1 then t := k;                      if (tab[x+dx[k],y+dy[k]]>0)  and (random(tab[x+dx[k],y+dy[k]])=0)  then                        begin                           if (x+dx[k]=x1) and (y+dy[k] =y1) then                              begin                                if random(m)=0 then  t := k                              end                          else   t := k;                        end;                 end;               if (x+dx[t]=x1) and (y+dy[t]=y1) and (i<>dn-1) then  m :=0;               if (m<>0)  then                     begin                         i := i+1;                         x := x + dx[t];                         y := y + dy[t];                         Stk[i].x := x;                         Stk[i].y := y;                         a[x,y] := i;                         for k:=1 to 8 do                             if a[x+dx[k],y+dy[k]]<>-1 then                                     tab[x+dx[k],y+dy[k]] := tab[x+dx[k],y+dy[k]] -1;                     end                 else                    begin                         stop := stop +1 ;                         j := i - stop;                         if j<1 then                              begin                                 j := 1;                                 stop := 0;                               end;                         for k := i  downto j+1 do                            begin                                a[Stk[k].x,Stk[k].y] := 0;                                for r:=1 to 8 do                                    if  a[Stk[k].x+dx[r],Stk[k].y+dy[r]] <> -1 then                                          tab[Stk[k].x+dx[r],Stk[k].y+dy[r]]:= tab[Stk[k].x+dx[r],Stk[k].y+dy[r]]+1;                            end;                         i := j;                         x := Stk[i].x;                         y := Stk[i].y;                    end         end;         print(x0,y0,x1,y1); end; begin     Randomize;     write('Enter start point x y : '); readln(i,j);     write('Enter end   point x y : '); readln(tmpx,tmpy);     HorseLV(i,j,tmpx,tmpy); end.

评论