圖像識別中常用的降維的PCA方法。

這裏用的是最簡單的PCA方法，直接求取協方差矩陣C的特徵值，比較慢，具體優化方法件Petland的論文Eigenfaces for recognition。

某些定義我將不再給出，其實很簡單，比如TxxyyArray，xx代碼維數，比如Single就是一維，Double就是二維，Triple就是三維，yy代表類型，比如Byte、Longint、Integer、Extended等。

unit PCA;

interface

uses
  Math, Windows, SysUtils, Variants, Classes, unitypes, Matrix;

type
  TPCAData = record
    x: TSingleLongintArray;
  end;

  TPCADatabase = record
    Data: array of TPCAData;
    Count: longint;
  end;

  TPCA = class
  private
  public
    Database: TPCADatabase;
    N: longint;
    MeanData: TSingleLongintArray;
    EigenLambda: TSingleExtendedArray;
    EigenVector: TDoubleExtendedArray;
    procedure Init(sN: longint);
    procedure AddToDatabase(Data: TSingleLongintArray);
    procedure CalculateEigenImage;
    procedure CalculateProjection(Data: TSingleLongintArray; var EigenData: TSingleLongintArray; sN: longint);
    function SaveToFile(FileName: string): boolean;
    function LoadFromFile(FileName: string): boolean;
    destructor Destroy; override;
  end;

implementation

procedure TPCA.Init(sN: longint);
begin
  N := sN;
  setlength(EigenLambda, N);
  setlength(EigenVector, N, N);
  setlength(MeanData, N);
end;

procedure TPCA.AddToDatabase(Data: TSingleLongintArray);
var
  i: longint;
begin
  if High(Database.Data) >= Database.Count - 1 then setlength(Database.Data, Database.Count + $10);
  setlength(Database.Data[Database.Count].x, N);
  for i := 0 to N - 1 do
    Database.Data[Database.Count].x[i] := Data[i];
  Inc(Database.Count);
end;

procedure TPCA.CalculateEigenImage;
var
  i, j, fi, fj, TL, s: longint;
  fm: Extended;
  C, A: TDoubleLongintArray;
begin
  setlength(A, N, DataBase.Count);
  setlength(C, N, N);

  for i := 0 to N - 1 do begin
    TL := 0;
    for j := 0 to DataBase.Count - 1 do
      Inc(TL, Database.Data[j].x[i]);
    TL := TL div Database.Count;
    for j := 0 to Database.Count - 1 do
      A[i, j] := Database.Data[j].x[i] - TL;
    MeanData[i] := TL;
  end;

  for i := 0 to N - 1 do
    for j := 0 to N - 1 do begin
      TL := 0;
      for fi := 0 to Database.Count - 1 do
        Inc(TL, A[i, fi] * A[j, fi]);
      C[i, j] := TL div Database.Count;
    end;

  CalculateEigenVV(EigenLambda, EigenVector, C, N, 0.00001);

  for i := 0 to N - 1 do begin
    s := i;
    for j := i + 1 to N - 1 do
      if Abs(EigenLambda[j]) > Abs(EigenLambda[s]) then s := j;
    if s <> i then begin
      fm := EigenLambda[s]; EigenLambda[s] := EigenLambda[i]; EigenLambda[i] := fm;
      for j := 0 to N - 1 do begin
        fm := EigenVector[s, j];
        EigenVector[s, j] := EigenVector[i, j];
        EigenVector[i, j] := fm;
      end;
    end;
  end;
end;

procedure TPCA.CalculateProjection(Data: TSingleLongintArray; var EigenData: TSingleLongintArray; sN: longint);
var
  i, j: longint;
  fm: extended;
begin
  setlength(EigenData, sN);
  for i := 0 to sN - 1 do begin
    fm := 0;
    for j := 0 to N - 1 do
      fm := fm + (Data[j] - MeanData[j]) * EigenVector[i, j];
    EigenData[i] := trunc(fm);
  end;
end;

function TPCA.LoadFromFile(FileName: string): boolean;
var
  i, j: longint;
  ReadStream: TMemoryStream;
begin
  ReadStream := TMemoryStream.Create;
  try
    ReadStream.LoadFromFile(FileName);
    ReadStream.Read(N, sizeof(N));
    setlength(EigenLambda, N);
    setlength(EigenVector, N, N);
    setlength(MeanData, N);
    for i := 0 to N - 1 do
      ReadStream.Read(EigenLambda[i], sizeof(EigenLambda[i]));
    for i := 0 to N - 1 do
      for j := 0 to N - 1 do
        ReadStream.Read(EigenVector[i, j], sizeof(EigenVector[i, j]));
    for i := 0 to N - 1 do
      ReadStream.Read(MeanData[i], sizeof(MeanData[i]));
    Result := true;
  except
    Result := false;
  end;
  ReadStream.Free;
end;

function TPCA.SaveToFile(FileName: string): boolean;
var
  i, j: longint;
  SaveStream: TMemoryStream;
begin
  SaveStream := TMemoryStream.Create;
  try
    SaveStream.Write(N, sizeof(N));
    for i := 0 to N - 1 do
      SaveStream.Write(EigenLambda[i], sizeof(EigenLambda[i]));
    for i := 0 to N - 1 do
      for j := 0 to N - 1 do
        SaveStream.Write(EigenVector[i, j], sizeof(EigenVector[i, j]));
    for i := 0 to N - 1 do
      SaveStream.Write(MeanData[i], sizeof(MeanData[i]));
    SaveStream.SaveToFile(FileName);
    Result := true;
  except
    Result := false;
  end;
  SaveStream.Free;
end;

destructor TPCA.Destroy;
begin
  setlength(Database.Data, 0);
  setlength(EigenLambda, 0);
  setlength(EigenVector, 0);
  setlength(MeanData, 0);
  inherited;
end;
end.