Cod sursa(job #1135046)

Utilizator azkabancont-vechi azkaban Data 7 martie 2014 11:33:05
Problema Problema Damelor Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.49 kb
Program regine;
var x:array[1..100] of byte;
    n,k1:byte;
    nrsol:word;

procedure scriesolutie;
        var i,j:byte;
          begin
               inc(nrsol);
          if k1=0 then begin
               for i:=1 to n do
                           for j:=1 to n do
                                           if x[i]=j then write(j,' ');
                          writeln;  k1:=k1+1;
                          end;



         end;

function pozitievalida(k:byte):boolean;
        var i:byte;
            atac:boolean;
          begin
                atac:=false;
                for i:=1 to k-1 do
                    if(x[i]=x[k]) or (k-i=abs(x[k]-x[i])) then atac:=true;
                pozitievalida:=not atac;
          end;

procedure back(k:byte);
         var i:byte;
          begin
              for i:=1 to n do begin
                                     x[k]:=i;
                                     if pozitievalida(k) then
                                           if k=n then
                                                       scriesolutie
                                                  else back(k+1);
                               end;
          end;

begin
assign(input,'damesah.in'); reset(input);
assign(output,'damesah.out'); rewrite(output);
read(n);
if n<4 then writeln('Nu sunt solutii ')
       else begin
                 nrsol:=0;
                 back(1);
            end;
     writeln(nrsol);
  close(input); close(output);
end.