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

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

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

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Линейная интерполяция
сообщение
Сообщение #1


Гость






Условие:

---
Пусть функция 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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

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

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


а возможно ли...
- произвести не линейную, а сплайн-интерполяцию
- вычислить полином Лагранжа (например, при заданных значениях 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...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Jill,
Кубический сплайн не подойдет (по-моему, даже с отрисовкой smile.gif ) ? Или тебе именно полиномом Лагранжа
Цитата
ручками все просчитала и нарисовала, а вот Pascal...
Обижаешь... Если можно сделать ручками, то надо просто объяснить компьютеру, как это сделать на Паскале... yes2.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Пионер
**

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

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


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

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



ЗЫ: не обижаю - мне еще далеко до волшебника - я только учусь wink.gif компьютер меня не всегда понимает, а с паскалем я на подобные темы - "на вы и шепотом" wink.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Вот это посмотри: http://bib.com.ua/info863.html
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

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

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


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

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

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

3. и совсем не поняла назначение BPTRAP.PAS и MAKEDATA.PAS......... unsure.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Цитата
не могу найти причину...
Во-первых, EGAVGA.BGI скопируй в директорию с проектом, и измени строку инициализации на:
Код
InitGraph(grDriver, grMode, '');
, ну, а во-вторых, ты запускаешь с параметром? Надо запускать так:
Цитата(Console)
F:\interpol interpol.dat
, программа проверяет наличие параметров командной строки...

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

P.S. Координаты заносятся XYXY (именно попарно, а не "сначала все X, потом все Y")
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

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

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


Цитата

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



EGAVGA.BGI валяется в директории, в строке инициализации писать так:
InitGraph(grDriver, grMode, 'EGAVGA.BGI');
? эт я уточняю wink.gif

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

вырисовывает 2 функции / но по листингу их 3! (стандарт, лагранж и ньютон)
или что-то накладывается...?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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

Цитата
или что-то накладывается...?
yes2.gif Ньютон перекрывает Лагранжа... Чтобы увидеть это, сделай так:
  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 smile.gif

А через консоль - после системного приглашения печатай:
interpol interpol.dat
и будет тебе Счастье smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Пионер
**

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

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


Цитата

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

посмотрела smile.gif

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

и еще вопрос: можно интерполяционные узлы как-то отметить, выделить?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Ну, а координаты-то свои привести можешь? А то телепаты в отпуске у нас... blum.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Пионер
**

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

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


вот они :-)
-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

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


Гость






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

Достаточно неплохая кривая получается... smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Пионер
**

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

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


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

повторю вопрос насчет выделения узлов - это возможно?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






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

Вот чего я наваял... Изменяешь процедуру 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 если не нужны узлы }
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Пионер
**

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

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


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


volvo, я так и не поняла для чего BPTRAP.PAS и MAKEDATA.PAS.... первый - отлавливает и прорабатывает ошибки? а второй....?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






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

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


Пионер
**

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

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


пасиба за объяснения smile.gif




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

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


Пионер
**

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

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


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

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

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

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

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


Прикрепленные файлы
Прикрепленный файл  LAG.PAS ( 4.27 килобайт ) Кол-во скачиваний: 496
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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