PCIRCLE - Vòng số nguyên tố

Tác giả: ll931110

Ngôn ngữ: Pascal

Program PCIRCLE;
        Const
                input  = '';
                output = '';
        Var
                        a: array[1..20] of integer;
                   free,p: array[1..40] of boolean;
                     pnum: array[2..9] of longint;
                  n,c,num: longint;
                       fo: text;

Procedure init;
          Var
                fi: text;
          Begin
                Assign(fi, input);
                        Reset(fi);
                        Readln(fi, n);
                Close(fi);

                c:= n * 2;
                Fillchar(free, sizeof(free), true);

                a[1]:= 1;
                num:= 0;
          End;

Procedure printresult;
          Var
                i: integer;
          Begin
                For i:= 1 to c do write(fo, a[i],  ' ');
                Writeln(fo);
          End;

Procedure primearray;
          Begin
                Fillchar(p, sizeof(p), false);

                p[2]:= true;             p[17]:= true;
                p[3]:= true;             p[19]:= true;
                p[5]:= true;             p[23]:= true;
                p[7]:= true;             p[29]:= true;
                p[11]:= true;            p[31]:= true;
                p[13]:= true;
          End;

Procedure pnumber;
          Begin
                  pnum[2]:= 2;
                  pnum[3]:= 2;
                  pnum[4]:= 4;
                  pnum[5]:= 96;
                  pnum[6]:= 1024;
                  pnum[7]:= 2880;
                  pnum[8]:= 81024;
                  pnum[9]:= 770144;
          End;

Procedure attempt(t: integer);
          Var
                i: integer;
          Begin
                For i:= 2 to c do
                        If free[i] and p[i + a[t - 1]] then
                                Begin
                                        a[t]:= i;
                                        free[i]:= false;

                                        If (t = c) and p[a[c] + a[1]] then
                                                Begin
                                                        inc(num);
                                                        If num <= 10000 then printresult else exit;
                                                End
                                                        else attempt(t + 1);

                                        free[i]:= true;
                                End;
          End;

Begin
        init;
        primearray;

        Assign(fo, output);
                Rewrite(fo);
                        pnumber;
                        Writeln(fo, pnum[n]);
                        attempt(2);
        Close(fo);
End.

Download