Program S2;
Uses crt;
Var
m,n,i,nb,a,K : integer;
chk,ch,ligne : string;
ok : boolean;
f : text;
//*****************************************
Function premiersuivant(j:integer) : integer;
Var
v : boolean;
n,k : integer;
Begin
n := j;
Repeat
n := n+1;
k := 2;
V := true;
While (k<=n Div 2) And (v) Do
If (n Mod k=0) Then
v := false
Else
k := k+1;
Until (v);
premiersuivant := n;
End;
//*****************************************
Function decomp(a:integer) : string;
Var
j : integer;
ligne,chj,cha : string;
Begin
str(a,cha);
ligne := '';
j := 2;
While (a>1) Do
Begin
If ( a Mod j=0) Then
Repeat
str(j,chj);
ligne := ligne+chj+'*';
a := a Div j
Until (a Mod j<>0);
j := premiersuivant(j);
End;
delete(ligne,length(ligne),1);
decomp := ligne;
End;
//*****************************************
Function sommechiffre(a:integer) : integer;
Var
cha : string;
v,e,s : integer;
Begin
str(a,cha);
s := 0;
For i:=1 To length(cha) Do
Begin
val(cha[i],v,e);
s := s+v;
End;
sommechiffre := s;
End;
//*****************************************
Function some_fact_prem(ch:String) : integer;
Var
v,e,sch : integer;
ch1 : string;
Begin
sch := 0;
ch := ch+'*';
While (pos('*',ch)<>0) Do
Begin
ch1 := copy(ch,1,pos('*',ch)-1);
If (length(ch1)=1) Then
val(ch1,v,e)
Else
Begin
val(ch1,v,e);
v := sommechiffre(v);
End;
sch := sch+v;
delete(ch,1,pos('*',ch));
End;
some_fact_prem := sch;
End;
//*****************************************
Procedure rigolo(a:integer;Var ch:String;Var ok:boolean);
Var
s,sch : integer;
Begin
s := sommechiffre(a);
ch := decomp(a);
sch := some_fact_prem(ch);
If (s=sch) Then
ok := true
Else
ok := false;
End;
//*****************************************
Procedure affiche(Var f:text);
Var
ligne : string;
Begin
reset(f);
While (Not(eof(f))) Do
Begin
readln(f,ligne);
writeln(ligne);
End;
End;
//*****************************************
Begin
assign(f,'resultat.txt');
rewrite(f);
Repeat
write('Donner M: ');
readln(m);
write('Donner N: ');
readln(n);
Until (m>100) And (m<n) And (n<1000);
nb := 0;
For k:=m To n Do
Begin
rigolo(k,ch,ok);
If (ok) Then
Begin
nb := nb+1;
str(k,chk);
ligne := chk+'= '+ch+' est un nombre rigolo.';
writeln(ligne);
readln;
writeln(f,ligne);
End;
End;
clrscr;
If (nb=0) Then
writeln('Il n''y a aucun nombre rigolo.')
Else
Begin
writeln(' Les nombres rigolo entre [',m,',',n,'] sont: ');
writeln;
writeln('---------------------------------------------------------');
writeln;
affiche(f);
End;
close(f);
End.
Inscription à :
Publier les commentaires (Atom)
