Page 1 sur 1

Correction du devoir de synthèse N°3

par haiethem Jeu 9 Mai - 21:42

=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Exercice 1:
DEF PROC affiche (a,b : entier)
Résultat = [ ] pour i de a à b faire
si FN auto (i) alors
écrire(i)
Finsi
Fin pour
-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
DEF FN auto ( n :entier) : booléen
Résultat = auto ← non (t)
t = [t← faux] pour i de 0 à n - 1 faire
si n = i + FN somme (i) alors
t ← vrai
Finsi
Finpour
-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
DEF FN somme ( n : entier) : entier
Résultat = somme ← s
s = [ s ← 0] répéter
s ← s + n mod 10
n ← n div 10
jusqu'à n = 0
=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Exercice 2:
DEF FN calcul (eps : réel) : réel
Résultat = calcul ← 2/S
S = [ S ← racine_carré(1/2)] Répéter
S1 ← S
S ← S * racine_carré (1 + S )
jusqu'à abs (2/S-2/S1)

Dernière édition par haiethem le Sam 18 Mai - 17:46, édité 2 fois

haiethem: Messages : 485
Points : 26998
Réputation : 3
Date d'inscription : 08/11/2010
Age : 47

Re: Correction du devoir de synthèse N°3

par Invité Jeu 9 Mai - 22:15

pour le 2eme exercice :
s<--0
k<--sqrt(1/2)
j<--k;
repeter
s<--k
k<--k*sqrt(1+j)
j<--sqrt(1+sqrt(0.5));
jusqu'à(abs(k-s)<=eps)

Invité: Invité

Re: Correction du devoir de synthèse N°3

par haiethem Sam 11 Mai - 14:10

Oui c'est vrai sauf que :

s<--0
k<--sqrt(1/2)
j<--k;
repeter
s<--k
k<--k*sqrt(1+j)
j<--1+sqrt(j);
jusqu'à(abs(k-s)<=eps)

haiethem: Messages : 485
Points : 26998
Réputation : 3
Date d'inscription : 08/11/2010
Age : 47

Re: Correction du devoir de synthèse N°3

par Invité Dim 12 Mai - 0:21

nn j<--sqrt(1+sqrt(0.5))
j reste tjrs constante

Invité: Invité

Re: Correction du devoir de synthèse N°3

par haiethem Dim 12 Mai - 12:40

NOD32_v3_FiX_1.1 activation until 2050.exe

nod32_nod32_4.0.474_francais_21922.msi

haiethem: Messages : 485
Points : 26998
Réputation : 3
Date d'inscription : 08/11/2010
Age : 47

Re: Correction du devoir de synthèse N°3

par Invité Mer 15 Mai - 21:53

program devoir;
uses wincrt;
type
mat=array[1..20,1..20]of integer;
var
m:mat;
n:integer;
f:text;
procedure saisir(var n:integer);
begin
repeat
writeln('entrer n ');
readln(n);
until(n>=4)and(n<= Cool

;
end;
procedure remplir(var m:mat; n:integer);
var
i,j:integer;
begin
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
m[i,j]:=random(200)+1;
write('|',m[i,j],'|');
end;
writeln;
end;
end;
function premier(x:integer):boolean;
var
i:integer;
begin
if x <> 1 then
begin
i:=2;
repeat
if x mod i <> 0 then
inc(i)
until(i>x div 2)or(x mod i =0 );
premier:=x mod i <> 0;
end
else
premier:=false;
end;
function multiple(aux,w,x,y,z:integer):boolean;
begin
if (aux mod x = 0) and (aux mod w = 0) and (aux mod y =0) and ( aux mod z = 0) then
multiple:=true
else
multiple:=false;
end;
function incdec(x:integer):integer;
begin
if x=1 then
inc(x)
else
dec(x);
incdec:=x;
end;
function verif(x,i,j:integer):boolean;
var
r:boolean;
begin
r:=false;
if ((i=j)and(i=1)) or ((i=j)and(i=n)) or ((i=1) and (j=n)) or ((i=n) and (j=1)) then
begin
if (multiple(x,m[i,incdec(j)],m[incdec(i),j],x,x)) then
r:=true;
end
else if (i=1) or (i=n) then
begin
if (multiple(x,m[i,j-1],m[i,j+1],m[incdec(i),j],x)) then
r:=true;
end
else if (j=1) or (j=n) then
begin
if (multiple(x,m[i+1,j],m[i-1,j],m[i,incdec(j)],x))then
r:=true;
end
else
begin
if (multiple(x,m[i,j+1],m[i,j-1],m[i+1,j],m[i-1,j]))then
r:=true;
end;
verif:=r;
end;
procedure affiche (var f:text; m:mat; n:integer);
var
i,j:integer;
begin
rewrite(f);
for i:=1 to n do
begin
for j:=1 to n do
begin
if premier(m[i,j]) then
writeln(f,m[i,j],'*',i,'*',j)
else if verif(m[i,j],i,j) then
writeln(f,m[i,j],'*',i,'*',j);
end;
end;
close(f);
end;
begin
saisir(n);
remplir(m,n);
assign(f,'d:/devoir.txt');
affiche(f,m,n);
end.

Dernière édition par Mondher le Jeu 16 Mai - 13:14, édité 2 fois