Delphi de cubicspline enterpolasyonu

[pandora303]

Aslında basit bişey yapmak istiyorum ama bulduğum onca companentle istediğim işi yapamadım.

Elimde 10 tane noktanın (x,y) koordinatı var ve ben bu noktalar arasında olmak şartıyla herhangi bir x noktasındaki y değerini cubicspline enterpolasyonu ile hesaplamak istiyorum.Bunu Delphi 7 de nasıl yapabilirim yardımcı olabilecek var mı?

[sabanakman]

Elimde 10 tane noktanın (x,y) koordinatı var ve ben bu noktalar arasında olmak şartıyla herhangi bir x noktasındaki y değerini cubicspline enterpolasyonu ile hesaplamak istiyorum

Acep Türkçe açıklaması ne ola ki?

[Z.D.]

http://niuwenchai.bokee.com/1103667.html

bu adreste bir örnek var, biraz sadeleştirip kullanabilirsiniz sanırım

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  PT4 = array[1..5] of TPOINT;
  CalcArray = array[1..4,1..4] of real;
  A1000_4=array[1..100,1..4]of real;
  TCurveType = (Cat_Rom, {Cubic spline ????,????}
                B_Spline, {Cubic spline ?????,????}
                Ext_Tspline, {Triginometric spline  ?????,????}
                Int_Tspline ); {Cubic spline ????; ????}


  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Points,Ps:array of TPoint;
    pcount,psc:integer;
    procedure PlotCurves(P1,P2,P3,P4 : TPOINT; C : TColor );
    procedure PlotCurve(ACanvas: TCanvas; P1, P2, P3, P4: TPOINT; C: TColor);
  end;

var
  Form1: TForm1;
  Max_Points : real; {Max number of points to interpolate per segment}
  Curve : A1000_4; {Current interpolating curve}
  Curr_Basis : TCurveType; {Type of basis function being used}

const
  Bspline : CalcArray = ( ( -0.166667, 0.5, -0.5, 0.166667 ), ( 0.5, -1.0, 0.0, 0.666667 ), ( -0.5, 0.5, 0.5, 0.166667 ), ( 0.166667, 0.0, 0.0, 0.0 ) );
  Catrom :  CalcArray = ( ( -0.5, 1.0, -0.5, 0.0 ), ( 1.5, -2.5, 0.0, 1.0 ), ( -1.5, 2.0, 0.5, 0.0 ), ( 0.5, -0.5, 0.0, 0.0 ) );

implementation

{$R *.dfm}

function CubicSpline( t : real; n : integer; M : CalcArray ) : real;
{ Calculates value of nth cubic basis function specified by M for parameter t; calculates basis curve one point at a time; called by SetBasis }
var
  T1, T2, T3 : real;
begin
  T1 := t;
  T2 := t*t;
  T3 := t*t*t;
  CubicSpline := T3*M[n,1] + T2*M[n,2] + T1*M[n,3] + M[n,4];
end;
{CubicSpline}
{-------------------------------------------------------------------}

function ExTSpline( t : real; n : integer ) : real;
{ Calculates the value of the n-th basis function for the exterpolating triginometric spline for parameter t; used to calculate the basis curve one point at a time; Called by SetBasis }
var
  Sn, Cs : real;
begin
  Sn := sin( 0.5*Pi*t );
  Cs := cos( 0.5*Pi*t );
  case n of
    1 : ExTSpline := 0.25*( 1 - Cs);
    2 : ExTspline := 0.25*( 1 + Sn);
    3 : ExTspline := 0.25*( 1 + Cs);
    4 : ExTspline := 0.25*( 1 - Sn);
  end;
end;
{ExTspline}
{-------------------------------------------------------------------}

function InTspline( t : real; n : integer ) : real;
{ Calculates the value of the n-th basis function for the interpolating triginometric spline for parameter t; used to calculate the basis curve one point at a time; Called by SetBasis }
var
  Sn, Cs : real;
begin
  Sn := sin( 0.5*Pi*t );
  Cs := cos( 0.5*Pi*t );
  case n of
    1 :InTspline := 0.5*Cs*(Cs - 1 );
    2 : InTspline := 0.5*Sn*(Sn + 1 );
    3 : InTspline := 0.5*Cs*(Cs + 1 );
    4 : InTspline := 0.5*Sn*(Sn - 1 );
  end;
