Форум «Всё о Паскале» _ Задачи _ Работа с двумя графиками
Автор: Pilotchik 18.01.2007 8:44
Итак, вот есть задачка! Построить 2 графика, отмасштабированных и вывести таблицу значений...и всё это через файл Программка рисует графики, масштабирует, да только неправильно! К 4 часам утра не могу найти проблему... А сдавать в 12... Думаю, ни у одного меня возникнут вопросы с такими вот программами... Помогите найти ошибку (почему-то cos0 для программы не 1, а 0,5)...
Код
uses graph,crt; const route='c:\graficpr.txt'; k=300; eps=1E-4; Mx=640; My=480; type kord=array[1..k] of real; var n,i,a,b,c,dr,dm,e:integer; f:text; cx,cy,cxy:boolean; ch:char;
procedure osi(kf:real;yz,xz:integer); var j,kx,ky:integer; st:string; begin setcolor(15); line(15,yz,465,yz); line(462,yz-3,465,yz); line(462,yz+3,465,yz); line(xz,15,xz,465); line(xz-3,18,xz,15); line(xz+3,18,xz,15); setcolor(15); kx:=0; ky:=0; if 470-yz<10 then ky:=-1; if 470-xz<10 then kx:=-1; for j:=1 to round((yz-20)/kf) do begin line(xz-1,round(yz-j*kf),xz+1,round(yz-j*kf)); str(j,st); settextstyle(2,0,2); outtextxy(xz-10,round(yz-j*kf)-4,st); end; for j:=1 to round((450-yz)/kf)+1 do begin line(xz-1,round(yz+j*kf),xz+1,round(yz+j*kf)); str(-j,st); settextstyle(2,0,2); outtextxy(xz-13,round(yz+j*kf)-4,st); end; for j:=0 to round((xz-20)/kf) do begin line(round(xz-j*kf),yz-1,round(xz-j*kf),yz+1); str(-j,st); settextstyle(2,0,2); outtextxy(round(xz-j*kf-4),yz+2,st); end; for j:=1 to round((440-xz)/kf) do begin line(round(xz+j*kf),yz-1,round(xz+j*kf),yz+1); str(j,st); settextstyle(2,0,2); outtextxy(round(xz+j*kf-4),yz+2,st); end; settextstyle(0,0,1); outtextxy(450,yz+5+15*ky,'Ox'); outtextxy(xz+5+20*kx,15,'Oy'); cx:=true; end;
procedure func_name; begin setcolor(blue); line(480,20,500,20); outtextxy(505,20,'Y(x)=cos(x)+b'); outtextxy(554,15,'x'); setcolor(red); line(480,40,500,40); outtextxy(505,40,'F(x)=1---+-----+...'); outtextxy(567,30,'2 4 6'); outtextxy(562,35,'x x x'); outtextxy(561,46,'2! 4! 6!'); end;
procedure grafic(n:integer;xm,ym,xm2,ym2:kord); var xna4,xkon,yna4,ykon,yna42,ykon2,kfx,kfy,kf,k,dx,dy:real; xzero,yzero:integer; begin xna4:=xm[1]; xkon:=xm[n]; yna4:=ym[1]; ykon:=ym[n]; yna42:=ym2[1]; ykon2:=ym2[n]; cx:=true; cy:=true; cxy:=true; if ykon<ykon2 then ykon:=ykon2; if yna4>yna42 then yna4:=yna42; kfx:=(Mx-200)/(xkon-xna4); kfy:=(My-40)/(ykon-yna4); if kfx>=kfy then kf:=kfy else if kfx<kfy then kf:= kfx; dx:=-xna4*kf+250-(xkon-xna4)*kf/2; dy:=yna4*kf+240+(ykon-yna4)*kf/2; if round(ym[1])<>0 then k:=kf; rectangle(10,10,470,470); for i:=1 to n-1 do begin
if (round(ym2[i])=0) and cy=true then begin xzero:=round(ym2[i]*(-kf)+dy+1-k/2);cy:=false; end; if (round(xm2[i])=0) and cx=true then begin yzero:=round(xm2[i]*kf+dx+kf/2);cx:=false; end; if (cy=false) and (cx=false) and (cxy=true) then begin osi(kf,xzero,yzero);cxy:=false;end; end; func_name; end;
procedure table(n:integer;xm,ym,xm2,ym2:kord); var dx,j,x,y:integer; st,stx,sty:string; begin setcolor(blue); for j:=0 to ((n+ n mod 77)*2 div 77) do begin rectangle(1+j*80,0,15+j*80,479); rectangle(15+j*80,0,47+j*80,479); rectangle(47+j*80,0,80+j*80,479); line(1+j*80,10,80+j*80,10); if j=(n div 77) then setcolor(red); end; x:=0; y:=0; dx:=((n div 77)+1)*80; for i:=1 to n do begin setcolor(blue); str(i,st); str(xm[i]:3:3,stx); str(ym[i]:3:3,sty); settextstyle(2,0,2); outtextxy(3+x,5+i*6-y,st); outtextxy(3+15+x,5+i*6-y,stx); outtextxy(3+47+x,5+i*6-y,sty); setcolor(red); str(xm2[i]:3:3,stx); str(ym2[i]:3:3,sty); outtextxy(3+x+dx,5+i*6-y,st); outtextxy(3+15+x+dx,5+i*6-y,stx); outtextxy(3+47+x+dx,5+i*6-y,sty); for j:=1 to (n div 77)+1 do if i=77*j then begin setcolor(blue); settextstyle(2,0,4); outtextxy(5+x,-1,'N'); outtextxy(5+15+x,-1,'X'); outtextxy(5+47+x,-1,'Y(x)'); setcolor(red); outtextxy(5+x+dx,-1,'N'); outtextxy(5+15+x+dx,-1,'X'); outtextxy(5+47+x+dx,-1,'F(x)'); x:=x+80;y:=y+462; end; end; readln; readln; setfillstyle(1,0); bar(0,0,640,480); setcolor(15); end;
procedure load_from_file; var xm,ym,xm2,ym2:kord; f:text; begin assign(f,route); reset(f); readln(f,n); for i:=1 to n do begin readln(f,xm[i],ym[i],xm2[i],ym2[i]); end; close(f); table(n,xm,ym,xm2,ym2); readln; grafic(n,xm,ym,xm2,ym2); end;
procedure rec_to_file(n:integer;xm,ym,xm2,ym2:kord); begin assign(f,route); rewrite(f); writeln(f,n); for i:=1 to n do writeln(f,xm[i],' ',ym[i],' ',xm2[i],' ',ym2[i]); close(f); end;
procedure func_calc; var x,y,x2,y2,a,b,c,xna4,xkon:real; h,j:integer; xm,ym,xm2,ym2:kord; begin writeln('Vvesti novble parametrbl ??? Enter Y/N ???'); read(ch);
if ch='y' then begin writeln('Vvedite koefficient B, kol-vo to4ek, na4albnble i kone4nble zna4eni9 X'); a:=0; write(' B: ');readln(b); write('Kol-vo: ');read(n); write('Na4albnoe X:');read(xna4); write('Kone4noe X:');read(xkon); x:=xna4; j:=1; i:=1; repeat h:=0; y:=cos(x)+b; ym[i]:=y; xm[i]:=x; c:=1; y2:=c; while abs(c)>eps do begin c:=c*(-(sqr(x)/((h+1)*(h+2)))); y2:=y2+c; h:=h+1; end; xm2[i]:=x; ym2[i]:=y2; j:=j+1; i:=i+1; x:=x+((xkon-xna4)/(n-1)); until j>n; rec_to_file(n,xm,ym,xm2,ym2); end; end; begin clrscr; func_calc; dr:=detect; initgraph(dr,dm,''); load_from_file; readln; closegraph; end.
Автор: Lapp 18.01.2007 8:57
Цитата(Pilotchik @ 18.01.2007 5:44)
Думаю, ни у одного меня возникнут вопросы с такими вот программами...
О, да, не у одного. Первый вопрос: как насчет файла данных graficpr.txt ? Не облагодетельствуешь?..
Автор: Pilotchik 18.01.2007 9:02
Цитата(Lapp @ 18.01.2007 4:57)
О, да, не у одного. Первый вопрос: как насчет файла данных graficpr.txt ? Не облагодетельствуешь?..
Всмысле? Просто он нужен по условию... В него вносятся массивы с иксами и игриками функций, а потом берутся из него же... хотя это итак видно из процедур. Наличие процедур тоже - условие. А вообще файлик автоматически создаётся при вводе новых данных
Помогите найти ошибку (почему-то cos0 для программы не 1, а 0,5)...
В паскале тригонометрические функции работают с радианным представлениям угла...
Автор: Pilotchik 18.01.2007 9:08
Цитата(Bokul @ 18.01.2007 5:07)
В паскале тригонометрические функции работают с радианным представлениям угла...
Ясненько, а что? из-за этого изменится его значение? Напомните плиз как его перевести в градусы. Но мне не верится! Дело в том, что 2 график - это разложение в ряд Тейлора того же самого косинуса! И в точке "0" они соввпадают, но лежат не на единичке!
Автор: Bokul 18.01.2007 9:20
Цитата
Напомните плиз как его перевести в градусы.
Ты хотел сказать в радианы?
function rad(q:real):real; begin rad:=q/180*pi; end;
Цитата
из-за этого изменится его значение?
Для нуля нет, но более корректно работать с тем представлением, с которым умеет работать паскаль.
Автор: Pilotchik 18.01.2007 9:23
так в том-то и дело! Показываем преподу, а он говорит: "А хто это сделал..."(Гарик Аристархович) и прочий лол... Косинус нуля должен быть равен единичке по-любому! Если нет, то программа неправильная! И я с ним согласен... проблема не в радианах, ИМХО, но спасибо за совет
Автор: volvo 18.01.2007 15:24
Приведи описание ВСЕХ вводимых в программу данных... Что такое, например, "коэффициент B" ?
Автор: Pilotchik 19.01.2007 0:43
Цитата(volvo @ 18.01.2007 11:24)
Приведи описание ВСЕХ вводимых в программу данных... Что такое, например, "коэффициент B" ?
Это коэффициент смещения функции по игрику для функции: cos(x)+b n- число точек, с помощью которых будет строиться график Хнач - это начальное х! Хкон - это конечное х!
Автор: Pilotchik 19.01.2007 5:59
Задачка же интересная! Ну посмотрите, пожалуйста!
Автор: Lapp 19.01.2007 6:06
Цитата(Pilotchik @ 19.01.2007 2:59)
Задачка же интересная! Ну посмотрите, пожалуйста!
Ну посмотрел я.. извини, но написано так, что приходится продираться через дебри циферок. Если было бы в общем виде (а не привязано к конкретным координатам на экране) было бы гораздо яснее. А так.. Возможностей много. То ли ты выичсляешь неправильно, то ли оси строишь не так.. Ты извини, но, например, смещение никогда никто не называл коэффициентом. Коэффициент - это когда умножение. Понимаешь - и так не только тут.. Слишком много загадок. А прога сама по себе немалая. Вот и получается, что никто не хочет тратить время.. Попробуй хотя бы локализовать ошибку до процедуры, блока..
Автор: Pilotchik 19.01.2007 7:11
Всё ясно, я ж тоже не сидел просто так, сюда обратился, потомучто уже ничего не мог сделать...
Автор: Pilotchik 20.01.2007 2:24
Посмотрите, очень надо.. если бы были web-money, заплатил бы, наверное... но дожен же быть у форумчан спортивный интерес!
Автор: volvo 20.01.2007 2:43
Спортивный интерес? А как, по-твоему, разбираться в том, что ты нагородил? Вот тут, например:
procedure grafic(n:integer;xm,ym,xm2,ym2:kord); var xna4,xkon,yna4,ykon,yna42,ykon2,kfx,kfy,kf,k,dx,dy:real; xzero,yzero:integer; begin xna4:=xm[1]; xkon:=xm[n]; yna4:=ym[1]; ykon:=ym[n]; yna42:=ym2[1]; ykon2:=ym2[n]; cx:=true; cy:=true; cxy:=true; if ykon<ykon2 then ykon:=ykon2; if yna4>yna42 then yna4:=yna42; kfx:=(Mx-200)/(xkon-xna4); { <--- Почему 200, а не 175, к примеру? ОТКУДА это следует? Что такое 200?} kfy:=(My-40)/(ykon-yna4); { <--- Аналогично, что здесь значит 40? } if kfx>=kfy then kf:=kfy else if kfx<kfy then kf:= kfx; dx:=-xna4*kf+250-(xkon-xna4)*kf/2; { <--- Выше было 200, а здесь - 250? Что ЭТО значит?} dy:=yna4*kf+240+(ykon-yna4)*kf/2; if round(ym[1])<>0 then k:=kf; rectangle(10,10,470,470); for i:=1 to n-1 do begin
if (round(ym2[i])=0) and cy=true then begin xzero:=round(ym2[i]*(-kf)+dy+1-k/2);cy:=false; end; if (round(xm2[i])=0) and cx=true then begin yzero:=round(xm2[i]*kf+dx+kf/2);cx:=false; end; if (cy=false) and (cx=false) and (cxy=true) then begin osi(kf,xzero,yzero);cxy:=false;end; end; func_name; end;
У тебя же на этих вот неописанных константах вся игра происходит... Если бы ты делал вот так:
DX := -x_start * scale_x + viewport_x - ...
, то вопросы бы не особенно возникали, ибо было бы понятно, откуда что берется и куда подставляется... А так единственный способ разобраться - это вручную по нескольку раз менять все числа, и только тогда МОЖЕТ быть будет ясно что и где от этого меняется... А потом еще надо разобраться, как поправить это дело...
Это уже не спортивный интерес, а извращение...
Автор: Pilotchik 22.01.2007 5:37
Итак,хорошенько раскинув мозгами и почитав наконец-таки умную литературу вот что получил! Критикуйте
Код
uses crt,graph; const eps=1E-4; x0=100;xk=100;y0=100;yk=100; kvox=10;kvoy=10; type matr_real=array[1..300] of real; matr_int=array[1..300] of integer; mas_real=array[1..300] of real; mas_int=array[1..300] of integer;
function f(alf,x:real):real; begin f:=cos(x)+alf; end;
function f2(x:real):real; var h: integer;c,xu,xu2:real; begin h:=0; c:=1; xu2:=c; while abs(c)>eps do begin c:=c*(-(sqr(x)/((h+1)*(h+2)))); xu2:=xu2+c; h:=h+1; end; f2:=xu2; end;
procedure table; var i,n:integer;fil:text; x,x2:mas_real; y,y2:matr_real; j,m:integer; begin m:=10; assign(fil,'graph2.txt'); reset(fil); readln(fil,n); writeln(' ЙНННННННЛНННННННЛННННННННЛННННННН»'); writeln(' є i є x є f є y є'); writeln(' єНННННННєНННННННєННННННННєНННННННє '); for i:=1 to n do begin readln(fil,x[i],y[i],x2[i],y2[i]); writeln (' є',i,' є',x[i]:7:3,'є',y2[i]:7:3,' є', y[i]:7:3,'є'); writeln (' ИННННННННННННННННННННННННННННННННННј'); {readkey;} end; close(fil); readln; end;
procedure vvod; var f1:text;n:integer;a,b,alf:real; begin writeln('Hello!'); writeln('vvedite parametr b!'); readln(alf); writeln('vvedite kolichestvo tochek (maximum 300)'); readln(n); writeln('vvedite nachalnoe x'); readln(a); writeln('vvedite konechnoe x'); readln(b); assign(f1,'graph.txt'); rewrite(f1); writeln(f1,n); writeln(f1,a,' ',b); writeln(f1,alf); close(f1); end; procedure main; var x,x2:mas_real;u,u2:mas_int; y,y2:matr_real;v,v2:matr_int; hu,hv,grdr,grmd,i,p,n:integer; max,min,a,b,hx,hy,alf:real; c,d,g,h:real; Pattern:word; f1,fil:text; stroka:string; begin clrscr; assign(f1,'graph.txt'); reset(f1); readln(f1,n); readln(f1,a,b); readln(f1,alf); close(f1); x[1]:=a; x2[1]:=a; hx:=(b-a)/(n-1); for i:=1 to n do begin x[i]:=a+(i-1)*hx; y[i]:=f(alf,x[i]); x2[i]:=a+(i-1)*hx; y2[i]:=f2(x2[i]); end; max:=y[1]; min:=y[1]; for i:=1 to n do begin if y[i]>max then max:=y[i]; if y[i]<min then min:=y[i]; if y2[i]>max then max:=y2[i]; if y2[i]<min then min:=y2[i]; end; grdr:=detect; InitGraph(grdr,grmd,''); SetBkColor(14); SetColor(1); SetTextStyle(3,0,1); Rectangle(x0,y0,GetmaxX-xk,GetmaxY-yk); c:=(GetMaxX-x0-xk)/(b-a); d:=x0-c*a; g:=(GetMaxY-y0-yk)/(min-max); h:=y0-g*max; for i:=1 to n do begin u[i]:=trunc(c*x[i]+d); v[i]:=trunc(g*y[i]+h); u2[i]:=trunc(c*x2[i]+d); v2[i]:=trunc(g*y2[i]+h); end; assign(fil,'graph2.txt'); rewrite(fil); writeln(fil,n); for i:=1 to n-1 do writeln(fil,x[i],' ',y[i],' ',x2[i],' ',y2[i]); close(fil);
for i:=1 to n-1 do line(u[i],v[i],u[i+1],v[i+1]); SetColor(red); for i:=1 to n-1 do line(u2[i],v2[i],u2[i+1],v2[i+1]); setColor(blue); Rectangle(x0,y0,GetmaxX-xk,GetmaxY-yk); g:=(GetMaxY-y0-yk)/(min-max); h:=y0-g*max;
SetlineStyle(DashedLn,pattern,1); setcolor(1); hu:=trunc((GetmaxX-x0-xk)/(kvox-1)); hv:=trunc((GetmaxY-y0-yk)/(kvoy-1)); {postroenie setki} for i:=1 to kvox-2 do line(x0+i*hu,y0,x0+i*hu,GetMaxY-yk); for i:=1 to kvoy-2 do line(x0,y0+i*hv,GetMaxX-Xk,y0+i*hv); {//postroenie setki} hx:=(b-a)/(kvox-1); hy:=(max-min)/(kvoy-1); {koordinati po x} for i:=1 to kvox do begin Str(a+(i-1)*hx:1:1,stroka); OutTextXY(x0+(i-1)*hu-15,GetMaxY-Yk div 2 -15,stroka); end; {koordinati po y} for i:=1 to kvoy do begin Str(max-(i-1)*hy:1:1,stroka); OutTextXY(x0 div 2 - 10 ,y0+(i-1) *hv,stroka); end; {legenda} setcolor(blue); SetlineStyle(0,pattern,1); Line(GetMaxX-Xk-250,(Y0 div 4)+13,GetMaxX-Xk-200,(Y0 div 4)+13); OutTextXY(GetMaxX-Xk-190,1*Y0 div 4,'G(x)=cos(x)+b'); setcolor(red); SetlineStyle(0,pattern,1); Line(GetMaxX-Xk-250,(2*Y0 div 4)+13,GetMaxX-Xk-200,(2*Y0 div 4)+13); OutTextXY(GetMaxX-Xk-190,2*Y0 div 4,'F(x)=1-2x/2!+4x/4!-6x/6!+...');
SetlineStyle(SolidLn,pattern,1); setcolor(1); if (b>0) and (a<0) then begin line(round(d),y0,round(d),getmaxY-yk); outTextXY(round(d)-3,getmaxY-yk+40,'0'); end; if (max>0) and (min<0) then begin line(x0,round(h),GetMaxX-Xk,round(h)); outTextXY(x0-65,round(h),'0'); end; SetTextStyle(4,0,4); OutTextXY(50,30,'Graphiki f-zii'); repeat until keypressed; end; begin clrscr; vvod; main; readln; closegraph; table; readln; end.