Работа с двумя графиками, Проблемы с масштабированием Опции

[Pilotchik]

Итак, вот есть задачка! Построить 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

setcolor(blue);
line(round(xm[i]*kf+dx),round(ym[i]*(-kf)+dy),round(xm[i+1]*kf+dx),round(ym[i+1]*(-1)*kf+dy));
setcolor(red);
line(round(xm[i]*kf+dx),round(ym2[i]*(-kf)+dy),round(xm2[i+1]*kf+dx),round(ym2[i+1]*(-kf)+dy));

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]

Думаю, ни у одного меня возникнут вопросы с такими вот программами...

О, да, не у одного.
Первый вопрос: как насчет файла данных graficpr.txt ? Не облагодетельствуешь?..

[Pilotchik]

О, да, не у одного.
Первый вопрос: как насчет файла данных graficpr.txt ? Не облагодетельствуешь?..

Всмысле? Просто он нужен по условию... В него вносятся массивы с иксами и игриками функций, а потом берутся из него же... хотя это итак видно из процедур. Наличие процедур тоже - условие. А вообще файлик автоматически создаётся при вводе новых данных

Сообщение отредактировано: Pilotchik - 18.01.2007 5:05

[Bokul]

Помогите найти ошибку (почему-то cos0 для программы не 1, а 0,5)...

В паскале тригонометрические функции работают с радианным представлениям угла...

[Pilotchik]

В паскале тригонометрические функции работают с радианным представлениям угла...

Ясненько, а что? из-за этого изменится его значение? Напомните плиз как его перевести в градусы. Но мне не верится! Дело в том, что 2 график - это разложение в ряд Тейлора того же самого косинуса! И в точке "0" они соввпадают, но лежат не на единичке!

Сообщение отредактировано: Pilotchik - 18.01.2007 5:10

[Bokul]

Напомните плиз как его перевести в градусы.

Ты хотел сказать в радианы?

function rad(q:real):real;
begin
        rad:=q/180*pi;
end;

из-за этого изменится его значение?

Для нуля нет, но более корректно работать с тем представлением, с которым умеет работать паскаль.

[Pilotchik]

так в том-то и дело! Показываем преподу, а он говорит: "А хто это сделал..."(Гарик Аристархович) и прочий лол... Косинус нуля должен быть равен единичке по-любому! Если нет, то программа неправильная! И я с ним согласен... проблема не в радианах, ИМХО, но спасибо за совет

Сообщение отредактировано: Pilotchik - 18.01.2007 5:24

[volvo]

Приведи описание ВСЕХ вводимых в программу данных... Что такое, например, "коэффициент B" ?

[Pilotchik]

Приведи описание ВСЕХ вводимых в программу данных... Что такое, например, "коэффициент B" ?

Это коэффициент смещения функции по игрику для функции: cos(x)+b
n- число точек, с помощью которых будет строиться график
Хнач - это начальное х!
Хкон - это конечное х!

[Pilotchik]

Задачка же интересная! Ну посмотрите, пожалуйста!

[Lapp]

Задачка же интересная! Ну посмотрите, пожалуйста!

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

[Pilotchik]

Всё ясно, я ж тоже не сидел просто так, сюда обратился, потомучто уже ничего не мог сделать...

[Pilotchik]

Посмотрите, очень надо.. если бы были web-money, заплатил бы, наверное... но дожен же быть у форумчан спортивный интерес!

[volvo]

Спортивный интерес? А как, по-твоему, разбираться в том, что ты нагородил? Вот тут, например:

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

setcolor(blue);
line(round(xm[i]*kf+dx),round(ym[i]*(-kf)+dy),round(xm[i+1]*kf+dx),round(ym[i+1]*(-1)*kf+dy));
setcolor(red);
line(round(xm[i]*kf+dx),round(ym2[i]*(-kf)+dy),round(xm2[i+1]*kf+dx),round(ym2[i+1]*(-kf)+dy));

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]

Итак,хорошенько раскинув мозгами и почитав наконец-таки умную литературу вот что получил! Критикуйте

Код

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.