language: Pascal (fpc) (fpc 2.2.0)
date: 104 days 17 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

const n=13;
var a:array[1..n]of integer;
    b:array[1..n]of byte;
    c:array[2..2*n]of byte;
    d:array[1-n..n-1]of byte;
    ans,m:longint;
 
procedure print;
var i:integer;
begin
  inc(ans);
  if ans>3 then exit;
  for i:=1 to m-1 do
  write(a[i],' ');
  writeln(a[m]);
end;
 
procedure find(i:integer);
var j:integer;
begin
  if i=m+1 then print
  else
  for j:=1 to m do
  if  (b[j]=0)and(c[i+j]=0)and(d[i-j]=0) then
  begin
  a[i]:=j;
  b[j]:=1;
  c[i+j]:=1;
  d[i-j]:=1;
  find(i+1);
  b[j]:=0;
  c[i+j]:=0;
  d[i-j]:=0;
  end;
end;
begin
  readln(m);
  find(1);
  writeln(ans);
end.