queen8.pas

关于课件 好多种结构的算法 等等 大家自己看吧

program queen8(input,output);
VAR
 x:array[1..8] of integer;
 a,b,c:array [-7..16] of boolean;
 i,count:integer;
 ch:char;
procedure print;
var
 k:integer;
begin
 writeln('count=',count);
 for k:=1 to 8 do
 write(x[k]:4);
 writeln;
end;
procedure onestep(m,n:integer);
var
 i,j,k,r,cc,row,col:integer;
 q:array[1..8,1..8] of integer;
begin
 for i:=1 to 8 do
  for j:=1 to 8 do
   q[i,j]:=0;
 for j:=1 to n do
  if x[j]<>0 then
   begin
    row:=x[j];
    col:=j;
    q[row,col]:=-1;
    for k:=col+1 to 8 do q[row,k]:=q[row,k]+1;
    r:=row-1;
    cc:=col+1;
    while (r>0) and (r<=8) and (cc>0) and(cc<=8) do
     begin
      q[r,cc]:=q[r,cc]+1;
      r:=r-1;
      cc:=cc+1;
     end;
    r:=row+1;
    cc:=col+1;
    while (r>0) and (r<=8) and (cc>0) and(cc<=8) do
     begin
      q[r,cc]:=q[r,cc]+1;
      r:=r+1;
      cc:=cc+1;
     end;
    end;
    write('j=');
    for i:=8 downto 1 do
     begin
      if i=8 then  write(i:3) else write(i:5);
      for j:=1 to 8 do
       begin
        if q[i,j]=0 then write('  ')
        else if q[i,j]>0 then write(q[i,j]:2)
             else if q[i,j]=-1 then write(' Q');
       end;
      writeln;
     end;
    writeln('  i=  1 2 3 4 5 6 7 8');
    writeln;
    write('x:':5);
    for i:=1 to n do write(x[i]:2);
    for i:=n+1 to 8 do write(0:2);
    writeln;
    writeln('i=',n,'   j=',m,'   i+j=',m+n,'   i-j=',n-m);
    write('     ');
    for i:=-7 to 16 do write(i:3);
    writeln;
    write('a[',m:2,']');
    for i:=-7 to 16 do if a[i] then write(' ':3) else write('F':3);
    writeln;
    write('b[',m+n:2,']');
    for i:=-7 to 16 do if b[i] then write(' ':3) else write('F':3);
    writeln;
    write('c[',n-m:2,']');
    for i:=-7 to 16 do if c[i] then write(' ':3) else write('F':3);
    writeln;
    readln(ch);
  end;

procedure try(i:integer);
var
 j:integer;
begin
 for j:=1 to 8 do
  if a[j] and b[i+j] and c[i-j] then
   begin
     x[i]:=j;
     a[j]:=false;
     b[i+j]:=false;
     c[i-j]:=false;
     if (ch='c')or(ch='C') then onestep(j,i);
     if i<8 then  try(i+1) else begin count:=count+1; print; end;
     a[j]:=true;
     b[i+j]:=true;
     c[i-j]:=true;
     if (ch='c')or(ch='C') then onestep(x[i-1],i-1);
  end
end;
BEGIN
 count:=0;
 ch:='c';
 for i:=1 to 8 do
  x[i]:=0;
 for i:=-7 to 16 do
  begin
   a[i]:=true;
   b[i]:=true;
   c[i]:=true;
  end;
 try(1);
END.