DEVOIR PRATIQUE BAC 2013 G1

Voir le sujet précédent Voir le sujet suivant Aller en bas

DEVOIR PRATIQUE BAC 2013 G1

Message par Mondher le Ven 24 Mai - 13:51

program aires;
uses wincrt;
type
enreg= record
rect,trapez:real;
nombre:integer;
end;
fenreg=file of enreg;
var
f:fenreg;
eps:real;
resultat:integer;
function fct (x:real):real;
begin
fct:=sqr(x);
end;
procedure saisirepsilon (var eps:real);
begin
repeat
writeln('entrer epsilon');
readln(eps);
until (eps>=0.001) and (eps<=0.1);
end;
function rectangle (a,b:real; n:integer):real;
var
k,s:real;
i:integer;
begin
s:=0;
k:=(b-a)/n;
for i:= 1 to n do
begin
s:=s+ fct(a+k/2)*k;
a:=a+k;
end;
rectangle:=s;
end;
function trapeze (a,b:real; n:integer):real;
var
i:integer;
s,k:real;
begin
s:=0;
k:=(b-a)/n;
for i:= 1 to n do
begin
s:=s+ (fct(a)+fct(a+k))*k/2;
a:=a+k;
end;
trapeze:=s;
end;
procedure traitement (var f:fenreg; eps:real; var resultat:integer);
var
n:integer;
e:enreg;
k,j,rec,trap:real;
begin
rewrite(f);
n:=1;
k:=0;
j:=0;
rec:=1;
trap:=1;
while(abs(rec-k)>eps)and(abs(trap-j)>eps)do
k:=rec;
j:=trap;
n:=n+1;
rec:=rectangle(0,3,n);
trap:=trapeze(0,3,n);
e.nombre:=n;
e.rect:=rec;
e.trapez:=trap;
write(f,e);
writeln('n=',n,' | ', rec:9:5,' | ', trap:9:5);
if(abs(rec-k)resultat:=1
else if (abs(rec-k)>abs(trap-j)) then
resultat:=2
else
resultat:=3;
writeln('la methode est ',resultat);
close(f);
end;
procedure afficher (var f:fenreg;resultat:integer);
var
e:enreg;
begin
writeln('| N |','| Rectangle |','| trapeze |');
reset(f);
while not(eof(f))do
begin
read(f,e);
writeln('|',e.nombre,'|','| ',e.rect:9:5,' |','| ',e.trapez:9:5,' |');
end;
case resultat of
1:writeln('la methode qui converge la premiere vers l''aire exacte est la methode de rectangle');
2:writeln('la methode qui converge la premiere vers l''aire exacte est la methode de trapeze');
3:writeln('les deux methodes convergent en meme temp vers 9 qui est l''aire exacte');
end;
end;
begin
assign(f,'d:\calcul.dat');
saisirepsilon(eps);
traitement(f,eps,resultat);
afficher(f,resultat);
end.


Dernière édition par Mondher le Dim 26 Mai - 13:23, édité 1 fois

Mondher

Messages : 57
Points : 9151
Réputation : 0
Date d'inscription : 24/09/2012
Age : 22
Localisation : Tunisie

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Re: DEVOIR PRATIQUE BAC 2013 G1

Message par haiethem le Sam 25 Mai - 23:34

La méthode des trapèzes :
s:=s+(fct(a)+fct(a+h))*k/2;

_________________
=================================
Haiethem Elguediri
Lycée Secondaire Mareth
+21652084191
+21652906038
+21631139805
+21675321050
haiethem@gmail.com
www.haiethem.tk
avatar
haiethem

Messages : 419
Points : 14620
Réputation : 3
Date d'inscription : 08/11/2010
Age : 41

Voir le profil de l'utilisateur http://www.haiethem.tk

Revenir en haut Aller en bas

Re: DEVOIR PRATIQUE BAC 2013 G1

Message par haiethem le Sam 25 Mai - 23:34

Il y a une ligne incomplète :

if(abs(rec-k)


_________________
=================================
Haiethem Elguediri
Lycée Secondaire Mareth
+21652084191
+21652906038
+21631139805
+21675321050
haiethem@gmail.com
www.haiethem.tk
avatar
haiethem

Messages : 419
Points : 14620
Réputation : 3
Date d'inscription : 08/11/2010
Age : 41

Voir le profil de l'utilisateur http://www.haiethem.tk

Revenir en haut Aller en bas

Re: DEVOIR PRATIQUE BAC 2013 G1

Message par haiethem le Sam 25 Mai - 23:40

Voici ma proposition :
program ex23052013;
uses wincrt;
type
enreg = record
n:integer;
r,t:real;
end;
fdat=file of enreg;
var f:fdat;
ch:string;
nb:integer;
s,eps:real;

procedure saisir;
begin
repeat
writeln('donner epsilon : ');
readln(eps);
until (eps<=0.1) and (eps>=0.0001);
end;
procedure affiche (var f:fdat);
var x:enreg;
begin
reset(f);
while not eof (f) do
begin
read(f,x);
writeln(x.n,' *** ',x.r,' *** ',x.t);
end;
close(f);
writeln(ch,' ** ',nb,' ** ',s);
end;
function rect(m:integer;a,b:real):real;
var i:integer;y:real;
begin
s:=0;
y:=a+b/m;
for i:= 1 to m do
begin
s:=s+(y-a)*sqr(y);
a:=a+b/m;
y:=y+b/m;
end;
rect:=s;
end;
function trap(m:integer;a,b:real):real;
var i:integer;
begin
s:=0;
for i:= 1 to m do
begin
s:=s+((sqr(a)+sqr(a+b/m))*b/m)/2;
a:=a+b/m;
end;
trap:=s;
end;
procedure remplir (var f:fdat;eps:real);
var m:integer;
x:enreg;
begin
rewrite(f);
m:=50;
repeat
x.r:=rect(m,0,3);
x.t:=trap(m,0,3);
m:=m+10;
write(f,x);
writeln(m);
until(abs((x.r)-9)if (abs(x.r)-9)begin
nb:=m;
s:=x.r;
ch:= 'Méthode des rectangles';
end
else
begin
nb:=m;
s:=x.t;
ch:='Méthode des trapezes';
end;
close(f);
end;
begin
assign(f,'c:\bac2013\calcul.dat');
saisir;
remplir(f,eps);
affiche(f);
end.

_________________
=================================
Haiethem Elguediri
Lycée Secondaire Mareth
+21652084191
+21652906038
+21631139805
+21675321050
haiethem@gmail.com
www.haiethem.tk
avatar
haiethem

Messages : 419
Points : 14620
Réputation : 3
Date d'inscription : 08/11/2010
Age : 41

Voir le profil de l'utilisateur http://www.haiethem.tk

Revenir en haut Aller en bas

Re: DEVOIR PRATIQUE BAC 2013 G1

Message par Mondher le Dim 26 Mai - 13:30

Il y'a une liigne incomplete :
until(abs(x.r-9)<=eps)or(abs(x.t-9)<=eps);

Mondher

Messages : 57
Points : 9151
Réputation : 0
Date d'inscription : 24/09/2012
Age : 22
Localisation : Tunisie

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Re: DEVOIR PRATIQUE BAC 2013 G1

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum