Линейная интерполяция Опции

[Женя]

Условие:

---
Пусть функция y(x) задана таблицей:

Xi X1 X2 X3 ... Xm
Yi Y1 Y2 Y3 ... Ym

Составить программу для вычисления значения этой функции в произвольной точке X1<=X<=Xm по формуле линейной интерполяции:

                  X - Xi
Y(X) = Yi + --------- * (Yi+1 - Yi)
                Xi+1 - Xi

, где Xi<=X<=Xi+1

Расчёт функции оформить в виде подпрограммы. Таблица и значение аргумента вводятся, результат расчёта выводить в главной программе.

> i+1, 2, 3, m, i - это всё нижний индекс.
---

Вот начал делать, и что-то не получается.. пожалуйста, проведите корректировку:

Код

program inter;
type
mas=array [1..10] of real;
var x,y: mas;
i,m,n:integer;
g:real;

Procedure Input (m1:integer; var x1:mas);
var i:integer;
begin
writeln ('Введите значения X: ');
for i:=1 to m1 do
readln (x1[i]);
end;

Procedure Input1 (m1:integer; var y1:mas);
var i:integer;
begin
writeln ('Введите значения Y: ');
for i:=1 to m1 do
readln (y1[i]);
end;

Function Summa (m1,n1:integer;x1,y1:mas):real;
var i:integer;
s:real;
begin
for i:=1 to m1-1 do
begin
if x1[i+1]-x1[i]=0 then begin writeln('y(x) - не существует.');
end
else
s:=y1[i]+((x1[n1]-x1[i])/(x1[i+1]-x1[i]))*(y1[i+1]-y1[i]);
end;
summa:=s;
end;

begin
writeln ('Введите количество элементов X, Y: ');
readln(m);
Input (m,x);
Input1 (m,y);
Writeln ('Введите произвольную точку: ');
readln(n);
g:=summa (m,n,x,y);
writeln ('Значения равны: ',g:10:5);
readln
end.

Заранее благодарен!

Сообщение отредактировано: volvo - 22.12.2004 0:28

[volvo]

Вообще-то, насколько я помню, интерполяция производится так:

Код

const
 size = 10;
type
 mas = array[1 .. size] of real;

var
 x, y: mas;
 i,m:integer;
 xnew, g:real;

procedure Input(const s: string;
         sz: integer; var arr: mas);
 var i: integer;
 begin
   writeln('Введите значения ' + s + ': ');
   for i := 1 to sz do
     readln(arr[i])
 end;

function intrp(x: real; xarr, yarr: mas; sz: integer): real;
 var
   i: integer;
 begin
   intrp := 0;
   if (x < xarr[1]) or (x > xarr[sz]) then
     writeln('невозможно произвести интерполяцию y(x)')
   else
     begin
       i := sz;
       repeat dec(i)
       until x > xarr[i];
       intrp := yarr[i] + (x - xarr[i])/(xarr[i+1] - xarr[i]) *
                                (yarr[i+1] - yarr[i])
     end;
 end;

begin
writeln ('Введите количество элементов X, Y: ');
readln(m);
Input('X', m, x);
Input('Y', m, y);

Writeln ('Введите произвольную точку:');
readln(xnew);
g:=intrp(xnew, x, y, m);
writeln ('Значение равно: ',g:10:5);
readln
end.

[Jill]

а возможно ли...
- произвести не линейную, а сплайн-интерполяцию
- вычислить полином Лагранжа (например, при заданных значениях X0=0.5, X1=0, X2=1, Y0=-0.21, Y1=-1.5, Y2=0.53, вывести результат: 3.07*x*x - 1.04*x -1.5)
- графически отобразить начальную интерполяцию и полином
...или я расфантазировалась? ручками все просчитала и нарисовала, а вот Pascal...

[volvo]

Jill,
Кубический сплайн не подойдет (по-моему, даже с отрисовкой ) ? Или тебе именно полиномом Лагранжа

ручками все просчитала и нарисовала, а вот Pascal...

Обижаешь... Если можно сделать ручками, то надо просто объяснить компьютеру, как это сделать на Паскале...

[Jill]

подойдет, конечно
пошла разбираться...

а полином Лагранжа (и еще Ньютона вдобавок) мне надо обязательно - просчитать и нарисовать...



