Cod sursa(job #1694875)

Utilizator RobushekDivine Spirit Robushek Data 26 aprilie 2016 10:21:48
Problema Problema Damelor Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 2.08 kb
program dame;


var x:array[1..100] of integer;
    k,i,j,g:integer;
    n:4..13;
    sa,ev:boolean;
    h,m,sec,msec:word;
    Ti,Tf:real;
    fi,fo:text;

begin
    assign(fi,'damesah.in');
    assign(fo,'damesah.out');
    reset(fi);rewrite(fo);
    read(fi,n);





    k:=1;
    x[k]:=0;
                   while (k>0) do begin
                                     repeat
                                          if x[k]<n then begin
                                                            x[k]:=x[k]+1;
                                                            sa:=true;
                                                         end

                                                     else sa:=false;
                                                     if sa then ev:=true;
                                           for i:=1 to k-1 do
                                              if (x[k]=x[i]) or (abs(x[k]-x[i])=abs(k-i))  then
                                                                                   ev:=false;
                                      until (not sa) or (sa and ev);


                                      if sa then
                                            if k=n then begin

                                                           if g=0 then begin
                                                           for i:=1 to n do
                                                            write(fo,x[i],' ');
                                                            writeln(fo); end;

                                                           inc(g);

                                                        end
                                                    else begin
                                                            inc(k);
                                                            x[k]:=0;
                                                         end
                                      else dec(k);
                                   end;



     write(fo,g);
     close(fi);close(fo);



end.