object algebra

Back
Dynamic Arrays
author: Nikolai Shokhirev
http://www.shokhirev.com/nikolai.html http://www.chem.arizona.edu/~shokhirn/nikolai.html)
created: 2003.01.01
last modified: 2004.12.12
ŠNikolai V. Shokhirev, 2003-2004 }
unit uDynArrays;

interface

uses
  SysUtils, uMatTypes;

const
  _= MaxInt;  // open index

type
  TFArr = array of TFloat;

  TFArrFarr = array of array of TFloat;

  TArrayType =(atZeroBased,  // [0..Dim-1] - zero-based
               atNatural,    // [1..Dim] - one-based
               atCentered,   // [-((Dim-1) div 2)..(Dim div 2)]
               atGeneric);   // [Lo..Hi] - arbitrary limits

  TSliceType = (_Col,_Row);

  EInvalidType = class(Exception);

  ELimMismatch = class(Exception);

  ENonSquareMatrix = class(Exception);

  ESingularMatrix = class(Exception);

{ Interface for 1D Limits }
  ILim1D = interface(IComment)
    property Lo1: TInt read GetLo1 write SetLo1;
    property Hi1: TInt read GetHi1;
    property Dim1: TInt read GetDim1;
  end;

{ Interface for 2D Limits }
  ILim2D = interface(ILim1D)
    property Lo2: TInt read GetLo2 write SetLo2;
    property Hi2: TInt read GetHi2;
    property Dim2: TInt read GetDim2;
  end;

{ Interface for 3D Limits }
  ILim3D = interface(ILim2D)
    property Lo3: TInt read GetLo3 write SetLo3;
    property Hi3: TInt read GetHi3;
    property Dim3: TInt read GetDim3;
  end;

{ Interface for 1D string Array }
  ISArr1D = interface(ILim1D)
    procedure Assign(const A: ISArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: string read GetValue write SetValue; default;
  end;

{ Interface for 1D Boolean Array }
  IBArr1D = interface(ILim1D)
    procedure Fill(C: boolean);
    procedure Assign(const A: IBArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: boolean read GetValue write SetValue; default;
  end;

{ Interface for 2D Boolean Array }
  IBArr2D = interface(ILim2D)
    function GetSlice(i1, i2: TInt): IBArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IBArr1D);
    procedure Fill(C: boolean);
    procedure Assign(const A: IBArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: boolean read GetValue write SetValue; default;
  end;

{ Interface for 1D Boolean Array }
  IBArr3D = interface(ILim3D)
    procedure Fill(C: boolean);
    procedure Assign(const A: IBArr3D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2, i3: TInt]: boolean read GetValue write SetValue; default;
  end;

{ Interface for 1D integer Array }
  IIArr1D = interface(ILim1D)
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Interface for 2D integer Array }
  IIArr2D = interface(ILim2D)
    function GetSlice(i1, i2: TInt): IIArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IIArr1D);
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Interface for 3D integer Array }
  IIArr3D = interface(ILim3D)
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr3D);
    property Value[i1, i2, i3: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Interface for 1D float Array }
  IFArr1D = interface(ILim1D)
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr1D);
    function Norm(Normalize: boolean = false): TFloat;
    function MaxAbs: TFloat;
    function Dot(const A: IFArr1D): TFloat;
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: TFloat read GetValue write SetValue; default;
  end;

{ Interface for 2D float Array }
  IFArr2D = interface(ILim2D)
    function GetSlice(i1, i2: TInt): IFArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IFArr1D);
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr2D);
    function Norm2(i1, i2: TInt): TFloat;
    function Norm(i1, i2: TInt): TFloat;
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: TFloat read GetValue write SetValue; default;
  end;

{ Interface for 3D float Array }
  IFArr3D = interface(ILim3D)
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr3D);
    property Value[i1, i2, i3: TInt]: TFloat read GetValue write SetValue; default;
  end;

{Interface for Dynamic Complex 1D Array:
  CVector = ReVector + i*ImVector }
  ICArr1D = interface(ILim1D)
  ['{0ADE7BFF-EFC1-4614-BE71-716509288B64}']
    procedure Conjugate;
    procedure Fill(C: Complex);
    procedure Times(C: Complex);
    procedure Assign(const A: ICArr1D);
    procedure Swap(i, j: TInt);
    function MaxAbs: TFloat;
    property Re: IFArr1D read GetRe write SetRe;
    property Im: IFArr1D read GetIm write SetIm;
    property Value[i1: TInt]: Complex read GetValue write SetValue; default;
  end;

