1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| program exercice8;
uses wincrt;
var p,q:integer;
procedure saisie(var p,q:integer);
begin
repeat
write('p:='); read(p);
write('q:='); read(q);
until (10 < p) and (p<q) and (q<20000);
end;
function premier(n:integer):boolean;
var i :integer;test:boolean;
begin
test:=true;
if(n=1) then test:=false
else begin
for i:= 2 to (n div 2) do
if (n mod i = 0) then test:=false;
premier:=test;
end;
end;
function supprimer(n:integer):integer;
var m,e:integer; ch:string;
begin
str(n,ch);
delete(ch,length(ch),1);
val(ch,m,e);
supprimer:=m;
end;
function super_premier(n:integer):boolean;
var test:boolean;
begin
test := false;
if premier(n) then
begin
n:=supprimer(n);
repeat
if premier(n) then n:=supprimer(n);
until (not premier(n)) or (n div 10 = 0);
if (n div 10 = 0) then test := true;
end;
super_premier:=test;
end;
procedure trait(p,q:integer);
var i:integer;
begin
for i:= p to q do
begin
if (super_premier(i)=true) then writeln(i, ' est super premier')
else write;
end;
end;
begin
writeln(premier(503));
writeln(super_premier(503));
writeln(super_premier(47));
writeln(supprimer(47));
saisie(p,q);
trait(p,q);
end. |
Partager