IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Помогите с графической частью..., Вычисление интеграла методом симпсона 3/8. Маштабирование
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской
Реальное имя: Роман

Репутация: -  0  +


Вычисление интеграла методом симпсона 3/8
Вот задание:
Исходные данные:
Число уравнений 3. y=a*x^3+b*x+c; y=a*sin(x+b)+c; y=a*ln|x+b|+c; Коэффициенты a, b, c вещественные числа задаются с клавиатуры. Пределы интегрирования – вещественные числа, лежащие в пределах от –1000 до 1000. Число интервалов разбиения не более 500.
Отобразить на экране в графическом режиме с учетом масштабирования процесс вычисления интеграла. Выдать на экран точное и приближенное значения интеграла, погрешность вычисления.
Вот я написал код программы. Все работает, строит графики, но во второй функции (синусоида) иногда, при некоторых коэффициентах сбивается масштабирование, причем сбивается по оси Y(выходит за пределы экрана). Подписи под осями тоже не всегда отображаются. И еще когда вводишь число разбиений разное, почему-то значение интеграла не меняется... Поэтому сделал фиксированное...
Вот собственно код:


program simps3_8;
uses crt,graph;
type
funct = function (x:real):real;
var
a,b,i,q,w,c,err,Ir:real;
n:integer;
j:char;
function f1(x:real):real;far;
begin
f1:=q*x*x*x+w*x+c;
end;

function f2(x:real):real;far;
begin
f2:=q*sin(x+w)+c;
end;

function f3(x:real):real;far;
begin
f3:=q*ln(abs(x+w))+c;
end;

procedure Simps(f1:funct; a,b:real; var I:real);
var
x,h,q,w,c:real;
e,m,n:integer;
begin
i:=0;
x:=a;
h:=(b-a)/n;
I:=(3*h/8)*(f1(x)+f1(b));
for e:=1 to n-1 do begin
if (e mod 3=0) then
m:=2 else m:=3;
x:=x+h;
I:=I+(3*h*m*f1(x)/8);
end;
end;

