Program S13;
Type
Tab = array [1..50] Of integer ;
Var
N,M : integer;
//**************************************
Procedure saisie(Var N,M:integer);
Begin
Repeat
write('2 entiers : ');
readln(n,m);
Until (n >=5) And (n<m) ;
End;
//**************************************
Procedure remplir_fact_prem(n:integer ; Var TF:tab; Var F : integer);
Var
i : integer;
Begin
f := 0;
i := 2;
Repeat
If n Mod i = 0 Then
Begin
f := f + 1;
TF[f] := i;
n := n Div i;
End
Else
i := i + 1;
Until n=1;
End;
//**************************************
Function exist(x,n:integer ; T:tab) : boolean;
Var
i : integer;
Begin
i := 1;
While (t[i]<>x) And (i<=n) Do
inc(i);
exist := i<=n;
End;
//**************************************
Function Parcours(T,V:tab ; N1,N2 : integer) : boolean;
Var
i : integer;
Ok : boolean;
Begin
i := 1;
Repeat
Ok := exist(t[i],N2,V) ;
If Ok Then
inc(i);
Until Not Ok Or(i>N1);
Parcours := i>N1 ;
End;
//**************************************
Procedure Affiche(N:integer ; T:tab);
Var
i : integer;
Begin
For i:=1 To N-1 Do
write (T[i],'*');
write (T[N]);
End;
//**************************************
Procedure Affich_Si_Homogen(N,M:integer);
Var
i,n1,m1 : integer;
Tn,Tm : Tab ;
Begin
Remplir_fact_prem(N,Tn,n1);
Write(N,' = ');
Affiche(n1,Tn);
Writeln;
Remplir_fact_prem(M,Tm,m1);
Write(M,' = ');
Affiche(m1,Tm);
Writeln;
If Parcours(Tn,Tm,n1,m1) And Parcours(Tm,Tn,m1,n1) Then
writeln(n,' et ',m,' sont Homogènes ' )
Else writeln(n,' et ',m,' ne sont pas Homogènes ' );
End ;
Begin
Saisie(N,M);
Affich_Si_Homogen(N,M);
End.
Inscription à :
Publier les commentaires (Atom)
