На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
Модераторы: Romtek, volvo877
  
    > Как нарисовать график функции, на интервале от А до Б
      ExpandedWrap disabled
        type TFunction=function(x:real):real;
        procedure drawgraph(f:TFunction;a,b:real);
        var i,j:integer;
            d,dd,x,y,m,mm:real;
            s:string;
        begin
          if a=b then begin
            putpixel(getmaxx div 2,getmaxy div 2,14);
            exit end; {если А=Б, то график - точка, а уж где она будет...}
          if a>b then begin
            d:=a;
            a:=b;
            b:=d; {поменяли местами}
          end;
          d:=(b-a)/(getmaxx-1); {интервал изменения значения ф-и, чтобы каждый раз не считать}
          {теперь считаем диапазон значений ф-и}
          m:=f(a);
          mm:=f(a);
          x:=a;
          while x<=b do begin
            x:=x+d;
            y:=f(x); {вот это собственно и есть график, хехе. Мы его просто пока не рисуем}
            if m<y then m:=y;
            if mm>y then mm:=y;
          end; {теперь М - это максимум, ММ - минимум}
          dd:=(m-mm)/(getmaxy-1);
          {собственно рисуем}
          i:=1;
          x:=a;
          y:=f(a);
          setcolor(14);
          str(y:0:3,s);
          j:=getmaxy-trunc((y-mm)/dd); {графика не признает действительных чисел}
          if j>getmaxy-40 then outtextxy(1,j-15,s) else outtextxy(1,j+10,s); {выводим начальное значение F(a)}
          setcolor(12);
          str(a:0:2,s);
          if j>getmaxy div 2 then outtextxy(1,1,s) else outtextxy(1,getmaxy-textheight(s)-1,s); {это значение А}
          setcolor(11);
          moveto(i,j);
          while x<=b do begin
            x:=x+d;
            inc(i); {смещение Х на D эквивалентно смещению точки на 1 по экрану}
            y:=f(x);
            j:=getmaxy-trunc((y-mm)/dd);
            lineto(i,j); {из предыдущего положения - в текущее, а предыдущее сначала задается moveto'м, а потом его помнит модуль графики}
          end;
          {график нарисовали, теперь оформлЯем}
          setcolor(14);
          str(y:0:3,s);
          if j>getmaxy-40 then outtextxy(getmaxx-textwidth(s)-1,j-15,s) else outtextxy(getmaxx-textwidth(s)-1,j+10,s); {такой трюк для того, чтобы все цифры поместились на экране}
          setcolor(12);
          str(b:0:2,s);
          if j>getmaxy div 2 then outtextxy(getmaxx-textwidth(s)-1,1,s) else outtextxy(getmaxx-textwidth(s)-1,getmaxy-textheight(s)-1,s);
          {ну и хватит}
        end;


      Надо же, всего одна ошибка, не ту разницу по Y ставил.

      Добавлено в :
      Так. Теперь как все это работает.

      Сначала проверяется корректность данных. Вообще-то в любой функции должна быть какая-то проверка входящих данных. Считается, что А меньше Б, но нам могут подсунуть что угодно.

      Считается интервал взятия последовательных Х. Нам не нужна большая точность здесь, хватает смещать точку на графике на один пиксел по горизонтали. Начинается экран с Х=1, туда ставим Х=А, а заканчивается видимая часть в GetMaxX, который может меняться в зависимости от установленного видеорежима. (320, 640, 720, 800, 1024, какие есть драйверы графики в руках.) Посему и шаг взятия значений функции нужно менять.

      Первый цикл while x<=b do begin... ищет границы изменения функции на указанном промежутке. Если нам дали f(x)=1/x, A=-1, B=1, то получится деление на 0. Ну и ладно, пусть программист думает, что он подсунул. Просчет очень простой, проходим по отрезку и ищем максимум и минимум, запоминая их в переменных М и ММ.

      Аналогичным способом берется шаг отображения по оси ординат, переменная DD.

      Строим график, в начале выводим красным цветом А и желтым Y=F(A). График строится как кривая линия с линейной же интерполяцией. А зачем нам больше? В каждом взятом Х берем Y и рассчитываем точку, в которую нужно вести линию. Минимум значения Y соответствует значению GetMaxY, который опять же зависит от установленного режима, а максимум соответствует всегда единице.

      Дошли до конца, выводим на экран конечные значения B, F(B).

      Для того, чтобы можно было передать функцию, она должна быть объявлена так же, как написано в типе (только необязательно, чтобы переменная в формальных параметрах называлась так же), и она должна быть объявлена как далекая (после ее заголовка должна идти директива FAR.) Например вот так:
      ExpandedWrap disabled
        function MyVeryCoolFunction(MyVar:real):real; far;
        begin
          MyVeryCoolFunction:=exp(sin(MyVar));
        end;
      А передаваться она должна как переменная, т.е. ее необходимо присвоить заведенной где-нибудь переменной типа TFunction.
      Сообщение отредактировано: romtek -
      Долог путь в бессмертие... я еще вернусь.
      Профильный скилл "Телепатия" 8%
      ТРОЛЛЬ - Троян Разрушительный Опасный, Лучше ЛинятЬ (с) Freezing Spell
      Прошу потестить игру.
        Мой вариант:
        ExpandedWrap disabled
          {$N+,E-}
           
          uses Crt,Graph;
           
          type TFunction=function(x:real):real;
           
          Const Scale=80.0; { Коэффициент увеличения графика }
          var cx,cy, { центр, точка отсчета }
              mx,my: integer; { Максимальные значения по X и Y }
           
          function InitGraphics: integer;
          Var grDriver, grMode : Integer;
          begin
               grDriver:=Detect;
               InitGraph(grDriver, grMode, '..\bgi');
               InitGraphics:=GraphResult;
          end;
           
          function CoordX(X: real): integer; {графика не признает действительных чисел}
          begin
               CoordX:=cx+Trunc(X*Scale);
          end;
           
          function CoordY(Y: real): integer;
          begin
               CoordY:=cy-Trunc(Y*Scale);
          end;
           
          function MyVeryCoolFunction(MyVar:real):real; Far;
          begin
            MyVeryCoolFunction:=sin(exp(MyVar));
          end;
           
          procedure PlotAxis;
          begin
               SetColor(LightBlue);
               Line(0,cy,mx,cy);
               Line(cx,0,cx,my);
          end;
           
          procedure DrawGraph(PF: Pointer; a,b: real);
          var F: TFunction;
              temp,
              Step, { Шаг }
              x,y,
              Minimum,Maximum: real;
           
          procedure Net;
          var
              z,t: real;
              i,j: integer;
              s: string;
          begin
               SetColor(Red);
               z:=a;
               t:=(b-a)/10.0;
               while z<=b do
               begin
                    str(z:0:1,s);
                    i:=CoordX(z);
                    Line(i,cy-2,i,cy+2);
                    OutTextXY(i,cy+6,s);
                    z:=z+t;
               end;
           
               SetColor(LightRed);
               SetLineStyle(DottedLn, 0, NormWidth);
               j:=CoordY(Minimum);
               Line(0,j,mx,j);
               j:=CoordY(Maximum);
               Line(0,j,mx,j);
          end;
           
          begin
               @F:=PF;
           
               {если А=Б, то график - точка}
               if a=b then begin
                 putpixel(CoordX(a),CoordX(F(a)),Yellow);
                 exit
               end;
               if a>b then begin
                 temp:=a;
                 a:=b;
                 b:=temp; {поменяли местами}
               end;
               {интервал изменения значения ф-и, чтобы каждый раз не считать}
               Step:=(b-a)/(MX+1)*1.0;
               {теперь считаем диапазон значений ф-и}
               Minimum:=F(a);
               Maximum:=Minimum;
               x:=a;
               MoveTo(CoordX(x),CoordY(F(x)));
               SetColor(Yellow);
           
               {собственно рисуем}
               while x<=b do begin
                 x:=x+Step;
                 y:=F(x); { вычисление значения функции в точке }
                 LineTo(CoordX(x),CoordY(y)); {из предыдущего положения - в текущее, а предыдущее
                 сначала задается MoveTo, его помнит модуль графики}
                 if Minimum<y then Minimum:=y;
                 if Maximum>y then Maximum:=y;
               end;
           
               {график нарисовали, теперь оформлЯем}
               Net;
          end;
           
          begin
               if InitGraphics<>grOK then Exit;
           
               MX := GetMaxX;
               MY := GetMaxY;
               CX := MX div 2;
               CY := MY div 2;
           
               PlotAxis;
           
               DrawGraph(@MyVeryCoolFunction,-4.0,4.0);
           
               repeat until keypressed;
               CloseGraph;
          end.

        Проверено в Turbo Pascal и Free Pascal.
        Внизу картинка графика.
        Прикреплённый файлПрикреплённый файлGraph.gif (5.39 Кбайт, скачиваний: 1661)
          А вот графики в
          - параметрической С.К. (plotgraf2.pas)
          - полярной С.К. (plotgraf3.pas)
          Сообщение отредактировано: Romtek -

          Прикреплённый файлПрикреплённый файлplotgraf.zip (2.19 Кбайт, скачиваний: 596)
            Вот картинка графика в параметрической системе координат:
            Прикреплённый файлПрикреплённый файлPLOTGR2.PNG (5.69 Кбайт, скачиваний: 1269)
              и картинка графика в полярной системе координат:
              Прикреплённый файлПрикреплённый файлPLOTGR3.PNG (4.99 Кбайт, скачиваний: 1010)
              1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script Execution time: 0,0783 ]   [ 15 queries used ]   [ Generated: 22.07.19, 06:27 GMT ]