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
| program premier;
uses crt;
var n,i:longint;
function prm(n:longint):boolean;
var i:longint;
begin
if n=1 then prm:=false else
begin
i:=2;
while (n mod i <> 0) and (i<n) do i:=i+1;
if i=n then prm:=true else prm:=false;
end;
end;
function supprm(n:longint):boolean;
var ch,aux:string;
m:longint;
s,i:byte;
e:integer;
begin
str(n,ch);
aux:=ch;
if prm(n)=false then supprm:=false else
begin
s:=0;
for i:=1 to length(aux) do
begin
delete(ch,i,1);
val(ch,m,e);
ch:=aux;
if prm(m)=true then s:=s+1;
end;
if s=length(aux) then supprm:=true else supprm:=false;
end;
end;
begin
readln(n);
for i:=1 to n do
begin
if supprm(i)=true then writeln(i);
end;
end. |
Partager