Program fact_prim;
Var
n : integer;
i : integer;
//**************************************
Procedure saisir(Var n:integer);
Begin
Repeat
writeln('taper N');
readln(n);
Until n In [2..5];
End;
//**************************************
Function premier(x:integer) : boolean;
Begin
i := 1;
Repeat
i := i+1;
Until (i>=sqrt(x)) Or (x Mod i =0);
premier := i>sqrt(x);
End;
//**************************************
Function factoriel(x:integer) : longint;
Var
f : longint;
Begin
f := 1;
For i:=1 To x Do
f := f*i;
factoriel := f;
End;
//**************************************
Function primoriel(x:integer) : longint;
Var
p,k : longint;
Begin
p := 1;
For k:=1 To x Do
If (premier(k)) Then
p := p*k;
primoriel := p;
End;
//**************************************
Function verif_fact(x:integer) : boolean;
Var
pf : boolean;
j : integer;
Begin
pf := false;
j := 1;
Repeat
j := j+1;
If (factoriel(j)-1= x) Or (factoriel(j)+1 = x) Then
pf := true;
Until (j>=x-1) Or (pf);
verif_fact := pf;
End;
//**************************************
Function verif_primo(x:integer) : boolean;
Var
pp : boolean;
j : integer;
Begin
pp := false;
j := 1;
Repeat
j := j+1;
If (primoriel(j)-1= x) Or (primoriel(j)+1 = x) Then
pp := true;
Until (j>=x-1) Or (pp);
verif_primo := pp;
End;
//**************************************
Procedure prem_fact(n:integer);
Var
cpt,v : integer;
Begin
cpt := 0;
v := 1;
Repeat
v := v+1;
If (premier(v) And verif_fact(v) ) Then
Begin
cpt := cpt+1;
writeln( v ,' est un nombre premier factoriel');
End;
Until cpt = n;
End;
//**************************************
Procedure prem_primoriel(n:integer);
Var
c,v : integer;
Begin
c := 0;
v := 1;
Repeat
v := v+1;
If (premier(v) And verif_primo(v) ) Then
Begin
c := c+1;
writeln( v ,' est un nombre premierprimoriel');
End;
Until c >= n;
End;
//**************************************
Begin
saisir(n);
writeln('Nombres premiers factoriels :');
prem_fact(n);
writeln('Nombres premiers primoriels :');
prem_primoriel(n);
End.
Inscription à :
Publier les commentaires (Atom)
