Forum pour les élèves lycéens
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
Le Deal du moment : -40%
-40% sur le Pack Gaming Mario PDP Manette filaire + ...
Voir le deal
29.99 €

BAC INFO 2016

Aller en bas

BAC INFO 2016 Empty BAC INFO 2016

Message par haiethem Sam 21 Mai - 10:38

program nom_prg;
uses wincrt;
var n:integer;
procedure saisir;
begin
repeat
writeln('Donner n ');
readln(n);
until n in [2..5];
end;

function premier (n:integer):boolean;
var i,nb:integer;
begin
nb:=0;
for i:=1 to n do
if n mod i=0 then nb:=nb+1;
premier :=nb=2;
end;

function fact(n:integer):longint;
var i,f:longint;
begin
f:=1;
for i:=1 to n do
f:=f*i;
fact:=f;
end;

function prefact(n:integer):boolean;
var f:integer;
begin
f:=1;
repeat
f:=f+1;
until premier(f)and((fact(f)+1=n)or(fact(f)-1=n)or(fact(f)>n));
prefact:=(fact(f)+1=n) or(fact(f)-1=n);
end;

function preprim (n:integer):boolean;
var p,pr:integer;
begin
p:=2;
pr:=1;
repeat
pr:=p*pr;
while not premier(p) do p:=p+1;
until (pr-1=n)or(pr+1=n)or(pr>n+1);
end;

procedure afficher;
var i,j,k:integer;
begin
k:=1;
for i:= 1 to n do
begin
j:=k;
repeat
inc(j);
until prefact(j);
writeln(j,' Premier factoriel ');
k:=j+1;
end;
k:=1;
for i:=1 to n do
begin
j:=k+1;
repeat
inc(j);
until preprim(j);
writeln(j,' Premier primoriel ');
k:=j;
end;
end;

begin
saisir;
afficher;
end.
haiethem
haiethem

Messages : 485
Points : 27078
Réputation : 3
Date d'inscription : 08/11/2010
Age : 47

http://www.gdiri.info

Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum