游戏开发中的经典算法集锦之二

Dijkstra最短路径（一点到各顶点最短路径）

{本程序解决6个顶点之间的最短路径问题,各顶点间关系的数据文件在sj.txt中}
{如果顶点I到顶点J不能直达就设置距离为30000}
program dijkstra;
type
   jihe=set of 0..5;
var
   a:array[0..5,0..5] of integer;
   dist:array[0..5] of integer;
   i,j,k,m,n:integer;
   fv:text;
   s:jihe;
begin
   s:=[0];
   assign(fv,'sj.txt');
   reset(fv);
   for i:=0 to 5 do  {从文件中读数据,其中a[i,j]代表从顶点i到顶点j的直达距离,如果不通用30000代替}
     begin
        for j:=0 to 5 do read(fv,a[i,j]);
        readln(fv)
     end;
   for i:=1 to 5 do  {设置DIST数组的初始值,即为顶点0到各顶点的直达距离(算法的第一步)}
      dist[i]:=a[0,i];
   for i:=1 to 5 do
   begin
        m:=0;
        dist[m]:=30000;    {设置DIST[M]的目的是为下面的一步做准备,即在DIST数组中一个最小的值}

        for j:=1 to 5 do    {算法的第二步,找最小的DIST值}
        if (not (j in s)) and (dist[m]>dist[j]) 
         then m:=j ;    {用M来记录到底是哪个顶点}
        s:=s+[m];    {把顶点加入S中}

        for k:=1 to 5 do     {算法的第三步,修改后面的DIST值}
           if (not (k in s)) and  (dist[k]>dist[m]+a[m,k])
             then
               dist[k]:=dist[m]+a[m,k]
   end;
   writeln('原各顶点间的路径关系是：（30000代表不通）');
   for i:=0 to 5 do
      begin
        for j:=0 to 5 do  write(a[i,j]:6);
        writeln
      end;
   writeln; writeln;

八皇后问题

{问题描述：在国际象棋8X8的棋盘里摆放8个皇后，使每个皇后都能生存而不互相冲突，即同一行、同一列同对角线（包括主对角线和辅对角线）都只能有一个皇后}

program eightqueen;  {本程序可以搜索出所有的解}
var
  a,b:array[1..8] of integer;
  c:array[-7..7] of integer;
  d:array[2..16] of integer;
  i,k:integer;  {K变量用来存放答案的个数}
  fv:text;

  procedure print;
  var
    i:integer;
  begin
    for i:=1 to 8 do
       writeln(fv,'第',i:2, '行放在第', a[i]:2,'列');  {结果输出到文件里}
       k:=k+1;  {每输出一个答案计数加1}
       writeln(fv)
  end;

  procedure try(i:integer);
  var
    j:integer;
  begin
    for j:=1 to 8 do
      if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then
         begin
           a[i]:=j; 
           b[j]:=1; {宣布占领列、主副对角线}
           c[i-j]:=1;
           d[i+j]:=1;
           if i<8 then try(i+1) else print;
           b[j]:=0;  {释放占领列、主副对角线}
           c[i-j]:=0;
           d[i+j]:=0
         end
  end;

begin
  for i:=1 to 8 do a[i]:=0;
  for i:=-7 to 7 do c[i]:=0;
  for i:=2 to 16 do d[i]:=0;
  k:=0;
  assign(fv,'jieguo.txt');  {指定文件与文件变量相联系}
  rewrite(fv);  {以写的方式打开文件}
  try(1);
  close(fv);  {一定要记得关闭文件，不然数据有可能丢失}
  writeln('共有 ',k:3,' 种摆法')
end.

　快速排序算法

program kuaisu(input,output);
const n=10;
var
   s:array[1..10] of integer;
   k,l,m:integer;

procedure qsort(lx,rx:integer);
var
   I,j,t:integer;
