Cod sursa(job #1146495)

Utilizator ROMaANUMitea Lucian ROMaANU Data 19 martie 2014 00:09:48
Problema Problema Damelor Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.23 kb
uses crt;
type stiva=array[1..100]of integer;
var n,k,p,nr:integer;
    as,ev:boolean;
    st:stiva;f,g:text;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(k:integer;var st:stiva;var as:boolean);
begin
if st[k]<n then
   begin
   inc(st[k]);
   as:=true;
   end
     else as:=false;
end;
procedure validare(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] then ev:=false;
 for i:=1 to k-1 do if abs(st[i]-st[k])=abs(i-k) then ev:=false;
 end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
if nr=0 then
begin
for i:=1 to k do write(g,st[i],' ');writeln(g);
end;
inc(nr);
end;
begin
clrscr;
k:=1;
assign(f,'damesah.in');
reset(f);
read(f,n);
close(f);
assign(g,'damesah.out');
rewrite(g);
nr:=0;
init(k,st);
while k>0 do
  begin
  repeat
  succesor(k,st,as);
  if as then validare(k,st,ev);
  until (not as)or(as and ev);
  if as then
    if solutie(k) then tipar
                  else
                   begin
                   inc(k);
                   init(k,st);
                   end
   else dec(k);
   end;
  writeln(g,nr);
  close(g);
end.