Cod sursa(job #1646843)

Utilizator SaniokMDACaliman Alexandru SaniokMDA Data 10 martie 2016 17:56:34
Problema Problema Damelor Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.03 kb
var
  a: array[1..1000]of longint;
  n, i, j, s, x: longint;

procedure deplasare;
var
  y: longint;
begin
  for y := n downto 2 do
    if a[y] = n + 1 then begin
      a[y] := 1;
      a[y - 1] := a[y - 1] + 1;
    end;
end;

procedure afisare;
var
  k: longint;
begin
  for k := 1 to n do 
    write(a[k], ' ');
  writeln;
end;

function verificare: boolean;
var
  i, j, s: longint;
begin
  
  verificare := true;
  for i := 1 to n - 1 do
    for j := i + 1 to n do
      if (a[i] = a[j]) or (abs(i - j) = abs(a[i] - a[j])) then 
      begin
        verificare := false; 
        break;
      end;
end;

begin
  assign(input, 'damesah.in');
  assign(output, 'damesah.out');
  reset(input);
  rewrite(output);
  read(n);
  x := 1;
  s := 0;
  for i := 1 to n do 
  begin
    a[i] := 1;
    x := x * n;
  end;
  for j := 1 to x do 
  begin
    //afisare; 
    if verificare then begin
      s := s + 1;
      if s = 1 then afisare
    end;
    inc(a[n]);
    deplasare;
  end;
  write(s);
end.