Vòng tròn nguyên tố

var  x:array[1..10000] of int64;
    n,k,t,d:int64;
    i:longint;

function      kt(t:integer):boolean;
var i:longint;
begin
  i:=2;
  while ((t mod i) <>0) and (i<= sqrt(t)) do
  i:=i+1;
  if ((i>sqrt(t)) and (t>1)) then kt:=true else kt:=false;
  end;
procedure  result;
var h:longint;
begin
  inc(h);
  for i:=1 to 2*n  do write(x[i]);
  writeln;
  if h>10000 then exit;
end;
function  trung(i,j:integer):boolean;
var k:longint;
begin
  trung:=false;
  for k:=1 to i-1 do
  if x[k]=j then trung:=true;
end;
procedure    tang;
begin
    inc(d);
end;
procedure    try(i:integer);
var d:int64;
    j:longint;
begin

  x[1]:=1;
  for j:=2 to 2*n do
  if( not trung(i,j) and (kt(x[i-1]+j)=true)) then
    begin
      x[i]:=j;
      if ((i=2*n) and (kt(x[1]+x[2*n])=true)) then result  else try(i+1);
    end;
      end;
procedure    sinh(i:integer);
var j:longint;
begin

  x[1]:=1;
  for j:=2 to 2*n do
  if( not trung(i,j) and (kt(x[i-1]+j)=true)) then
    begin
      x[i]:=j;
      if ((i=2*n) and (kt(x[1]+x[2*n])=true)) then tang  else sinh(i+1);
    end;
      end;
BEGIN
  readln(n);
  sinh(2);
  writeln(d);
  try(2);
  readln
END.

program vong_tron_nguyen_to;
uses crt;
const max=100; fi='vtnt.txt';
var a:array[1..max] of integer;
    kt:array[1..max] of boolean;
    i,n,dem,l:integer; f:text;

procedure nhap;
 begin
  clrscr;
  write('nhap n: ');readln(n);
 end;

function ktnt(k:integer):boolean;
 begin
  ktnt:=false;
  if k<2 then exit;
  for l:=2 to trunc(sqrt(k)) do
  if k mod l=0 then exit;
  ktnt:=true;
 end;

procedure try(i:integer);
 var j:integer;
 begin
  for j:=2 to 2*n do
  if (kt[j])and(ktnt(a[i-1]+j)) then
    begin
    a[i]:=j;kt[j]:=false;
    if (i=2*n)and(ktnt(a[1]+a[2*n])) then
      begin
      inc(dem);
      for l:=1 to 2*n do write(f,a[l],' ');
      writeln(f);
      end
    else try(i+1);
    kt[j]:=true;
    end;
 end;

procedure tinh;
 begin
  a[1]:=1; dem:=0;
  for i:=2 to 2*n do kt[i]:=true;
  assign(f,fi);
  rewrite(f);
  try(2);
  writeln(f,'Co tat ca ',dem,' cach.');
  close(f);
 end;

begin
 nhap;
 tinh;
end.

Var
        n:longint;
        count:qword;
        a:array[0..20]of longint;
        kq:array[0..10000,0..100]of longint;
        DaXet,NT:array[0..100]of boolean;
        Function Test(k:longint):boolean;
        Var
                i:longint;
        Begin
        Test:=true;
        If (k=2)or(k=3) then
                exit(true)
        Else
                For i:=2 to trunc(sqrt(k)) do
                        If k mod i=0 then
                                exit(false);
        End;
        Procedure Init;
        Var
                i:longint;
        Begin
        Readln(n);
        a[1]:=1;
        a[2*n+1]:=1;
        For i:=1 to 39 do
                Nt[i]:=Test(i);
        End;
        Procedure Update;
        Begin
        inc(count);
        If count<=10000 then
                kq[count]:=a;
        End;
        Procedure Try(k:longint);
        Var
                i:longint;
        Begin
        If k=2*n+1 then
                If NT[a[k]+a[k-1]] then
                        begin
                        Update;
                        exit;
                        end;
        For i:=2 to 2*n do
                If not DaXet[i] then
                        begin
                        a[k]:=i;
                        DaXet[i]:=true;
                        If NT[a[k-1]+a[k]] then
                                Try(k+1);
                        DaXet[i]:=false;
                        end;
        End;
        Procedure Print;
        Var
                i,j:longint;
        Begin
        Writeln(count);
        If count>10000 then
                count:=10000;
        For i:=1 to count do
                begin
                For j:=1 to 2*n do
                        write(kq[i,j],' ');
                end;
        End;
        Procedure Solve;
        Begin
        Init;
        Try(2);
        Print;
        End;
BEGIN
Solve;
END.