ЗЫ: не обижаю - мне еще далеко до волшебника - я только учусь компьютер меня не всегда понимает, а с паскалем я на подобные темы - "на вы и шепотом"

[volvo]

Вот это посмотри: http://bib.com.ua/info863.html

[Jill]

ого! проектик...

попробуй, разберись...
1. не поняла, как вносятся заданные координаты в INTERPOL.DAT - в описаловке - попарно - это XYXY или XXYY?

2. сам INTERPOL.PAS рисовать не хочет / то есть ошибок не выдает, но и не рисует ничего... хотя GRAPHICS.PAS (я так поняла, для примера) рисует очень даже крассссиво не могу найти причину... вроде аналогично все...

3. и совсем не поняла назначение BPTRAP.PAS и MAKEDATA.PAS.........

[volvo]

не могу найти причину...

Во-первых, EGAVGA.BGI скопируй в директорию с проектом, и измени строку инициализации на:

Код

InitGraph(grDriver, grMode, '');

, ну, а во-вторых, ты запускаешь с параметром? Надо запускать так:

F:\interpol interpol.dat

, программа проверяет наличие параметров командной строки...

Или указывай параметры так: в меню -> Run -> Parameters вводи только имя файла данных: interpol.dat

P.S. Координаты заносятся XYXY (именно попарно, а не "сначала все X, потом все Y")

[Jill]

Во-первых, EGAVGA.BGI скопируй в директорию с проектом, и измени строку инициализации на:

InitGraph(grDriver, grMode, '');

EGAVGA.BGI валяется в директории, в строке инициализации писать так:

InitGraph(grDriver, grMode, 'EGAVGA.BGI');

? эт я уточняю

С
-> Run -> Parameters
получилось, но с запуском с параметрами через консоль я не поняла

вырисовывает 2 функции / но по листингу их 3! (стандарт, лагранж и ньютон)
или что-то накладывается...?

[volvo]

Нет, графика инициализируется именно с пустой строкой...

или что-то накладывается...?

Ньютон перекрывает Лагранжа... Чтобы увидеть это, сделай так:

  DrawPlace(@Standart, GetMin(Data), GetMax(Data), 0.1);

  SetColor(Yellow);
  SetLineStyle(DottedLn, 0, ThickWidth);
  DrawGraph(@Lagrange, GetMin(Data), GetMax(Data), 0.1);
  readln;

  SetColor(Green);
  SetLineStyle(DottedLn, 0, ThickWidth);
  DrawGraph(@Newton, GetMin(Data), GetMax(Data), 0.1);
  readln;

  SetColor(Red);
  SetLineStyle(SolidLn, 0, ThickWidth);
  DrawGraph(@Standart, GetMin(Data), GetMax(Data), 0.1);

и ты увидишь, что "зеленый" Newton закрывает "желтого" Lagrange

А через консоль - после системного приглашения печатай:
interpol interpol.dat
и будет тебе Счастье

[Jill]

Ньютон перекрывает Лагранжа...

посмотрела

volvo, а по моим координатам график почему-то прорисовывается ломаный - с острыми углами...

и еще вопрос: можно интерполяционные узлы как-то отметить, выделить?

[volvo]

Ну, а координаты-то свои привести можешь? А то телепаты в отпуске у нас...

[Jill]

вот они :-)
-1E+0000
1.0090E+0000
-0.9E+0000
0.4743E+0000
-0.8E+0000
0.2475E+0000
-0.7E+0000
0.4091E+0000
-0.6E+0000
0.6512E+0000
-0.5E+0000
0.6007E+0000
-0.4E+0000
0.0361E+0000
-0.3E+0000
-0.7662E+0000
-0.2E+0000
-1.3814E+0000
-0.1E+0000
-1.4429E+0000

...маткад прорисовывает сплайном...

[volvo]

 DrawGraph(@Lagrange, GetMin(Data), GetMax(Data), 0.01); { шаг уменьшай до 0.01 }
...
 DrawGraph(@Newton, GetMin(Data), GetMax(Data), 0.01); { здесь тоже }

Достаточно неплохая кривая получается...

[Jill]

супер!
вот где собака порылась...

повторю вопрос насчет выделения узлов - это возможно?

[volvo]

повторю вопрос насчет выделения узлов - это возможно?

Вот чего я наваял... Изменяешь процедуру DrawGraph вот так:

