singlelinklist.~pas

最小二乘相关介绍,最小二乘相关介绍,及其原程序!仔细整理收获不少!

//单链表单元文件
unit SingleLinkList;

interface

uses
	Windows, Messages, SysUtils, Classes, Forms, Dialogs;

type
  int = integer;

  //单链表数据类。
  TSDLinkListRec = class
  public
    Next: TSDLinkListRec;
    constructor Create;
  end;

  //单链表管理类。
  TSDLinkListMGR = class
  private
    FCount: integer;
  public
    Head: TSDLinkListRec;
    constructor Create;
    destructor  Destroy;override;
    function  IndexOf(Index: integer): TSDLinkListRec;
    function  GetIndex(SL: TSDLinkListRec): int;
    procedure Clear;virtual;
    procedure Append(SL: TSDLinkListRec);virtual;
    procedure Insert(Index, SL: TSDLinkListRec);virtual;
    procedure Delete(SL: TSDLinkListRec);virtual;
    procedure MovePrev(SL: TSDLinkListRec);
    procedure MoveNext(SL: TSDLinkListRec);
    property  Count: int read FCount;
  end;

  TDBArray = array of Double;
  TFitDataRec = class(TSDLinkListRec)
	private
    FItemName: 	String;
    FPower:     BYTE;
    FCoef:			TDBArray;
    FError:			Double;
    FFitTime:		TDateTime;
    FMemo:			TStrings;

    FDataNums:	WORD;
    FTestIn:    TDBArray;
    FTestOut:		TDBArray;
    FFitOut:		TDBArray;
    FRelError:	TDBArray;

    procedure SetItemName(Value: String);
    procedure SetCoef(Index: Integer; Value: Double);
    procedure SetPower(Value: BYTE);
    procedure SetDataNams(Value: WORD);

    procedure SetTestIn(Index: Integer; Value: Double);
    procedure SetTestOut(Index: Integer; Value: Double);
    procedure SetFitOut(Index: Integer; Value: Double);
    procedure SetRelError(Index: Integer; Value: Double);

    function GetCoef(Index: Integer): Double;

    function GetTestIn(Index: Integer): Double;
    function GetTestOut(Index: Integer): Double;
    function GetFitOut(Index: Integer): Double;
    function GetRelError(Index: Integer): Double;
  published
  	property ItemName: 	String read FItemName write SetItemName;
    property Power:     BYTE read FPower write FPower;
    property Error:			Double read FError write FError;
    property FitTime:		TDateTime read FFitTime write FFitTime;
    property Memo: TStrings read FMemo write FMemo;

    property DataNums:	WORD read FDataNums write FDataNums;
  public
  	property Coef[Index: Integer]: Double read GetCoef write SetCoef;
    property TestIn[Index: Integer]:    Double read GetTestIn write SetTestIn;
    property TestOut[Index: Integer]:		Double read GetTestOut write SetTestOut;
    property FitOut[Index: Integer]:		Double read GetFitOut write SetFitOut;
    property RelError[Index: Integer]:	Double read GetRelError write SetRelError;

    procedure ReadFromFile(var F: Text);
    procedure WriteToFile(var F: Text);
    
  	constructor Create;
  end;

  TFitDataMGR = class(TSDLinkListMGR)
    DefaultFitInfo: TFitDataRec;
    Modifyed: Boolean;

    function  FindItemByName(ItemName: String): TFitDataRec;
    
    procedure ReadFromFile(FileName: string);
    procedure WriteToFile(FileName: string);
    constructor Create;
    destructor  Destroy;override;
  end;

implementation

{
	以下是一个单链表的完整实现。包括两个类：之一是单链表中的存储数据的类。之二是对此单链表进行管理的类。
  在管理类中实现了以下操作：
    1、APPEND操作：向链表中添加节点。
    2、INSERT操作：向链表中插入节点。（插入的节点在INDEX节点后面。）
    （注意：以上操作支持多节点。）
    3、DELETE操作：删除链表中的一个节点。
    4、MOVEPREV操作：将一个节点移动到其前一个节点前。
    5、MOVENEXT操作：将一个节点移动到其后一个节点后。
    6、INDEX操作：通过索引方式查找节点。
}
//--TSDLinkListRec单链表记录类

constructor TSDLinkListRec.Create;
begin
  inherited;
  Next := nil;
