Cod sursa(job #1135038)

Utilizator azkabancont-vechi azkaban Data 7 martie 2014 11:30:10
Problema Problema Damelor Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.56 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[j]=i then write(i,' '); 
                          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.