?? vector.~pas
字號:
{-------------------------------------------------------------------------------
2003.08.11 定義向量類及相關(guān)運算
以基本類定義為基礎(chǔ)，定義向量類。該類能夠與傳統(tǒng)的數(shù)據(jù)類型進行方便的轉(zhuǎn)換。
--------------------------------------------------------------------------------
2004.07.03
向量與矩陣的乘法如何定義？列向量？還是行向量？
--------------------------------------------------------------------------------
2003.08.20
移動平均：開頭或結(jié)尾的點，有幾個就平均幾個。
求離散的差分：前差(i-(i-1))
--------------------------------------------------------------------------------
2003.08.14 實現(xiàn)求導(dǎo)、牛頓迭代
--------------------------------------------------------------------------------
2003.08.13 向量的移動:左移、右移;帶參數(shù)，表示循環(huán)與否(缺省情況是循環(huán)，否則補0)。
-------------------------------------------------------------------------------}
unit Vector;
interface
uses classes, MathTypes, DB, Series;
Type
TVectorStyle = (RowVector, ColumnVector);
TVector = class
protected
FData: TFloatArray; // 數(shù)據(jù)
FCount: integer; // 數(shù)組的大小
FVectorStyle: TVectorStyle; // 向量的類型(行向量、列向量(缺省))
{--------------------------------------------------------------------------}
FFormat: string; // 顯示格式
{--------------------------------------------------------------------------}
FErrorLimit: double; // 誤差限
FMaxIterations: Integer; // 最大迭代次數(shù)
FRoot: double; // 根
{--------------------------------------------------------------------------}
FDataSet: TDataSet; // 數(shù)據(jù)庫
FStartField: Integer; // 首字段ID
public
{ 構(gòu)造與析構(gòu)方法-----------------------------------------------------------}
constructor Create;
destructor Destroy; override;
{ 數(shù)據(jù)顯示 ----------------------------------------------------------------}
function AsString: string;
{ 數(shù)據(jù)賦值 ----------------------------------------------------------------}
procedure CopyFrom(Source: TVector);
procedure CopyFromArray(x: array of double);
procedure LoadFromDatabase(ADataSet: TDataSet; FieldID: integer = 0;
Start: integer = 0; nCount: integer = -1);
overload;
procedure LoadFromDatabase; overload;
{ 數(shù)據(jù)維護 ----------------------------------------------------------------}
function LeftCopy(N: integer): TVector;
procedure Resize(NCount: integer);
{ 常見的數(shù)值方法 ----------------------------------------------------------}
function Average: double; // 平均值
function Value(x: double): double; // 多項式求值
function Derivative: TVector; // 多項式的導(dǎo)數(shù)
procedure Transpose;
{ 有方程求根算法-----------------------------------------------------------}
function NewtonIteration: double; // 牛頓迭代法求根
{ 有關(guān)統(tǒng)計的算法-----------------------------------------------------------}
function MovingAverage(N: integer=3): TVector; // 移動平均
function GetMinIndex: integer; // 找極小值
function GetMaxIndex: integer; // 找極大值
function GetAbsMaxIndex: integer; // 找絕對極大值
function GetLocalAbsMaxIndex(FirstID, LastID: integer): integer; // 找局部絕對極大值
function GetLocalMaxIndex(FirstID, LastID: integer): integer; // 找局部極大值
function GetLocalMinIndex(FirstID, LastID: integer): integer; // 找局部極小值
published
property Count: integer read FCount write Resize;
property Values: TFloatArray read FData write FData;
property DisplayFormat: string read FFormat write FFormat;
property ErrorLimit: double read FErrorLimit write FErrorLimit; // 誤差限
property MaxIterations: Integer read FMaxIterations write FMaxIterations; // 最大迭代次數(shù)
property Root: double read FRoot write FRoot; // 根
property Style: TVectorStyle read FVectorStyle write FVectorStyle; // 向量類型
end;
procedure ShowVectorAsSeries(Vx,Vy: TVector; aSeries: TCustomSeries;
StartIndex: integer = 0; nCount: integer = -1);
implementation
uses math, sysutils, dialogs;
{ TVector }
procedure TVector.CopyFromArray(x: array of double);
Var
i,N: integer;
begin
N := Length(x);
Resize(N);
for i:=0 to N-1 do FData[i] := x[i];
end;
procedure TVector.CopyFrom(Source: TVector);
Var
i: integer;
begin
if Source is TVector then begin
Resize((Source as TVector).FCount);
for i:=0 to FCount-1 do FData[i] := (Source as TVector).Values[i];
end;
end;
function TVector.AsString: string;
Var
i: Integer;
begin
Result := '';
for i:=0 to FCount-1 do
if Result='' then
Result := Format(FFormat,[FData[i]])
else
Result := Result + Format(' + ' + FFormat+' x^%d',[FData[i],i]);
end;
function TVector.Average: double;
Var
r: double;
i: integer;
begin
r := 0;
for i:=0 to FCount-1 do r := r + FData[i];
Result := r / FCount;
end;
constructor TVector.Create;
begin
inherited Create;
FData := nil;
FFormat := '%.4f';
FErrorLimit := 1e-5; // 誤差限
FMaxIterations := 1000; // 最大迭代次數(shù)
FRoot := 0; // 根
FVectorStyle := ColumnVector; // 缺省是列向量
end;
// 求多項式的導(dǎo)數(shù)
function TVector.Derivative: TVector;
Var
i: integer;
begin
Result := TVector.Create;
if FCount>1 then begin
Result.Resize (FCount-1); // 多項式的大小
// 計算一階導(dǎo)數(shù)
for i:=0 to FCount-2 do Result.FData[i] := FData[i+1] * (i+1);
end else begin
Result.Resize(1);
Result.FData[0] := 0;
end;
end;
destructor TVector.Destroy;
begin
FData := nil;
inherited;
end;
function TVector.GetAbsMaxIndex: integer;
Var
tmp: double;
i,k: integer;
begin
tmp := abs(FData[0]);
k := 0;
for i:=1 to FCount-1 do begin
if tmp<abs(FData[i]) then begin
tmp := abs(FData[i]);
k := i;
end;
end;
Result := k;
end;
function TVector.GetLocalAbsMaxIndex(FirstID, LastID: integer): integer;
Var
tmp: double;
i,k: integer;
begin
tmp := abs(FData[FirstID]);
k := FirstID;
for i:=FirstID+1 to LastID do begin
if tmp<abs(FData[i]) then begin
tmp := abs(FData[i]);
k := i;
end;
end;
Result := k;
end;
function TVector.GetLocalMaxIndex(FirstID, LastID: integer): integer;
Var
tmp: double;
i,k: integer;
begin
tmp := FData[FirstID];
k := FirstID;
for i:=FirstID+1 to LastID do begin
if tmp<FData[i] then begin
tmp := FData[i];
k := i;
end;
end;
Result := k;
end;
function TVector.GetLocalMinIndex(FirstID, LastID: integer): integer;
Var
tmp: double;
i,k: integer;
begin
tmp := FData[FirstID];
k := FirstID;
for i:=FirstID+1 to LastID do begin
if tmp>FData[i] then begin
tmp := FData[i];
k := i;
end;
end;
Result := k;
end;
function TVector.GetMaxIndex: integer;
Var
tmp: double;
i,k: integer;
begin
tmp := FData[0];
k := 0;
for i:=1 to FCount-1 do begin
if tmp<FData[i] then begin
tmp := FData[i];
k := i;
end;
end;
Result := k;
end;
function TVector.GetMinIndex: integer;
Var
tmp: double;
i,k: integer;
begin
tmp := FData[0];
k := 0;
for i:=1 to FCount-1 do begin
if tmp>FData[i] then begin
tmp := FData[i];
k := i;
end;
end;
Result := k;
end;
function TVector.LeftCopy(N: integer): TVector;
Var
i: Integer;
begin
Result := TVector.Create;
Result.Resize(N);
for i:=0 to N-1 do Result.Values[i] := FData[i];
end;
procedure TVector.LoadFromDatabase(ADataSet: TDataSet; FieldID: integer = 0;
Start: integer = 0; nCount: integer = -1);
Var
i,N: integer;
begin
N := ADataSet.RecordCount;
if nCount>0 then Resize(nCount)
else Resize(N);
ADataSet.FindFirst;
for i:=0 to Start-1 do ADataSet.Next;
if nCount<0 then begin
for i:=0 to N-1 do
if NOT ADataSet.Eof then begin
FData[i] := ADataSet.Fields[FieldId].AsFloat;
ADataSet.Next;
end else break;
end else begin
for i:=0 to nCount-1 do
if NOT ADataSet.Eof then begin
FData[i] := ADataSet.Fields[FieldId].AsFloat;
ADataSet.Next;
end else break;
end;
end;
function TVector.MovingAverage(N: integer): TVector;
Var
L, R, i, Z, j: integer;
y: TVector;
a: double;
begin
if not odd(N) then N := N+1;
Z := N div 2;
y := TVector.Create;
y.Resize(FCount);
for i:=0 to FCount-1 do begin
a := 0;
// 左端
L := 0;
if i>=Z then begin
for j:=i-Z to i-1 do begin
a := a + FData[j];
inc(L);
end;
end else begin
for j:=0 to i-1 do begin
a := a + FData[j];
inc(L);
end;
end;
// 中心點
a := a + FData[i];
// 右端
R := 0;
if i<FCount-Z then begin
for j:=i+1 to i+Z do begin
a := a + FData[j];
inc(R);
end;
end else begin
for j:=i+1 to FCount-1 do begin
a := a + FData[j];
inc(R);
end;
end;
y.FData[i] := a / (L + R + 1);
end;
Result := y;
end;
function TVector.NewtonIteration: double;
Var
i: Integer;
xn, xn_1, e: double;
dp: TVector;
begin
// 計算一階導(dǎo)數(shù)
dp := Derivative;
// 開始迭代
i := 0;
xn_1 := FRoot;
Repeat
xn := xn_1 - poly(xn_1, FData) / poly(xn_1, dp.FData);
e := abs(xn - xn_1);
inc(i);
if e >= FErrorLimit then xn_1 := xn;
Until (i>FMaxIterations) or (e < FErrorLimit);
if i>FMaxIterations then showmessage('牛頓迭代不收斂！');
FRoot := (xn + xn_1) / 2;
Result := FRoot;
end;
procedure TVector.Resize(NCount: integer);
begin
if NCount<>FCount then begin
FData := nil;
SetLength(FData, NCount);
FCount := NCount;
end;
end;
function TVector.Value(x: double): double;
begin
Result := Poly(x, FData);
end;
procedure ShowVectorAsSeries(Vx,Vy: TVector; aSeries: TCustomSeries;
StartIndex: integer = 0; nCount: integer = -1);
Var
i,N: integer;
begin
aSeries.Clear;
if nCount>0 then N := StartIndex + nCount
else N := StartIndex + Vx.Count;
for i:=StartIndex to N-1 do aSeries.AddXY(Vx.Values[i], Vy.Values[i]);
end;
procedure TVector.Transpose;
begin
if FVectorStyle = ColumnVector then FVectorStyle := RowVector
else FVectorStyle := ColumnVector;
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -