Cod sursa(job #996105)

Utilizator sulzandreiandrei sulzandrei Data 11 septembrie 2013 01:22:40
Problema Dame Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.1 kb
program dame;
type stiva=array[1..1000] of integer;
var st:stiva;
n,k:word;
f,g:text;
as,ev:boolean;
procedure init(k:integer; var st:stiva);
begin
st[k]:=0;
end;
procedure suc(k:integer; var st:stiva; var as:boolean);
begin
if st[k]<n then begin st[k]:=st[k]+1; as:=true; end
else as:=false;
end;
procedure valid(k:integer; st:stiva;  var ev:boolean);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if (st[k]=st[i] ) or (abs(st[k]-st[i])=abs(k-i)) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
if k=n then solutie:=true else solutie:=false;
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do writeln(f,i,' ',st[i],' ');
writeln;
end;
begin
assign(f,'dame.out');
rewrite(f);
assign(g,'dame.in');
reset(g);
readln(g,n);
close(g);
writeln(f,n);
k:=1;
init(k,st);
 while k>0 do begin
  repeat
   suc(k,st,as);
   if as then valid(k,st,ev);
  until (not as) or (as and ev);
  if as then if solutie(k) then begin tipar; k:=0; writeln(f); end
                           else begin k:=k+1; init(k,st); end
        else k:=k-1;
 end;
 close(f);
end.