end;

//--TSDLinkListMGR单链表管理类

constructor TSDLinkListMGR.Create;
begin
  inherited;
  Clear;
end;

destructor  TSDLinkListMGR.Destroy;
begin
  Clear;
  inherited;
end;

function  TSDLinkListMGR.IndexOf(Index: integer): TSDLinkListRec;
var
  T: TSDLinkListRec;
  i: integer;
begin
  i := 1;
  Result := nil;
  T := Head;
  while T <> nil do
  begin
    if i = Index then
    begin
      Result := T;
      Break;
    end;
    T := T.Next;
    Inc(i);
  end;
end;

function  TSDLinkListMGR.GetIndex(SL: TSDLinkListRec): int;
var
  P: TSDLinkListRec;
begin
  Result := 0;
  P := Head;
  while P <> nil do
  begin
    Inc(Result);
    if P = SL then
      Exit;
    P := P.Next;
  end;
  Result := 0;
end;

procedure TSDLinkListMGR.Clear;
var
  T: TSDLinkListRec;
begin
  T := Head;
  while T <> nil do
  begin
    Head := T.Next;
    T.Destroy;
    T := Head;
  end;
  Head := nil;
  FCount := 0;  
end; 

procedure TSDLinkListMGR.Append(SL: TSDLinkListRec);
var
  T: TSDLinkListRec;
  C: integer;
begin
  T := SL;
  C := 0;
  while T <> nil do
  begin
    inc(C);
    T := T.Next;            
  end;
  if C = 0 then
    Exit;
  if Head = nil then
    Head := SL
  else
  begin
    T := Head;
    while T.Next <> nil do
      T := T.Next;
    T.Next := SL;
  end;
  inc(FCount, C);
end;

procedure TSDLinkListMGR.Insert(Index, SL: TSDLinkListRec);
var
  T, T1, T2: TSDLinkListRec;
  C: integer;
begin
  C := 0;
  T := SL;
  while T <> nil do
  begin
    inc(C);
    T := T.Next;
  end;
  if C = 0 then
    Exit;
  if Head = nil then
    Head := SL
  else
  begin
    T := Head;
    while T <> nil do
    begin
      if T = Index then
      begin
        T1 := T;
        T.Next := SL;
        T2 := SL;
        while T2.Next <> nil do
          T2 := T2.Next;
        T2.Next := T1;
        Break;
      end;
      T := T.Next;
    end;
  end;
  inc(FCount, C);
end;

procedure TSDLinkListMGR.Delete(SL: TSDLinkListRec);
var
  T: TSDLinkListRec;
begin
  if SL = nil then
    Exit;
  if Head = SL then
  begin
    Head := SL.Next;
    SL.Destroy;
  end
  else
  begin
    T := Head;
    while T <> nil do
    begin
      if T.Next = SL then
      begin
        T.Next := SL.Next;
        SL.Destroy;
        Break;
      end;
      T := T.Next;
    end;
  end;
  dec(FCount);
end;

procedure TSDLinkListMGR.MovePrev(SL: TSDLinkListRec);
var
  P, C: TSDLinkListRec;
begin
  if (SL = nil) or (SL = Head) then
    Exit;
  if Head.Next = SL then
  begin
    C := SL.Next;
    SL.Next := Head;
    Head.Next := C;
    Head := SL;
  end;
  P := Head;
  C := P.Next;
  while (C.Next <> SL) and (C.Next <> nil) do
  begin
    P := C;
    C := C.Next;
  end;
  if C.Next = nil then
    Exit;
  P.Next := SL;
  C.Next := SL.Next;
  SL.Next := C;
end;

procedure TSDLinkListMGR.MoveNext(SL: TSDLinkListRec);
var
  P, C: TSDLinkListRec;
begin
  if SL = nil then
    Exit;
  if Head = nil then
    Exit;
  P := Head;
  C := P.Next;
  while C <> SL do
  begin
    P := C;
    C := C.Next;
  end;
  if C.Next = nil then
    Exit;
  C := SL.Next;
  P.Next := C;
  SL.Next := C.Next;
  C.Next := SL;
end;


// TFitDataRec
procedure TFitDataRec.SetItemName(Value: String);
begin
  if Value <> '' then
  	FItemName := Value;
end;

