Cod sursa(job #2207160)

Utilizator Banari01Banari Veronica Banari01 Data 24 mai 2018 23:16:41
Problema Problema Damelor Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.96 kb
 var x:array[1..100] of integer;
     sol,n:integer;

procedure scriesol;
  var i,j:integer;
begin
  inc(sol);
  writeln('Solutia a ',sol,' este: ');
  for i:=1 to n do begin
                    writeln;
                    for j:=1 to n do
                    if x[j]=i then write('X',' ')
                              else write('O',' ');
                   end;writeln;
end;
function potcont(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;
  potcont:=not atac;
end;
procedure nrback(k:integer);
  var i:integer;
begin
  for i:=1 to n do begin
                   x[k]:=i;
                   if potcont(k) then
                   if k=n then scriesol
                          else back(k+1);
                   end;
end;
Begin
   write('n=');readln(n);
   sol:=0;
   nrback(1);
   writeln('Numarul de solutii',sol);
   readln;
end.