Begin
   I:lx;j:rx;t:s[I];
   Repeat
      While (s[j]>t) and (j>I) do
         Begin
            k:=k+1;
            j:=j-1
         end;
   if Ibegin
   s[I]:=s[j];I:=I+1;l:=l+1;
   while (s[I]       begin
          k:=k+1;
          I:=I+1
      End;
   If Ibegin
         S[j]:=s[I];j:=j-1;l:=l+1;
      End;
End;
Until I=j;
S[I]:=t;I:=I+1;j:=j-1;l:=l+1;
If lxIf IEnd;{过程qsort结束}

Begin
Writeln('input 10 integer num:');
For m:=1 to n do read(s[m]);
K:=0;l:=0;
Qsort(l,n);
Writeln('排序后结果是：')；
For m:=1 to n do write(s[m]:4)
 End.
地图四色问题

{问题描述：任何一张地图只要用四种颜色进行填涂，就可以保证相邻省份不同色}

program tt;
const num=20;
var a:array [1..num,1..num] of 0..1;
    s:array [1..num] of 0..4; {用1-4分别代表RBWY四种颜色;0代表末填进任何颜色}
    k1,k2,n:integer;
function pd(i,j:integer):boolean;{判断可行性：第I个省填上第J种颜色}
var k:integer;
begin
     for k:=1 to i-1 do   {一直从第一个省开始进行比较一直到I省减一的那个省，目的是对已经着色的省份来进行比较，因为>I的省还没                           有着色，比较没有意义，着色的顺序是先第一、二、三……I个省}
         if (a[i,k]=1) and (j=s[k]) then {省I和省J相邻且将填进的颜色和已有的颜色相同}
            begin
               pd:=false; {即不能进行着色}
               exit;   {退出当前函数}
            end;
     pd:=true;  {可以进行着色}
end;

procedure print;{打印结果}
var k:integer;
begin
      for k:=1 to n do{将数字转为RBWY串}
          case s[k] of
            1:write('R':4);
            2:write('B':4);
            3:write('W':4);
            4:write('Y':4);
          end;
      writeln;
end;

procedure try(i:integer);
var j:integer;
begin
     for j:=1 to 4 do
         if pd(i,j) then begin
                              s[i]:=j;
                              if i=n then print
                                 else try(i+1);  {对下一个省进行着色}
                              s[i]:=0;  {不能进行着色，将当前状态设置0，即不进行着色}
                          end;
end;

BEGIN
     write('please input city number: '); readln(n);
     writeln('please input the relation of the cities:');
     for k1:=1 to n do
     begin
          for k2:=1 to n do read(a[k1,k2]);  {A[K1，K2]=1表示省K1、K2相邻，为0就不相邻}
          readln;
     end;
     for k1:=1 to n do s[k1]:=0;  {把所有的颜色设置为0，即还没有进行着色}
     try(1);
END.

穿越迷宫

{本程序假设迷宫是一个4 X 4的矩阵，入口在A[1，1]，出口在A[4，4]}
{矩阵数据放在文件shuju3.txt 中}
program mikong;
var
  a,b,c:array[1..4,1..4] of integer;  {数组A用来存放迷宫路径，约定元素值为0表示通，1表示不通}
                                      {数组B用来存放方向增量} 
                                      {数组C用来记录结果，当第I步移到某一元素时，该元素就等于I}
  i,j,k,m,n:integer;
  fv:text;
  q:boolean;  {用来标记迷宫是否有出路}

  procedure print;
  var
     m,n:integer;
  begin
    q:=true;  {如果打印步骤，表示肯定有出路}
    writeln;
    writeln;
    writeln('穿越迷宫的步骤是：');
    for m:=1 to 4 do
      begin
              for n:=1 to 4 do
          write(c[m,n]:4);
        writeln;
      end
  end;

  procedure try(x,y,i:integer);
  var
    u,v,k:integer;
  begin
    for k:=1 to 4 do   {可以有4个方向选择}
      begin
        u:=x+b[k,1];     {当前坐标加上方向增量}
        v:=y+b[k,2];
        if (u>=1) and (u<=4) and (v>=1) and (v<=4) then  {判断是否越界}
          if (a[u,v]=0) and (c[u,v]=0) then    {判断是否为0，为0就表示通，为1就表示不通}
            begin
              if (x=2) and (y=3) then writeln('aaaaaaaaaaaa');
              c[u,v]:=i;  {数组 C打上记号，表示此元素是第I步到达}
              if (u<>4) or (v<>4) then  {判断是否到出口}
                  try(u,v,i+1)  {没有就继续走}
                else   print;
              c[u,v]:=0   {下一路所有方向都不通，清除本次所做的标记}
            end
      end
  end;

 

begin
  assign(fv,'shuju3.txt');
  reset(fv);
  for i:=1 to 4 do
    begin
      for j:=1 to 4 do
        read(fv,a[i,j]);
        readln(fv)
      end;
  b[1,1]:=-1;  b[1,2]:=0;
  b[2,1]:=0;   b[2,2]:=1;
  b[3,1]:=1;   b[3,2]:=0;
  b[4,1]:=0;   b[4,2]:=-1;
  close(fv);
  for i:=1 to 4 do    {首先标记数组C所有元素全部为0}
    for j:=1 to 4 do c[i,j]:=0;
  c[1,1]:=1;
  for i:=1 to 4 do  {显示迷宫具体线路，0表示通，1表示不通}
    begin
      for j:=1 to 4 do
        write(a[i,j]:4);
        writeln
      end;
  q:=false;  {假设迷宫没有出路}
  try(1,1,2);
 if q=false then writeln( '此迷宫没有出路')
end.