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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.12.2009, 17:27   #1
tanek
Форумчанин
 
Регистрация: 07.03.2009
Сообщений: 209
Печаль интерполяция сплайнами

Здраствуйте уважаемые форумчанины..... У меня появилась такая проблема....
Я написала программу по теме интерполирование кубическими сплайнами
Она вроде бы как работает верно но вот появился один ньюансик....
программа должна сгладить график, а она это не делает...
т.е. у мееня рисуется график с помощь прямых а должен с помощью гипербол...
может я где то наврала... помогите мне исправить.....(((((
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    DefinitionMatrix: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    Chart1: TChart;
    Series1: TLineSeries;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
  Nmax=100;
Type
  Mas1 = array[1..Nmax] of extended;

var
  Form1: TForm1;
     x:mas1;
  y:mas1;
  a,b,c,d,h,s,alpha,beta: mas1;
  t,k: extended; // abcissa
  n: integer; //chislo uzlovih to4ek

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var ret,s1,s2: extended;
i,j,truex: integer;
a1,c1,b1,f1,z1: extended;
h1,h2: mas1;
left,right,q: extended;
begin
     series1.Clear;
    n:=StrToInt(Edit1.Text);
    t:=StrToFloat(Edit2.Text);

      truex:=0;

     for i:=1 to n-1 do
       x[i]:=StrToFloat(DefinitionMatrix.Cells[1,i]);
    for i:=1 to n-1 do
       y[i]:=StrToFloat(DefinitionMatrix.Cells[2,i]);
     for i:=1 to n-2 do
    If x[i]<x[i+1] then
    else truex:=truex+1;

      If truex=0 then
begin
for i:=2 to n-1 do
    begin
     h1[i]:=x[i]-x[i-1];
    end;
   h1[1]:=h1[2];
   c[1]:=0;
   c[n-1]:=0;

alpha[1]:=0;
beta[1]:=0;
for i:=2 to n-2 do
begin
h1[i]:=x[i]- x[i - 1];
h2[i]:=x[i + 1] - x[i];
A1:= h1[i];
C1:=2* (h1[i] + h2[i]);
B1:= h2[i];
F1:= 6* ((y[i + 1] - y[i]) / h2[i] - (y[i] - y[i - 1]) / h1[i]);
z1:= (A1 * alpha[i - 1] + C1);
alpha[i] := -B1 / z1;
beta[i] := (F1 - A1 * beta[i - 1]) / z1;




end;

for i:=n-2 downto 1 do
begin
c[i] := alpha[i+1] * c[i+1] + beta[i+1];

end;
for i:=2 to n-1 do
begin
      h1[i]:=x[i] - x[i - 1];
      d[i]:=(c[i]-c[i-1])/h1[i];
      b[i]:=h1[i]*c[i]/2-Sqr(h1[i])*d[i]/6+(y[i]-y[i-1])/h1[i];
 end;
     memo1.Lines.Add('s0(x)='+floattostr(y[1]));
    for i:=2 to n-1 do
    begin

    memo1.Lines.Add('');
    memo1.Lines.Add('s'+inttostr(i)+'(x)='+floattostr(y[i])+'+('+floattostr(b[i])+')(x-('+floattostr(x[i])+'))+('+floattostr(c[i])+'/2)(x-('+floattostr(x[i])+'))^2+('+floattostr(d[i])+'/6)(x-('+floattostr(x[i])+'))^3');

    memo1.Lines.Add('na intervale['+floattostr(x[i-1])+';'+floattostr(x[i])+']');

    end;

for i:=1 to n-2 do
begin
if (t>=x[i]) and (t<x[i+1]) then
begin
memo1.Lines.Add('  ');
s1:=y[i]+b[i]*(t-x[i])+(c[i]/2)*(t-x[i])*(t-x[i])+(d[i]/6)*(t-x[i])*(t-x[i])*(t-x[i]);

end;
end;
memo1.Lines.Add(floattostr(s1));


q:=x[1];
series1.AddXY(x[1],y[1],'');
for i:=2 to n-2 do
begin
repeat
s2:=y[i]+b[i]*(q-x[i])+(c[i]/2)*(q-x[i])*(q-x[i])+(d[i]/6)*(q-x[i])*(q-x[i])*(q-x[i]);
series1.AddXY(q,s2,'');
q:=q+1;
until (q>x[i+1]);
end;
series1.AddXY(x[n-1],y[n-1],'');



end
else showmessage ('Must x1<X2<X3<...<Xn');

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
n:=StrToInt(Edit1.Text);
DefinitionMatrix.RowCount:=n;

end;


end.
я буду вам очень благодарна
Вложения
Тип файла: rar new folder.rar (9.6 Кб, 58 просмотров)
tanek вне форума Ответить с цитированием
Старый 14.12.2009, 22:26   #2
tanek
Форумчанин
 
Регистрация: 07.03.2009
Сообщений: 209
По умолчанию

мальчики и девочки ну помогите мне.....
мне умные люди сказали что в узлах где у графика острый угл должны чтобы первые производные были одинаковы....
как мне исправить
tanek вне форума Ответить с цитированием
Старый 15.12.2009, 22:37   #3
tanek
Форумчанин
 
Регистрация: 07.03.2009
Сообщений: 209
По умолчанию

вот так вот.... и нет не одного ответа....
неужели так пугает заголовок?
tanek вне форума Ответить с цитированием
Старый 22.05.2011, 22:26   #4
DespeRoN
Новичок
Джуниор
 
Регистрация: 22.05.2011
Сообщений: 1
По умолчанию

___________________________

Последний раз редактировалось DespeRoN; 22.05.2011 в 22:28.
DespeRoN вне форума Ответить с цитированием
Старый 23.05.2011, 10:36   #5
KobolD
Форумчанин
 
Регистрация: 10.06.2010
Сообщений: 239
По умолчанию

Вот похожая тема
http://www.programmersforum.ru/showthread.php?t=149028
только тебе надо будет матрицу не 3х3 делать а 4х4, добавится еще уравнение для касательности во второй точке, возможно понадобится вычисление второй производной для того чтобы функция была не ломанной если точки задавать левее от предыдущей.
Ты бы хоть коментарии к коду добавила
P.S. с паскалем не помогу, т.к. на C# пишу.
Чтобы слова не расходились с делом, нужно молчать и ничего не делать.
KobolD вне форума Ответить с цитированием
Старый 06.07.2011, 00:23   #6
Михаил1800
 
Регистрация: 07.10.2010
Сообщений: 4
По умолчанию

а можешь саму прогу скинуть???
Михаил1800 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Интерполяция лагранжа Styks Общие вопросы C/C++ 4 14.12.2009 18:47
линейная интерполяция Auster Помощь студентам 4 22.04.2008 18:02
Помогите со сплайнами KnDmPetr Паскаль, Turbo Pascal, PascalABC.NET 1 25.03.2008 16:13