{Interface for Dynamic Complex 2D Array:
  CMatrix = ReMatrix + i*ImMatrix }
  ICArr2D = interface(ILim2D)
    procedure Conjugate;
    procedure Fill(C: Complex);
    procedure Times(C: Complex);
    procedure Assign(const A: ICArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Re: IFArr2D read GetRe write SetRe;
    property Im: IFArr2D read GetIm write SetIm;
    property Value[i1, i2: TInt]: Complex read GetValue write SetValue; default;
  end;

  IEigenSys = interface(IComment)
    property Names: ISArr1D read GetNames write SetNames;
    property Values: IFArr1D read GetValues write SetValues;
    property Vectors: IFArr2D read GetVectors write SetVectors;
  end;

  IHEigenSys = interface(IComment)
    property Names: ISArr1D read GetNames write SetNames;
    property Values: IFArr1D read GetValues write SetValues;
    property Vectors: ICArr2D read GetVectors write SetVectors;
  end;

  ISVDSys = interface(IComment)
    property Values: IFArr1D read GetValues write SetValues;
    property Uvectors: IFArr2D read GetUvectors write SetUvectors;
    property Vvectors: IFArr2D read GetVvectors write SetVvectors;
  end;

  { Object for 1D Limits }
  TLim1D = class(TComment, ILim1D, IRestore)
  public
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    property Hi1: TInt read GetHi1;
    property Lo1: TInt read GetLo1 write SetLo1;
    property Dim1: TInt read GetDim1;
  end;

{ Object for 2D Limits }
  TLim2D = class(TLim1D, ILim2D, IRestore)
  public
    constructor Create(aHi1, aHi2: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt); overload;
    property Hi2: TInt read GetHi2;
    property Lo2: TInt read GetLo2 write SetLo2;
    property Dim2: TInt read GetDim2;
  end;

{ Object for 2D Limits }
  TLim3D = class(TLim2D, ILim3D)
  public
    constructor Create(aHi1, aHi2, aHi3: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2, aLo3, aHi3: TInt); overload;
    property Hi3: TInt read GetHi3;
    property Lo3: TInt read GetLo3 write SetLo3;
    property Dim3: TInt read GetDim3;
  end;

  { Limits1D Restore object }
  TRestore1D = class(TinterfacedObject, IRestore)
  public
    constructor Create(Lim: array of ILim1D);
    destructor Destroy; override;
  end;

  { Limits2D Restore object }
  TRestore2D = class(TinterfacedObject, Irestore)
  public
    constructor Create(Lim: array of ILim2D);
    destructor Destroy; override;
  end;

{ Object for 1D string Array }
  TSArr1D = class(TLim1D, ISArr1D)
  public
    constructor Create(A: ISArr1D; CopyData: boolean = false); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    procedure Assign(const A: ISArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: string read GetValue write SetValue; default;
  end;

{ Object for 1D boolean Array }
  TBArr1D = class(TLim1D, IBArr1D)
  public
    constructor Create(A: IBArr1D; CopyData: boolean = false); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: boolean);
    procedure Assign(const A: IBArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: boolean read GetValue write SetValue; default;
  end;

{ Object for 2D boolean Array }
  TBArr2D = class(TLim2D, IBArr2D)
  protected
    function GetSlice(i1, i2: TInt): IBArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IBArr1D);
  public
    constructor Create(A: IBArr2D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: boolean);
    procedure Assign(const A: IBArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: boolean read GetValue write SetValue; default;
  end;

{ Object for 1D integer Array }
  TIArr1D = class(TLim1D, IIArr1D)
  public
    constructor Create(A: IIArr1D; CopyData: boolean = false); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr1D);
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Object for 2D integer Array }
  TIArr2D = class(TLim2D, IIArr2D)
  protected
    function GetSlice(i1, i2: TInt): IIArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IIArr1D);
  public
    constructor Create(A: IIArr2D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Object for 3D integer Array }
  TIArr3D = class(TLim3D, IIArr3D)
  public
    constructor Create(A: IIArr3D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2, aHi3: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2, aLo3, aHi3: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: TInt);
    procedure Assign(const A: IIArr3D);
    property Value[i1, i2, i3: TInt]: TInt read GetValue write SetValue; default;
  end;

{ Object for 1D float Array }
  TFArr1D = class(TLim1D, IFArr1D)
  public
    constructor Create(A: IFArr1D; CopyData: boolean = false); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt; var A: TFArr); overload;
    destructor Destroy; override;
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr1D);
    function Norm(Normalize: boolean = false): TFloat;
    function MaxAbs: TFloat;
    function Dot(const A: IFArr1D): TFloat;
    procedure Swap(i, j: TInt);
    property Value[i1: TInt]: TFloat read GetValue write SetValue; default;
  end;

{ Object for 2D float Array }
  TFArr2D = class(TLim2D, IFArr2D)
  private
    fValue: array of array of TFloat;
  protected
    function GetSlice(i1, i2: TInt): IFArr1D;
    procedure SetSlice(i1, i2: TInt; const aValue: IFArr1D);
  public
    constructor Create(A: IFArr2D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr2D);
    function Norm2(i1, i2: TInt): TFloat;
    function Norm(i1, i2: TInt): TFloat;
    procedure Swap(i, j: TInt; st: TSliceType);
    property Value[i1, i2: TInt]: TFloat read GetValue write SetValue; default;
  end;