procedure DrawGraph(D: PData; f: Pointer; MinX, MaxX, Step: Real);
type
  TFunction = function(x: Real): Real;
var
  p: PData;

  x, y, Inf, Sup: Real;
  xl, yt, xr, yb, i: Integer;
  Error, Define: Boolean;
begin
  if Step = 0 then Exit;
  x := MinX; Define := False;
  while x < MaxX do begin
    if not Trap then begin
      y := TFunction(f)(x);
      if not Define then begin
        Inf := y; Sup := y; Define := True; end
      else begin
        if Inf > y then Inf := y;
        if Sup < y then Sup := y;
      end;
    end;
    UnTrap;
    x := x + Step;
  end;
  if not Define then Exit;
  xl := 60; yt := 20; xr := GetMaxX - 30; yb := GetMaxY - 20;
  x := MinX;
  Error := True;
  while x < MaxX do begin
    if not Trap then begin
      y := TFunction(f)(x);
      if Error then begin
        MoveTo(xl + Round((x - MinX) * (xr - xl) / (MaxX - MinX)),
          GetMaxY - Round((y - Inf) * (yb - yt) / (Sup - Inf)) - yt);
        Error := False; end
      else
        LineTo(xl + Round((x - MinX) * (xr - xl) / (MaxX - MinX)),
          GetMaxY - Round((y - Inf) * (yb - yt) / (Sup - Inf)) - yt); end
    else
      Error := True;
    UnTrap;
    x := x + Step;
  end;

  SetColor(LightRed);
  p := D;
  while p <> nil do begin
    x := p^.x; y := p^.y;
    Circle(xl + Round((x - MinX) * (xr - xl) / (MaxX - MinX)),
      GetMaxY - Round((y - Inf) * (yb - yt) / (Sup - Inf)) - yt, 3);
    p := p^.next;
  end;
end;

Ну, и вызов, соответственно:

  SetColor(Yellow);
  SetLineStyle(DottedLn, 0, ThickWidth);
  DrawGraph(Data, @Lagrange, GetMin(Data), GetMax(Data), 0.01);

  SetColor(Green);
  SetLineStyle(DottedLn, 0, ThickWidth);
  DrawGraph(Data, @Newton, GetMin(Data), GetMax(Data), 0.01);

  SetColor(Red);
  SetLineStyle(SolidLn, 0, ThickWidth);
  DrawGraph(nil, @Standart, GetMin(Data), GetMax(Data), 0.1); { NIL если не нужны узлы }

[Jill]

Супер! Узлы - то, что надо


volvo, я так и не поняла для чего BPTRAP.PAS и MAKEDATA.PAS.... первый - отлавливает и прорабатывает ошибки? а второй....?

[volvo]

Jill, насколько я вижу, если MAKEDATA.PAS переименовать, например, в __MAKE.PAS, то основная программа продолжает компилироваться, то есть, этот файл вообще-то не нужен для нормальной работы программы... Я его даже перенес в другую директорию, и тогда тоже все работает... Можно удалять

А первый... Если при выполнении функции возникает Run-Time Error, то программа "откатывается" назад, ДО вызова этой сбойной функции, и возвращается True (чтоб ошибочную функцию больше не вызывать, или поменять параметр, возможно дело именно в параметре)...

[Jill]

пасиба за объяснения




volvo, у меня тут еще вопрос возник - все бьюсь и бьюсь - по тому же поводу, но отдельной программкой - как сделать так, чтобы с клавиатуры ввести количество точек, их координаты - и вывелись коэффициенты? сама функция LAGRANGE небольшая, но не получается у меня ее прицепить к вектору значений координат

по той ссылке, что ты давал (супер библиотека!!! за нее отдельное спасибо), нашла готовую прогу вычисления - но она слишком большая, сложная и с "наворотами" (типа - ввод с клавиатуры или из файла + визуальное оформление - не это не нужно, а грамотно "обрезать" не получается...)

[Jill]

volvo, посмотри, пожалуйста

почему-то процедура Lagrange на гора результаты выдавать не хочет - как ввели координаты, так и выводим... :-(

в чем загвозка? подскажи, плз!

ВОПРОС СНЯТ - У МЕНЯ ВСЕ ПОЛУЧИЛОСЬ!!!!!!!!!

Сообщение отредактировано: Jill - 6.01.2006 15:41