end;
{InTspline}
{-------------------------------------------------------------------}

procedure SetBasis( Basis : TCurveType; Max : integer);
{Pre-calculate basis function at specified granularity}
var
  t : real;
  i, j : integer;
begin
  Curr_Basis := Basis;
  if Max > 1000 then
  Max_Points := 1000    {set granularity <= 1000}
  else Max_Points := Max;
  for i:= 1 to Max do
  begin
    t:= i/Max;
    case Basis of  {calculate basis curves on point a time}
      Ext_Tspline : {exterpolating trig spline}
        for j:= 1 to 4 do Curve[i,j] := ExTspline( t, j );
      Int_Tspline : {interpolating trig spline}
        for j:= 1 to 4 do Curve[i,j] := InTspline( t, j );
      Cat_Rom  : {Catmull-Rom cubic spline}
        for j:= 1 to 4 do Curve[i,j] := CubicSpline( t, j, CatRom );
      B_Spline : {BSpline cubic spline}
        for j:= 1 to 4 do Curve[i,j] := CubicSpline( t, j, BSpline );
    end;
  end;
end;
{SetBasis}
{-------------------------------------------------------------------}

procedure TForm1.PlotCurve(ACanvas: TCanvas; P1, P2, P3, P4: TPOINT; C: TColor);
{Plots a segment of the defined curve in the specified color; called by Render_Curve }
var
  Xo, X1, X2, X3, X4, t, T1, T2, T3, Yo, Y1, Y2, Y3, Y4 : real;
  i, j, Max, X, Y : integer;
begin
  Max := round( Max_Points );
  X1 := P1.X;
  X2 := P2.X;
  X3 := P3.X;
  X4 := P4.X;
  Y1 := P1.Y;
  Y2 := P2.Y;
  Y3 := P3.Y;
  Y4 := P4.Y;
  SetBasis(Int_Tspline, Max);   //??????
  if (Curr_Basis=Cat_Rom) or (Curr_Basis=B_Spline) then //???,???????????,??????,??????????
    for i:= 1 to Max do
    begin { vary thru [0,1] & plot basis functn}
      Setlength(ps,psc+1);
      ps[psc].X := round(X1*Curve[i,1] + X2*Curve[i,2] + X3*Curve[i,3] + X4*Curve[i,4]) ;
      ps[psc].Y := round(Y1*Curve[i,1] + Y2*Curve[i,2] + Y3*Curve[i,3] + Y4*Curve[i,4]) ;
      inc(psc);
    end
  else
    for i:= Max downto 1 do   //???,???????????,??????,??????????
    begin { vary thru [0,1] & plot basis functn}
      Setlength(ps,psc+1);
      ps[psc].X := round(X1*Curve[i,1] + X2*Curve[i,2] + X3*Curve[i,3] + X4*Curve[i,4]) ;
      ps[psc].Y := round(Y1*Curve[i,1] + Y2*Curve[i,2] + Y3*Curve[i,3] + Y4*Curve[i,4]) ;
      inc(psc);
    end
end;

{ TForm1 }

procedure TForm1.PlotCurves(P1, P2, P3, P4: TPOINT; C: TColor);
begin
  PlotCurve(canvas,p1,p2,p3,p4,c);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PCount:=0;
  Max_Points:=20;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  Setlength(Points,Pcount+1);
  Points[PCount]:=Point(x,y);
  inc(Pcount);
  if Pcount>=4 then
  begin
    psc:=0;
    for i:=0 to Pcount-4 do
      PlotCurves(Points[i],Points[i+1],Points[i+2],Points[i+3],clred);
  end;
  invalidate;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i,j:integer;
begin
  i:=0;
  while i<=pcount-1 do
  begin
    Canvas.Rectangle(Points[i].X-2,Points[i].Y-2,Points[i].X+2,Points[i].Y+2);
    inc(i);
  end;
  if Pcount>=4 then
    Canvas.Polyline(ps);
end;

end.