Devoir

program devoir;
uses wincrt;
type
tab=array[1..20] of integer;
var
n,p:integer;
t:tab;
procedure saisir(var n : integer );
begin
repeat
writeln('entrer n ');
readln(n);
until(n>=5) and (n<=20);
end;
procedure remplir(var t:tab; n:integer);
var
i,x:integer;
begin
for i:=1 to n do
begin
repeat
writeln('entrer en entier de 4 chiffres');
readln(x);
until(x div 1000 <> 0 );
t[i]:=x;
end;
end;
procedure saisirp(var p : integer) ;
begin
repeat
writeln('entrer un entier de 4 chiffres');
readln(p)
until(p div 1000 <>0)
end;
function somme(x:integer):integer;
var
ch:string;
i,e,aux,k:integer;
begin
str(x,ch);
aux:=0;
for i:=1 to 3 do
begin
val(ch[i],k,e);
aux:=aux+k;
end;
somme:=aux;
end;
function verif1(t:tab;n,x:integer):boolean;
var
k:boolean;
i:integer;
begin
k:=false;
i:=1;
repeat
if t[i] = x then
k:=true;
inc(i);
until (i>n) or ( k=true);
verif1:=k;
end;
function verif2(t:tab;n,p:integer):boolean;
var
j,i:integer;
r:boolean;
begin
j:=1;
r:=false;
i:=somme(p);
repeat
if somme(t[j])=i then
r:=true;
inc(j);
until(j>n) or (r=true);
verif2:=r;
end;
procedure verif(t:tab;n,p:integer);
var
i,j:integer;
begin
if verif1(t,n,p) then
writeln(p,' appartient totalement à t')
else if(verif2(t,n,p)) then
writeln(p,' appartient partiellement à t')
else
writeln(p,' n''appartient pas à t');
end;
begin
saisir(n);
remplir(t,n);
saisirp(p);
verif(t,n,p);
end.

program appartenance;
uses wincrt;
type
tab=array[1..20] of integer;
var
n,p:integer;
t:tab;
{ ******* PROCEDURE SAISIR ******* }
procedure saisir(var n : integer );
begin
repeat
writeln('entrer n ');
readln(n);
until(n>=5) and (n<=20);
end;
{ ******* PROCEDURE REMPLIR ******* }
procedure remplir(var t:tab; n:integer);
var
i,x:integer;
begin
for i:=1 to n do
begin
repeat
writeln('Donner t[',i,'] '' de 4 chiffres'' :');
readln(x);
until(x div 1000 <> 0 );
t[i]:=x;
end;
end;
{ ******* PROCEDURE SAISIR P ******* }
procedure saisirp(var p : integer) ;
begin
repeat
writeln('Donner un entier p : ''de 4 chiffres'' :');
readln(p)
until(p div 1000 <>0)
end;
{ ******* FONCTION VERIF P ******* }
function verifp(t:tab;n,p:integer):boolean;
var
i:integer;
begin
i:=0;
repeat
inc(i);
until (i>n) or ( t[i] = p );
verifp:=( t[i] = p)
end;
{ ******* FONCTION VERIF P mod 10 ******* }
function verifp10(t:tab;n,p:integer):boolean;
var
i:integer;
begin
i:=0;
repeat
inc(i);
until (i>n) or (t[i] div 10 = p div 10 );
verifp10:=(t[i] div 10 = p div 10);
end;
{ ******* PROCEDURE AFFICHE ******* }
procedure affiche(t:tab;n,p:integer);
var
i,j:integer;
begin
if verifp(t,n,p) then
writeln(p,' appartient totalement à t')
else if verifp10(t,n,p) then
writeln(p,' appartient partiellement à t')
else
writeln(p,' n''appartient pas à t');
end;
{ ******* PROGRAMME PRINCIPAL ******* }
begin
saisir(n);
remplir(t,n);
saisirp(p);
affiche(t,n,p);
end.

salem
pour la fonction verifp, si p ne strouv pa dans t "i" vas depasser la taille du tableau alos t[i] sa va etre un element aleatoire qui peut etre egale à "p" nn :/ ? ou sa va retourner 0 ?

oui mais la probabilité d'avoir ce cas est presque nulle.

ah cboonn mercii