{ Object for 2D float Array }
  TFArr3D = class(TLim3D, IFArr3D)
  private
    fValue: array of array of array of TFloat;
  public
    constructor Create(A: IFArr3D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2, aHi3: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2, aLo3, aHi3: TInt); overload;
    destructor Destroy; override;
    procedure Fill(C: TFloat);
    procedure Times(C: TFloat);
    procedure Assign(const A: IFArr3D);
    property Value[i1, i2, i3: TInt]: TFloat read GetValue write SetValue; default;
  end;

    { Object for 1D complex Array }
  TCArr1D = class(TComment, ICArr1D)
  public
    constructor Create(A: ICArr1D; CopyData: boolean = false); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    procedure Conjugate;
    procedure Fill(C: Complex);
    procedure Times(C: Complex);
    procedure Assign(const A: ICArr1D);
    procedure Swap(i, j: TInt);
    function MaxAbs: TFloat;
    property Re: IFArr1D read GetRe write SetRe;
    property Im: IFArr1D read GetIm write SetIm;
    property Hi1: TInt read GetHi1;
    property Lo1: TInt read GetLo1 write SetLo1;
    property Dim1: TInt read GetDim1;
    property Value[i1: TInt]: Complex read GetValue write SetValue; default;
  end;

{ Object for 2D complex Array }
  TCArr2D = class(TComment, ICArr2D)
  public
    constructor Create(A: ICArr2D; CopyData: boolean = false); overload;
    constructor Create(aHi1, aHi2: TInt); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt); overload;
    destructor Destroy; override;
    procedure Conjugate;
    procedure Fill(C: Complex);
    procedure Times(C: Complex);
    procedure Assign(const A: ICArr2D);
    procedure Swap(i, j: TInt; st: TSliceType);
    property Re: IFArr2D read GetRe write SetRe;
    property Im: IFArr2D read GetIm write SetIm;
    property Hi1: TInt read GetHi1;
    property Lo1: TInt read GetLo1 write SetLo1;
    property Dim1: TInt read GetDim1;
    property Hi2: TInt read GetHi2;
    property Lo2: TInt read GetLo2 write SetLo2;
    property Dim2: TInt read GetDim2;
    property Value[i1, i2: TInt]: Complex read GetValue write SetValue; default;
  end;

{ Object for Real eigensystem }
  TEigenSys = class(TComment, IEigenSys)
  public
    constructor Create(const a: ILim2D); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    property Names: ISArr1D read GetNames write SetNames;
    property Values: IFArr1D read GetValues write SetValues;
    property Vectors: IFArr2D read GetVectors write SetVectors;
  end;

{ Object for Hermitian eigensystem }
  THEigenSys = class(TComment, IHEigenSys)
  public
    constructor Create(const a: ILim2D); overload;
    constructor Create(aHi1: TInt); overload;
    constructor Create(aLo1, aHi1: TInt); overload;
    destructor Destroy; override;
    property Names: ISArr1D read GetNames write SetNames;
    property Values: IFArr1D read GetValues write SetValues;
    property Vectors: ICArr2D read GetVectors write SetVectors;
  end;

{ Object for SVD system }
  TSVDSys = class(TComment, ISVDSys)
  public
    constructor Create(const A: IFArr2D; fullmat: boolean = false); overload;
    constructor Create(aHi1, aHi2: TInt; fullmat: boolean = false); overload;
    constructor Create(aLo1, aHi1, aLo2, aHi2: TInt; fullmat: boolean = false); overload;
    property Values: IFArr1D read GetValues write SetValues;
    property Uvectors: IFArr2D read GetUvectors write SetUvectors;
    property Vvectors: IFArr2D read GetVvectors write SetVvectors;
  end;

{ A.Lo1 = A.Lo2 and A.Hi1 = A.Hi2 }
function IsSquare(const A: ILim2D): boolean;

{ A1.Lo1 = A2.Lo1 and A1.Hi1 = A2.Hi1 }
function SameLim(const A1, A2: ILim1D): boolean; overload;
{ A1.Lo1 = A2.Lo1 and A1.Hi1 = A2.Hi1 and A1.Lo2 = A2.Lo2 and A1.Hi2 = A2.Hi2 }
function SameLim(const A1, A2: ILim2D): boolean; overload;
{ A1.Lo1 = A2.Lo1 and A1.Hi1 = A2.Hi1 and A1.Lo2 = A2.Lo2 and A1.Hi2 = A2.Hi2
  and A1.Lo3 = A2.Lo3 and A1.Hi3 = A2.Hi3  }
function SameLim(const A1, A2: ILim3D): boolean; overload;
{ Same limits with transposed:    <br>
  A1.Lo1 = A2.Lo2 and A1.Hi1 = A2.Hi2 and A1.Lo2 = A2.Lo1 and A1.Hi2 = A2.Hi1 }
function SameLimT(const A1, A2: ILim2D): boolean;

function ArrType(const A: ILim1D): TArrayType;

implementation

uses
  Math;

end.
Back
Generated by Lore's Source to HTML Converter ( http://www.newty.de/lsc/index.html )