procedure TFitDataRec.SetPower(Value: BYTE);
begin
  if Value >= 1 then
  	SetLength(FCoef,Value+1)
  else
    Application.MessageBox('拟合方程的次数必须大于或等于1！','警告',MB_OK+MB_ICONWARNING);
end;

procedure TFitDataRec.SetDataNams(Value: WORD);
begin
  if Value >= 2 then
  begin
  	SetLength(FTestIn,Value);
    SetLength(FTestOut,Value);
    SetLength(FFitOut,Value);
    SetLength(FRelError,Value);
  end else
    Application.MessageBox('用于拟合的测量数据对个数必须大于或等于2！','警告',MB_OK+MB_ICONWARNING);
end;

procedure TFitDataRec.SetCoef(Index: Integer; Value: Double);
begin
	if (Index > -1) and (Index < (FPower+1)) then
  	FCoef[Index] := Value
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

procedure TFitDataRec.SetTestIn(Index: Integer; Value: Double);
begin
  if (Index > -1) and (Index < FDataNums) then
  	FTestIn[Index] := Value
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

procedure TFitDataRec.SetTestOut(Index: Integer; Value: Double);
begin
  if (Index > -1) and (Index < FDataNums) then
  	FTestOut[Index] := Value
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

procedure TFitDataRec.SetFitOut(Index: Integer; Value: Double);
begin
  if (Index > -1) and (Index < FDataNums) then
  	FFitOut[Index] := Value
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

procedure TFitDataRec.SetRelError(Index: Integer; Value: Double);
begin
  if (Index > -1) and (Index < FDataNums) then
  	FRelError[Index] := Value
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

function TFitDataRec.GetCoef(Index: Integer): Double;
begin
  if (Index > -1) and (Index < (FPower+1)) then
  	Result := FCoef[Index]
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

function TFitDataRec.GetTestIn(Index: Integer): Double;
begin
  if (Index > -1) and (Index < FDataNums) then
  	Result := FTestIn[Index]
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

function TFitDataRec.GetTestOut(Index: Integer): Double;
begin
  if (Index > -1) and (Index < FDataNums) then
  	Result := FTestOut[Index]
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

function TFitDataRec.GetFitOut(Index: Integer): Double;
begin
  if (Index > -1) and (Index < FDataNums) then
  	Result := FFitOut[Index]
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

function TFitDataRec.GetRelError(Index: Integer): Double;
begin
  if (Index > -1) and (Index < FDataNums) then
  	Result := FRelError[Index]
  else
  	Application.MessageBox('索引越界！','错误',MB_OK+MB_ICONERROR);
end;

constructor TFitDataRec.Create;
begin
  inherited;
  Next := nil;
  FPower := 1;
  FDataNums := 0;
	SetLength(FCoef,2);
  SetLength(FTestIn,2);
  SetLength(FTestOut,2);
  SetLength(FFitOut,2);
  SetLength(FRelError,2);
end;

procedure TFitDataRec.ReadFromFile(var F: Text);
begin

end;

procedure TFitDataRec.WriteToFile(var F: Text);
begin

end;








//--TFitDataMGR

function TFitDataMGR.FindItemByName(ItemName: String): TFitDataRec;
var
  T: TFitDataRec;
begin
  Result := nil;
  T := Head;
  while T <> nil do
  begin
    if T.ItemName = ItemName then
    begin
      Result := T;
      Break;
    end;
    T := T.Next;
  end;
end;

procedure TFitDataMGR.ReadFromFile(FileName: string);
begin

end;

procedure TFitDataMGR.WriteToFile(FileName: string);
begin

end;

constructor TFitDataMGR.Create;
begin

end;

destructor  TFitDataMGR.Destroy;
begin
  inherited;
end;


{
// 在加入用户时，可以这样做：

var
  User: TUserRec;
begin
  User := TUserRec.Create;
  User.UserName := '1234';
  User.FullName := 'abcd';
  ......
  Users.Append(User);
end;

// 在删除用户时，可以这样做：
var
  User: TUserRec;
begin
  User := TUserRec(Users.IndexOf('1234'));
  Users.Delete(User);
end;

// 在遍历用户时，可以这样做：
var
  User: TUserRec;
begin
  User := TUserRec(Users.Head);
  while User <> nil do
  begin
    ......
    User := TUserRec(User.Next);
  end;
end;
 }

end.