BAC_PRATIQUE_2016

program Fac_prim;
uses WinCrt;
var
N:byte;

procedure saisie (Var n:byte);
begin
        repeat
            write('N=');
            readln(n);
        until n in[2..5];
end;

function fac_prem(x:integer):LongInt;
begin
            if x = 0 then fac_prem:=1
            else fac_prem:= x * fac_prem(x-1);
end;

function premier(x:integer):boolean;
var i:integer;
V:Boolean;
begin
            V:=true;
            for i:=2 to x div 2 do
                if x mod (i) = 0 then V:=false;
            premier:=V;
end;

function verif_fac_prem(x:integer):boolean;
var i:integer;
begin
        i:=0;
        repeat
            i:= i+1;
        until (fac_prem(i) + 1 = x) OR (fac_prem(i) - 1 = x) OR (fac_prem(i) + 1> x);
        if  (fac_prem(i) + 1 = x) OR (fac_prem(i) - 1 = x) then  verif_fac_prem:= true
        else verif_fac_prem:= false;
end;


function verif_prim(x:integer):boolean;
var i:integer;
P:longint;
begin
        i:=1;
        P:=1;
        Repeat
                    if premier(i) then
                    begin
                        P:=P*i;
                        i:=i+1;
                    End
                    else  i:=i+1;
        until (P+1 = x) OR (P-1 = x) OR (P > x+1);
        if  (P+1 = x) OR (P-1 = x) then verif_prim := true
        else   verif_prim := false;
end;


Procedure afficher(N:integer);
var
i:integer;
x:integer;
begin
        x:=1;
        writeln('Les nombres premiers factoriels :');
        for i:= 1 to N Do
        Begin
            repeat
                x:=x+1;
            until (premier(x)) AND (verif_fac_prem(x));
            writeln(x);
        end;
        x:=1;
        writeln('Les nombres premiers primoriels :');
        for i:= 1 to N Do
        Begin
                repeat
                    x:=x+1;
                until (premier(x)) AND (verif_prim(x));
            writeln(x);
        end;
end;

begin
saisie(n);
afficher(n);
end.