Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.12.2012, 20:06   #1
NENKA_PENKA
Новичок
Джуниор
 
Регистрация: 27.03.2012
Сообщений: 1
Восклицание Программа на Паскале. Интерполирование кубическими сплайнами.

Помогите, пож-та=) Есть программа, вроде все правильно делает. Но требуют еще 25 графиков сплайна..не знаю как делать


{Интерполирование функций кубическими сплайнами}
uses graphABC;
const
x_min=-5;//начало и конец графика в реальных значениях
x_max=5;
kol=25;
type vector=array [0..100000] of real; {Нумеруем точки с нуля}
var x,y,c:vector;
xl,xp,h,x1,e,p,p1,p2:real;
n,i:integer;
xx,yy,pp:array[0..100000] of real;
w,dx:real;
x0,y0:integer;

function F(x:real):real;
begin
f:=(exp(cos(x)/(1+sqr(x)))-exp(-1*cos(x)/(1+sqr(x))))/2;
end;

procedure gr(x:array[0..100000] of real;y:array[0..100000] of real;j:integer;colors:integer);
var mx,my,dx:real;
x0,y0,i,n:integer;
s:string;
begin
x0:=windowwidth div 2;//начало координат по оси Х
y0:=windowheight div 2; //по оси Y
mx:=(x0-30)/x_max;//масштаб по Х
my:=(y0-50)/F(0);//масштаб по Y
n:=12;//количество делений по осям в 1 сторону
line(20,y0,windowwidth-20,y0); //ось Х
line(x0,20,x0,windowheight-20); //ось У
for i:=1 to n do
begin
line(x0-3,y0-round(i*my/2),x0+3,y0-round(i*my/2));//засечки на оси У
line(x0-3,y0+round(i*my/2),x0+3,y0+round(i*my/2));
line(x0+round(i*mx/2),y0+3,x0+round(i*mx/2),y0-3); //засечки на оси Х
line(x0-round(i*mx/2),y0+3,x0-round(i*mx/2),y0-3);
str(i/2:0:1,s);
//подпись оси У
textout(x0-20,y0-round(i*my/2),s);{соответственно засечкам}
textout(x0-25,y0+round(i*my/2),'-'+s);
//подпись оси Х
textout(x0+round(i*mx/2),y0+10,s);
textout(x0-round(i*mx/2),y0+10,'-'+s);
end;
//центр
textout(x0+5,y0+10,'0');
//подписи концов осей
textout(windowwidth-30,y0-20,'X');
textout(x0+10,10, 'Y');
//график

x0:=windowwidth div 2;//начало координат по оси Х
y0:=windowheight div 2; //по оси Y
for i:=1 to j do
begin
setpixel(x0+round(x[i]*mx),y0-round(y[i]*my),colors);
end;
end;




procedure Input (var n:integer; var x,y:vector); {Ввод исходных данных}
var i:integer;
begin
xl:=0;xp:=5;
h:=(xp-xl)/kol;
n:=kol;
x[0]:=xl; y[0]:=f(xl);
for i:=1 to n do begin {Вычислить значения функции}
x[i]:=x[i-1]+h;
y[i]:=f(x[i]);
end;
end;

procedure Coeff(n:integer; var x,f,c:vector);
{Вычисление коээфициентов сплайна}
var i,j,m:integer;
a,b,r:real;
k:vector;
begin
{Прямой ход прогонки}
k[1]:=0; c[1]:=0;
for i:=2 to n do begin
j:=i-1;
m:=j-1;
a:=x[i]-x[j];
b:=x[j]-x[m];
r:=2*(a+b)-b*c[j];
c[i]:=a/r;
k[i]:=(3.0*((f[i]-f[j])/a-(f[j]-f[m])/b)-b*k[j])/r;
end;
{Обратный ход прогонки}
c[n]:=k[n];
for i:=n-1 downto 2 do c[i]:=k[i]-c[i]*c[i+1];
end;

procedure Spl (n:integer; var x,f,c:vector; x1:real; var p,p1,p2:real; var pp:array[0..100000] of real);
{Построение сплайна. x,f - исходные данные, c - вектор коэффициентов,
наденный процедурой Coeff, x1 - значение x, для которого строим сплайн,
p - значение сплайна в точке, p1,p2 - 1-я и 2-я производные}
var i,j:integer;
a,b,d,q,r:real;
begin
i:=1;
while (x1>x[i]) and (i<>n) do i:=i+1; {Ищем номер соседнего узла}
{Промежуточные переменные и коэффициенты}
j:=i-1; a:=f[j]; b:=x[j]; q:=x[i]-b;
r:=x1-b; p:=c[i]; d:=c[i+1];
b:=(f[i]-a)/q - (d+2*p)*q/3.0;
d:=(d-p)/q*r;
{Считаем значения сплайна и его производных:}
p1:=b+r*(2*p+d);
p2:=2*(p+d);
p:=a+r*(b+r*(p+d/3.0));
pp[i]:=p;

end;


begin
cls;
SetBrushColor(clGreen);
FillRect(0,0,windowwidth,windowheig ht);
i:=1;
w:=x_min;
dx:=0.001;
while w<=x_max do
begin
xx[i]:=w;
yy[i]:=f(xx[i]);
i:=i+1;
w:=w+dx; //наращиваем х
end;
gr(xx,yy,i,clBlue);
Input (n,x,y);
Coeff (n,x,y,c); {Нашли коэффициенты C с помощью прогонки}
writeln(' x y spline');
for i:=0 to n do
begin
Spl (n,x,y,c,x[i],p,p1,p2,pp);
write(x[i]:8:4);write(y[i]:8:4);writeln(pp[i]:8:4);
end;
gr(x,pp,n,clYellow);
end.
NENKA_PENKA вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Интерполяция сплайнами Михаил1800 Помощь студентам 0 06.07.2011 00:29
интерполяция сплайнами tanek Помощь студентам 5 06.07.2011 00:23
Интерполяция кубическими сплайнами Franzs Общие вопросы Delphi 0 25.04.2010 10:05
Помогите со сплайнами KnDmPetr Паскаль, Turbo Pascal, PascalABC.NET 1 25.03.2008 16:13
соединение точек с помощью линейной интерпаляции и интерпаляции кубическими сплайнами. yulia Помощь студентам 6 09.10.2007 07:38