procedure out_grp(f1:funct;xmin,xmax,ymin,ymax:real);
var
drv,mode:integer;
mx,my:real;
xx,yy:real;
sx:real;
dltx,dlty:integer;
s:string;
begin
drv:=VGA;
mode:=VGAHi;
initgraph(drv,mode,'');
ymin:=ymin/10;
if (xmin/xmax)>0.1 then dltx:=20 else dltx:=0;
if (ymin/ymax)>0.1 then dlty:=20 else dlty:=0;
mx:=500/(xmax-xmin);
my:=400/(ymax-ymin);
sx:=(xmax-xmin)/550;
settextjustify(1,1);
xx:=xmin;
repeat
setcolor(1);
line(trunc(40+mx*(xx-xmin)+dltx),20,trunc(40+mx*(xx-xmin)+dltx),469);
str(xx:4:2,s);
setcolor(15);
outtextxy(trunc(40+mx*(xx-xmin)+dltx),475,s);
xx:=xx+50*sx;
until (xx>(xmax+50*sx));
yy:=ymin+(ymax-ymin)/10;
repeat
setcolor(1);
line(41,trunc(470-my*(yy-ymin)-dlty),630,trunc(470-my*(yy-ymin)-dlty));
str(yy:4:2,s);
setcolor(15);
outtextxy(20,trunc(470-my*(yy-ymin)-dlty),s);
yy:=yy+(ymax-ymin)/10;
until (yy>(ymax+(ymax-ymin)/10));
line(40,0,40,480);
line(0,470,640,470);
line(40,0,38,10);
line(40,0,42,10);
line(640,470,630,472);
line(640,470,630,468);
xx:=xmin;
repeat
yy:=f1(xx);
putpixel(trunc(40+mx*(xx-xmin)+dltx),trunc(470-my*(yy-ymin)-dlty),7);
xx:=xx+sx;
until (xx>xmax);
outtextxy(300,10,' Press ESC to continue ');
outtextxy(635,455,'X');
outtextxy(20,10,'Y');
repeat until (readkey=#27);
closegraph;
end;

begin
clrscr;
writeln('Введите коэффициенты уравнения a,b,c');
readln(q,w,c);
writeln('Введите нижний и верхний пределы интегрирования');
readln(a,b);
if (a>1000) or (a<-1000) or (b>1000) or (b<-1000) then begin
writeln('Превышен допустимый предел, нажмите любую клавишу чтобы выйти');
readkey;
exit;
end;
n:=500;
writeln('Выберите функцию:');
writeln('Нажмите 1, чтобы выбрать функцию:',q:5:2,'*x^3+',w:5:2,'*x+',c:5:2);
writeln(' Нажмите 2, чтобы выбрать функцию:',q:5:2,'*sin(x+',w:5:2,')+',c:5:2);
writeln(' Нажмите 3, чтобы выбрать функцию:',q:5:2,'*ln|x+',w:5:2,'|+',c:5:2);
j:=readkey;
if(j=#49) then begin
simps(f1,a,b,i);
Ir:=(q*b*b*b*b/4+w*b*b/2+c*b)-(q*a*a*a*a/4+w*a*a/2+c*a);
err:=abs(I-Ir)/I*100;
out_grp(f1,a,b,f1(a),f1(b));
end;
if(j=#50) then begin
simps(f2,a,b,i);
Ir:=(c*b-q*cos(b+w))-(c*a-q*cos(a+w));
err:=abs(I-Ir)/I*100;
out_grp(f2,a,b,f2(a),f2(b));
end;
if(j=#51) then begin
simps(f3,a,b,i);
Ir:=(c*b-q*(b+w)+q*(b+w)*ln(b+w))-(c*a-q*(a+w)+q*(a+w)*ln(a+w));
err:=abs(I-Ir)/I*100;
out_grp(f3,a,b,f3(a),f3(b));
end;
writeln('Приближенное значение интеграла I=',i:15:11);
writeln('Точное значение интеграла I=',Ir:15:11);
writeln('error =',err:15:11,' %');
writeln('Число интервалов: ',n);
readkey;
end.


Простите что нету комментариев((( еще не успел....
Был бы очень признателен если хотя бы подредактировали только графическую часть. Т.е. процедуру out_grp; Т.к. я плохо там всё понимаю и писал её на примере другой программы.
Я часть с подсчетом интеграла мне понятна и вполне устраивает.

Сообщение отредактировано: Роман -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской
Реальное имя: Роман

Репутация: -  0  +


я уже почти разобрался.
Просьба к админам удалить что ли тему раз никому не интересноsad.gif

Сообщение отредактировано: Роман -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гуру
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской
Ада: Разработчик
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик

Репутация: -  627  +


Кто тебе виноват, что ты все завязал на "магических константах", и чем разобраться, что к чему, проще переписать с нуля программу?

Для начала, я бы выводил подписи по оси OX с двух сторон, то есть, чередовал бы вывод сверху/снизу:
Прикрепленное изображение

     i := 1;
repeat
setcolor(blue);
line(trunc(40+mx*(xx-xmin)+dltx),20,trunc(40+mx*(xx-xmin)+dltx),469);
str(xx:4:2,s);
setcolor(white);
if odd(i) then
outtextxy(trunc(40+mx*(xx-xmin)+dltx),475,s)
else
outtextxy(trunc(40+mx*(xx-xmin)+dltx),455,s);
inc(i);
xx:=xx+50*sx;
until (xx>(xmax+50*sx));
+ надо будет поднять само изображение абсциссы и стрелочку.

Во-вторых, неплохо было бы привести коэффициенты (входные данные), на которых происходит то, о чем ты говоришь. А не заставлять тех, кто зашел в тему и решил помочь, подбирать это вручную. Ты этого не сделал - вопрос остался без ответа... Это не значит, что тема никому не интересна. Это значит, что неинтересно делать то, чего можно было бы в принципе не делать - если бы вопрос был поставлен правильно.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской
Реальное имя: Роман

Репутация: -  0  +


Цитата(IUnknown @ 24.05.2011 14:50) *

Во-вторых, неплохо было бы привести коэффициенты (входные данные), на которых происходит то, о чем ты говоришь. А не заставлять тех, кто зашел в тему и решил помочь, подбирать это вручную. Ты этого не сделал - вопрос остался без ответа... Это не значит, что тема никому не интересна. Это значит, что неинтересно делать то, чего можно было бы в принципе не делать - если бы вопрос был поставлен правильно.

допустим a=30 b=1 c=30
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской
Реальное имя: Роман

Репутация: -  0  +




procedure out_grp(f1:funct;xmin,xmax,ymin,ymax:real);
var
drv,mode:integer;
mx,my:real;
xx,yy:real;
sx:real;
dltx,dlty,midx,midy:integer;
s:string;
begin
drv:=VGA;
mode:=VGAHi;
initgraph(drv,mode,'');
SetLineStyle(SolidLn,0,ThickWidth);
rectangle(0,0,getmaxx,getmaxy); {рамка вокруг графика}
if abs(xmin/xmax)<0.1 then dltx:=10 else dltx:=0;
if (abs(xmin/xmax)<0.1) and (xmin<0) then dltx:=-10 else dltx:=0;
ymin:=ymin/10; {хз зачем, но так лучше 0_0}
midx:=getmaxx div 2;
midy:=getmaxy div 2;
mx:=(midx/4)/(xmax-xmin); {типо масштабирование}
my:=(midy/10)/(ymax-ymin); {типо масштабирование}
sx:=(xmax-xmin)/getmaxx;
settextjustify(CenterText,CenterText);
xx:=xmin;
SetLineStyle(SolidLn,0,NormWidth);
line(midx,0,midx,getmaxy); {ось y}
line(0,midy,getmaxx,midy); {ось x}
line(midx,0,midx-10,10); {стрелочка на оси y}
line(midx,0,midx+10,10);
line(getmaxx,midy,getmaxx-10,midy+10); {стрелочка на оси x}
line(getmaxx,midy,getmaxx-10,midy-10);
xx:=xmin;
str(xx:4:2,s);
yy:=f1(xx);
outtextxy(trunc(midx+mx*xx+dltx),midy+10,s);
SetLineStyle(CenterLn,0,NormWidth);
line(trunc(midx+mx*xx+dltx),midy,trunc(midx+mx*xx+dltx),trunc(midy-my*yy)); {пунктирная линия предела}
MoveTo(trunc(midx+mx*xx+dltx),trunc(midy-my*yy));
SetLineStyle(SolidLn,0,NormWidth);
repeat {вывод графика}
yy:=f1(xx);
LineTo(trunc(midx+mx*xx+dltx),trunc(midy-my*yy));
xx:=xx+sx;
MoveTo(trunc(midx+mx*xx+dltx),trunc(midy-my*yy));
until (xx>xmax);
str(xx:4:2,s);
SetLineStyle(CenterLn,0,NormWidth);
line(trunc(midx+mx*xx+dltx),midy,trunc(midx+mx*xx+dltx),trunc(midy-my*yy)); {пунктирная линия предела}
outtextxy(trunc(midx+mx*xx+dltx),midy+10,s);
outtextxy(trunc(midx/2),10,' Press ESC to continue ');
outtextxy(630,220,'X');
outtextxy(300,10,'Y');
outtextxy(330,230,'0');
repeat until (readkey=#27);
closegraph;
end;


вот подправил чуть чуть... Решил сделать без сетки + подписи только на концах интервала
Пожалуйста помогите как сделать чтобы график автоматически растягивался или сужался по осям, чтобы не выходил за пределы осей, помогите плиз, я пытался сделать но всеравно криво получаетсяsad.gif(((

Сообщение отредактировано: Роман -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской
Реальное имя: Роман

Репутация: -  0  +


Все всем спасибо, переписал с нуля графическую часть, вопрос решен, все правильно строит при любых коэффициентах.
P.S удалите тему а то палевоsmile.gif курсач как бы) хотя как хотите)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 15.05.2024 6:07
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name