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. |
