Cod sursa(job #89064)

Utilizator johnyJohny Deep johny Data 5 octombrie 2007 18:21:34
Problema Dame Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.15 kb
program dame;
var x: array [1..1000] of integer;
   dp: array [-1000..1000] of integer;
   ds: array [2..2000] of integer;
   n: integer;


procedure init;
var i: integer;
begin
  {initializeaza cu permutarea identica}
  for i:=1 to n do x[i]:=i;
  randomize;
end;

procedure swap(i:integer);
var j,t: integer;
begin
  j:=i+random(n-i);
  t:=x[i];
  x[i]:=x[j];
  x[j]:=t;
end;

procedure nextperm;
var i: integer;
begin
  for i:=1 to n-1 do
     swap(i);
end;


procedure queens;
var i,nj,nr: integer;
begin
 init;
 repeat
   nextperm;
   nr:=0;
   for i:=1-n to n-1 do dp[i]:=0;
   for i:=2 to 2*n do ds[i]:=0;
   i:=1;
   while (i<=n) do
   begin

     if (dp[x[i]-i]=0) and (ds[x[i]+i]=0)
     then begin
            dp[x[i]-i]:=i;
            ds[x[i]+i]:=i;
            inc(i);nj:=0;
          end
     else begin
            swap(i);
            inc(nr);
            inc(nj);
            if nj>=(n-i) then break
          end;
   end;
 until (nr=0);
end;

procedure scrie;
var i: integer;
begin
  for i:=1 to n do
     writeln(i,':',x[i]);
end;

begin
  n:=8;
  queens;
  scrie;
  readln;
end.