Chia se 1 bai paccal ve ve do thi

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down

Chia se 1 bai paccal ve ve do thi

Bài gửi by anhlapro26 on 17/1/2011, 8:12 am

program hamsobac3;
uses crt, graph;
var
a, b, c, d: real; {cac he so}
x1, x2, y1, y2, xu, yu: real; {toa do cuc tri, diem uon}
delta: real; {delta' trong tinh toan y'}
k, currmode: integer;
isready: boolean;
(*----------------------------------------------------------*)
{khoi tao ve kiem tra loi do hoa neu co}
procedure khoitaodohoa;
var
maloi, driver, mode: integer;
begin
if (isready = false) then
begin
driver := detect;
initgraph(driver, mode, 'c:\tp\bgi'); {thay doi duong dan cho phu hop}
maloi := graphresult; {check for errors}
if (maloi <> grok) then
begin
writeln('Loi do hoa: ',grapherrormsg(maloi));
writeln('Nhan Enter de thoat...');
readln;
halt(1); {lenh ket thuc chuong trinh}
end
else isready := true;
end
else
begin
setgraphmode(currmode);
end;
end;
(*---------------------------------------------------------*)
procedure nhapdulieu;
var
s: string;
maloi: integer;
begin
clrscr;
writeln('Chuong trinh khao sat va ve do thi ham so bac 3');
writeln('y = ax3 + bx2 + cx + d');
writeln('-----------------------------------------------');
writeln('Nhap gia tri cac he so:');
write('a= ');
repeat
readln(s);
val(s, a, maloi);
if ((maloi<>0) or (a=0)) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('a= ');
end;
until ((a<>0) and (maloi=0));
write('b= ');
repeat
readln(s);
val(s, b, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('b= ');
end;
until (maloi=0);
write('c= ');
repeat
readln(s);
val(s, c, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('c= ');
end;
until (maloi=0);
write('d= ');
repeat
readln(s);
val(s, d, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('d= ');
end;
until (maloi=0);
end;
(*-----------------------------------------------------------*)
function F(x: real):real; {ham so nhan duoc}
begin
F := a*x*x*x + b*x*x + c*x + d;
end;
(*-----------------------------------------------------------*)
procedure xulydulieu;
var
temp: real;
begin
delta := b*b - 3*a*c;
if (delta>0) then
begin
x1 := ( (-1)*b + sqrt(delta) ) / (3*a);
x2 := ( (-1)*b - sqrt(delta) ) / (3*a);
y1 := F(x1);
y2 := F(x2);
if (a>0) then
begin
temp := x1;
x1 := x2;
x2 := temp;
temp := y1;
y1 := y2;
y2 := temp;
end;
end;
xu := (-1)*b / (3*a);
yu := F(xu);
end;
(*-----------------------------------------------------------*)
{xac dinh khoang khao sat va tinh toan ty le toa do thuc so voi man hinh}
procedure candoidothi(var xbegin, xend, kx, ky: real; sizex, sizey: integer);
var
temp: real;
begin
{khoang khao sat x}
if (delta <= 0) then
begin
xbegin := xu - 5;
xend := xu + 5;
end
else
begin
xbegin := x1 - (x2 - x1);
xend := x2 + (x2 - x1);
end;
temp := abs(xend);
if (abs(xbegin) > temp) then temp:=abs(xbegin);
kx := sizex / temp;

{khoang khao sat y}
temp := abs(F(xbegin));
if (abs(F(xend)) > temp) then temp := abs(F(xend));
if (delta>0) then
begin
if (abs(y2) > temp) then temp := abs(y2);
if (abs(y1) > temp) then temp := abs(y1);
end;
ky := sizey / temp;
end;
(*-------------------------------------------------------------*)
procedure vedothi(c1, d1, c2, d2: integer); {gioi han man hinh ve do thi}
var
ox, oy: integer; {goc toa do}
sizex, sizey: integer; {gioi han mot phan tu do thi}
kx, ky: real; {ty le toa do thuc so voi man hinh}
x, y, xbegin, xend: real; {diem tren do thi va gioi han do thi}
begin
{goc toa do}
ox := (c1 + c2) div 2;
oy := (d1 + d2) div 2;
outtextxy(ox+5, oy+2, 'o');

{truc tung}
line(ox, d1+10, ox, d2-10);
line(ox, d1+10, ox+2, d1+15);
line(ox, d1+10, ox-2, d1+15);
outtextxy(ox-12, d1+10, 'y');

{truc hoanh}
line(c1+10, oy, c2-10, oy);
line(c2-10, oy, c2-15, oy+2);
line(c2-10, oy, c2-15, oy-2);
outtextxy(c2-15, oy+5, 'x');

{xac dinh gioi han do thi va ty le toa do thuc so voi man hinh}
sizex := ((c2-c1) div 2)-40;
sizey := ((d2-d1) div 2)-40;
candoidothi(xbegin, xend, kx, ky, sizex, sizey);

{danh dau cac diem dac biet}
{diem uon}
putpixel(ox + round(xu*kx), oy - round(yu*ky), 14);

{cuc tri}
if (delta>0) then
begin
putpixel(ox + round(x1*kx), oy - round(y1*ky), 14); {cuc tri}
putpixel(ox + round(x2*kx), oy - round(y2*ky), 14); {cuc tri}
end;

{ve do thi}
x:=xbegin;
y:=F(x);
moveto(ox + round(x*kx), oy - round(y*ky));
repeat
x := x + 0.01;
y := F(x);
lineto(ox + round(x*kx), oy - round(y*ky));
until (x >= xend);
end;
(*-----------------------------------------------------*)
{in chuoi va xuong dong trong man hinh do hoa}
procedure outtextln(s: string);
begin
outtext(s);
moveto(0, gety + 2*textheight('H'));
end;
(*-----------------------------------------------------*)
{chuyen doi tu kieu so sang chuoi}
function tostring(x: real): string;
var
s: string;
begin
str(x:0:2, s); {lam tron den hai chu so thap phan}
if (s[length(s)] = '0') then
begin
delete(s, length(s), 1);
if (s[length(s)] = '0') then delete(s, length(s)-1, 2);
end;
tostring := s;
end;
(*----------------------------------------------------*)
{chuyen doi tu kieu so sang chuoi voi dinh dang phu hop}
function tostr(x: real): string;
var
s: string;
begin
str(x:0:2, s); {lam tron den hai chu so thap phan}
if (s[length(s)] = '0') then
begin
delete(s, length(s), 1);
if (s[length(s)] = '0') then delete(s, length(s)-1, 2);
end;
if (x<0) then s := '(' + s + ')';
tostr := s;
end;
(*-------------------------------------------------------------*)
procedure khaosat;
var
w, h: integer;
begin
w:=textwidth('W');
h:=textheight('H');

outtextln('Khao sat va ve do thi ham so:');
outtextln('y = ' + tostr(a) + 'x^3' + ' + ' + tostr(b) + 'x^2' + ' + ' + tostr(c) + 'x' + ' + ' + tostr(d));
outtext('(So thuc lam tron den hai chu so thap phan)');
moveto(0, gety + h);
outtextln('-------------------------------------------');
outtextln('* TXD la R');
outtextln('* Dao ham cap mot:');
outtextln('y'' = ' + tostr(3*a) + 'x^2' + ' + ' + tostr(2*b) + 'x' + ' + ' + tostr(c));
if (delta>0) then
begin
outtextln('y''= 0 <=> x= ' + tostring(x1) + ' hoac x= ' + tostring(x2) + ' (cuc tri)');
outtext('x= ' + tostring(x1) + ' => y= ' + tostring(y1) + '; ');
outtextln('x= ' + tostring(x2) + ' => y= ' + tostring(y2));
end
else
if (a<0) then
begin
if (delta=0) then
outtextln('=> y'' <= 0 voi moi x')
else
outtextln('=> y'' < 0 voi moi x');
outtextln('=> Ham so nghich bien tren R (ko co cuc tri)');
end
else
begin
if (delta=0) then
outtextln('=> y'' >= 0 voi moi x')
else
outtextln('=> y'' > 0 voi moi x');
outtextln('=> Ham so dong bien tren R (ko co cuc tri)');
end;
outtextln('* Dao ham cap hai:');
outtextln('y'''' = ' + tostr(6*a) + 'x' + ' + ' + tostr(2*b));
outtextln('y'''' = 0 <=> x = ' + tostring(xu));

{bang y''}
line(6*w, gety, 6*w, gety + 10*h);
line(2*w, gety + 3*h, 42*w, gety + 3*h);
line(2*w, gety + 6*h, 42*w, gety + 6*h);
line(24*w, gety + 6*h, 32*w, gety + 7*h);
line(32*w, gety + 7*h, 32*w, gety + 10*h);
line(24*w, gety + 6*h, 16*w, gety + 7*h);
line(16*w, gety + 7*h, 16*w, gety + 10*h);

moveto(3*w, gety + h);
outtext('x');
moveto(7*w, gety);
outtext('-oo');
moveto(24*w, gety);
settextjustify(1,2);
outtext(tostring(xu));
settextjustify(0,2);
moveto(39*w, gety);
outtext('+oo');
moveto(3*w, gety + 3*h);
outtext('y''');
moveto(12*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(24*w, gety);
outtext('0');
moveto(36*w, gety);
if (a>0) then
outtext('-')
else
outtext('+');
moveto(23*w, gety + 3*h);
outtext('D.U');
moveto(3*w, gety + h);
outtext('C');
moveto(11*w, gety);
if (a>0) then
outtext('lom')
else
outtext('loi');
moveto(35*w, gety);
if (a>0) then
outtext('loi')
else
outtext('lom');
moveto(25*w, gety + h);
settextjustify(1,2);
outtextln('(' + tostring(xu) + ';' + tostring(yu) + ')');
settextjustify(0,2);
outtextln('Qua x=' + tostring(xu) + ' y'''' doi dau');
outtextln('=>I('+ tostring(xu) + ';' + tostring(yu) + ') la diem uon');

{gioi han ham so}
outtext('* Gioi han: ');
if(a>0) then outtext('lim(y) = +oo lim(y) = -oo')
else outtext('lim(y) = -oo lim(y) = +oo');
moveto(0, gety + h);
outtextln(' x->+oo x->-oo');

{bang bien thien}
outtextln('* Bang bien thien:');
line(6*w, gety, 6*w, gety + 10*h);
line(2*w, gety + 3*h, 42*w, gety + 3*h);
line(2*w, gety + 6*h, 42*w, gety + 6*h);

moveto(0, gety + h);
moveto(3*w, gety);
outtext('x');
moveto(7*w, gety);
outtext('-oo');
moveto(39*w, gety);
outtext('+oo');
if (delta<=0) then
begin
if (delta=0) then
begin
moveto(24*w, gety);
settextjustify(1,2);
outtext(tostring(xu));
settextjustify(0,2);
end;
moveto(3*w, gety + 3*h);
outtext('y''');
if (delta=0) then
begin
moveto(14*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(24*w, gety);
outtext('0');
moveto(36*w, gety);
if (a>0) then
outtextln('+')
else
outtextln('-');
end
else
begin
moveto(24*w, gety);
if (a>0) then
outtextln('+')
else
outtextln('-');
end;

if (a>0) then
begin
moveto(39*w, gety + h);
outtext('+oo');
moveto(3*w, gety + h);
outtext('y');
moveto(7*w, gety + h);
outtext('-oo');
line(getx + w, gety + h, getx + 28*w, gety - 2*h);
line(getx + 28*w, gety - 2*h, getx + 28*w - 5, gety - 2*h-4);
line(getx + 28*w, gety - 2*h, getx + 28*w - 4, gety - 2*h + 4);
moveto(0, gety + 3*h);
end
else
begin
moveto(7*w, gety + h);
outtext('+oo');
line(getx + w, gety, getx + 28*w, gety + 2*h);
line(getx + 28*w, gety + 2*h, getx + 28*w - 4, gety + 2*h-4);
line(getx + 28*w, gety + 2*h, getx + 28*w - 5, gety + 2*h + 4);
moveto(3*w, gety + h);
outtext('y');
moveto(39*w, gety + h);
outtextln('-oo');
end;
end
else
begin
settextjustify(1,2);
moveto(18*w, gety);
outtext(tostring(x1));
moveto(25*w, gety);
outtext(tostring(xu));
moveto(32*w, gety);
outtext(tostring(x2));
settextjustify(0,2);
moveto(3*w, gety + 3*h);
outtext('y''');
moveto(12*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(18*w, gety);
outtext('0');
moveto(25*w, gety);
if (a>0) then
outtext('-')
else
outtext('+');
moveto(32*w, gety);
outtext('0');
moveto(38*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
if (a>0) then
begin
moveto(18*w, gety + 3*h);
settextjustify(1,2);
outtext('CD(' + tostring(y1) + ')');
moveto(32*w, gety + 3*h);
outtext('CT(' + tostring(y2) + ')');
settextjustify(0,2);
moveto(3*w, gety - 2*h);
outtext('y');
moveto(39*w, gety - h);
outtext('+oo');
moveto(7*w, gety + 3*h);
outtext('-oo');
line(11*w, gety + h, 18*w, gety - 2*h);
line(18*w, gety - 2*h, 32*w, gety);
line(32*w, gety, 38*w, gety - 3*h);
moveto(0, gety + 2*h);
end
else
begin
moveto(7*w, gety + 3*h);
outtext('+oo');
moveto(32*w, gety);
settextjustify(1,2);
outtext('CD(' + tostring(y2) + ')');
moveto(18*w, gety + 3*h);
outtext('CT(' + tostring(y1) + ')');
settextjustify(0,2);
moveto(39*w, gety);
outtext('-oo');
moveto(3*w, gety - 2*h);
outtext('y');
line(11*w, gety - h, 18*w, gety + 2*h);
line(18*w, gety + 2*h, 32*w, gety);
line(32*w, gety, 38*w, gety + 3*h);
moveto(0, gety + 4*h);
end;
end;
outtextln('* Do thi: Co tam doi xung I, di qua (0,' + tostring(d) + ')');
end;
(*-----------------------------------*)
{chuong trinh chinh}
begin
isready := false;
repeat
nhapdulieu;
xulydulieu;
khoitaodohoa;
khaosat;
outtext('Nhan enter de quan sat do thi...');
readln;
vedothi(3*getmaxx div 5, 50, getmaxx, getmaxy-50);
moveto(getmaxx, getmaxy);
settextjustify(2,0);
outtext('Press any key to continue, ESC to cancel');
settextjustify(0,2);
k:=ord(readkey);
if (k=0) then k := ord(readkey);
if (k<>27) then
begin
currmode := getgraphmode;
restorecrtmode;
isready := true;
end;
until (k=27);
closegraph;
end.
avatar
anhlapro26
Thành viên mới
Thành viên mới

Nam Ngày sinh : 26/10/1989
Tuổi : 28
Ngày đăng ký : 15/01/2011

Về Đầu Trang Go down

Re: Chia se 1 bai paccal ve ve do thi

Bài gửi by duy_sau_rom on 11/4/2011, 1:55 pm

E thu chep bai nay chay nhung khong duoc. Sad
avatar
duy_sau_rom
Thành viên mới
Thành viên mới

Nam Ngày sinh : 01/09/1995
Tuổi : 22
Ngày đăng ký : 30/03/2011

Về Đầu Trang Go down

Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang

- Similar topics

 
Permissions in this forum:
Bạn không có quyền trả lời bài viết