ftestebkandnvs.pas

Delphi math processing compononets and sources. Release.

{
@abstract(EBK&NVS Pascal-Delphi Math Library: Test application)
@author(Nikolai V. Shokhirev <[e-mail]> <[e-mail]>)
@author(Eugene B. Krissinel <[e-mail]> <[e-mail]>)
@created(09.09.1991)
@lastmod(04.04.2002)
This is a temporary publication (reduced variant), will be updated later
check: http://www.shokhirev.com/nikolai/programs/samplecode.html
㎞ikolai V. Shokhirev, 2002
}
unit fTestEBKandNVS;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, MathTypes, ComplexType, ExtCtrls, ComCtrls, LinAlg;
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    ButtonCalc: TButton;
    EditX: TEdit;
    EditY: TEdit;
    Conversion: TButton;
    StaticText1: TStaticText;
    result: TEdit;
    Panel1: TPanel;
    Label3: TLabel;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    ComplexMatrixTest: TButton;
    StaticText2: TStaticText;
    TabSheet3: TTabSheet;
    RealMatrixTests: TButton;
    Memo2: TMemo;
    TabSheet4: TTabSheet;
    MathTypesDemo: TButton;
    Memo3: TMemo;
    procedure ButtonCalcClick(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure ConversionClick(Sender: TObject);
    procedure ComplexMatrixTestClick(Sender: TObject);
    procedure RealMatrixTestsClick(Sender: TObject);
    procedure MathTypesDemoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI, SpecFunc, cMatrixProc, MatrixProc;

{$R *.DFM}

procedure TForm1.ButtonCalcClick(Sender: TObject);
var
  z, v: complex;
begin
  z := cmplx(StrToFloat(EditX.Text),StrToFloat(EditY.Text));
  v := cer(z);
  result.text := CmplxToStr(v);
  StaticText2.Caption := FloatToStr(er(StrToFloat(EditX.Text)));
end;

procedure TForm1.ConversionClick(Sender: TObject);
var
  v: complex;
begin
  v := StrToCmplx(result.text);
  StaticText1.Caption := CmplxToStr(v);
end;

procedure TForm1.ComplexMatrixTestClick(Sender: TObject);
const
  s3 = 0.577350269189625764;
  s6 = 0.408248290463863016;
var
  A, B, C: CMtPtr;
  D: VcPtr;
  s: string;
  i, j: IntType;

  procedure PrMt(M: CMatrix; N1, N2: IntType);
  var
  i, j: IntType;
  begin
    for i := 1 to N1 do
    begin
      s := '';
      for j := 1 to N2 do
        s := s  +' [ '+ CmplxToStr(M[i]^[j])+' ] ';
      Memo1.Lines.Add(s);
    end;
  end;

begin
  GetCMatrixMemory(A, 3, 3);
  GetCMatrixMemory(B, 3, 3);
  GetCMatrixMemory(C, 3, 3);
  GetVectorMemory(D, 3);
  A^[1]^[1] := cmplx(s3,0.0);
  A^[2]^[1] := cmplx(s3,0.0);
  A^[3]^[1] := cmplx(s3,0.0);
  A^[1]^[2] := cmplx(0.5,-0.5);
  A^[2]^[2] := cmplx(-0.5,0.5);
  A^[3]^[2] := cmplx(0.0,0.0);
  A^[1]^[3] := cmplx(0.0,-s6);
  A^[2]^[3] := cmplx(0.0,-s6);
  A^[3]^[3] := cmplx(0.0,2.0*s6);
  D[1] := 6.0;
  D[2] := 9.0;
  D[3] := 3.0;
  Memo1.Clear;
  DiagonalCM(3, C^, D^);
  Memo1.Lines.Add('D:');

  PrMt(C^, 3, 3);
  Memo1.Lines.Add('-----------------------------------------------');

  Memo1.Lines.Add('A:');
  PrMt(A^, 3, 3);
  Memo1.Lines.Add('-----------------------------------------------');

  Memo1.Lines.Add('A*D*AH:');
  CMxDxCMH(3, B^, A^, D^);
  PrMt(B^, 3, 3);
  Memo1.Lines.Add('-----------------------------------------------');

  Memo1.Lines.Add('AH*A*D*AH*A = D:');
  CMHxCMxCM(3, C^, B^, A^);
  PrMt(C^, 3, 3);

  FreeVectorMemory(D,3);
  FreeCMatrixMemory(C, 3, 3);
  FreeCMatrixMemory(A, 3, 3);
  FreeCMatrixMemory(B, 3, 3);
end;

procedure TForm1.RealMatrixTestsClick(Sender: TObject);
const
  s3 = 0.577350269189625764;
  s6 = 0.408248290463863016;
  s2 = 0.707106781186547524;
var
  A, B, C: MtPtr;
  D: VcPtr;
  s: string;
  i, j, signal: IntType;
  j0: IVcPtr;
  Det: RealType;

  procedure PrMt(M: Matrix; N1, N2: IntType);
  var
  i, j: IntType;
  begin
    for i := 1 to N1 do
    begin
      s := '';
      for j := 1 to N2 do
        s := s  +' [ '+ FloatToStr(M[i]^[j])+' ] ';
      Memo2.Lines.Add(s);
    end;
  end;

begin
  GetMatrixMemory(A, 3, 3);
  GetMatrixMemory(B, 3, 3);
  GetMatrixMemory(C, 3, 3);
  GetVectorMemory(D, 3);
  A^[1]^[1] := s3;
  A^[2]^[1] := s3;
  A^[3]^[1] := s3;
  A^[1]^[2] := s2;
  A^[2]^[2] := -s2;
  A^[3]^[2] := 0.0;
  A^[1]^[3] := -s6;
  A^[2]^[3] := -s6;
  A^[3]^[3] := 2.0*s6;
  D[1] := 6.0;
  D[2] := 9.0;
  D[3] := 3.0;
  Memo2.Clear;
  DiagonalM(3, C^, D^);
  Memo2.Lines.Add('D:');
  PrMt(C^,3,3);
  Memo2.Lines.Add('-----------------------------------------------');

  Memo2.Lines.Add('A:');
  PrMt(A^,3,3);
  Memo2.Lines.Add('-----------------------------------------------');

  Memo2.Lines.Add('A*D*AT:');
  MxDxMT(3, B^, A^, A^, D^);
  PrMt(B^,3,3);
  Memo2.Lines.Add('-----------------------------------------------');

  Memo2.Lines.Add('AT*A*D*AT*A = D:');
  MTxMxM(3, C^, B^, A^);
  PrMt(C^,3,3);

  Memo2.Lines.Add('-----------------------------------------------');
  GetIVectorMemory(j0,3);
  for i := 1 to 3 do
  begin
    for j := 1 to 3 do
    begin
      A^[i]^[j] := 1.0;
      B^[i]^[j] := 1.0;
    end;
    A^[i]^[i] := 2.0;
    B^[i]^[i] := 2.0;
  end;
  FastInverse(3,A^,j0^,Det,signal);
  MxM(3, C^, A^, B^);
  Memo2.Lines.Add('Matrix');
  PrMt(B^,3,3);
  Memo2.Lines.Add('Inverse:');
  PrMt(A^,3,3);
  Memo2.Lines.Add('Inverse x Matrix:');
  PrMt(C^,3,3);

  FreeIVectorMemory(j0,3);
  FreeVectorMemory(D,3);
  FreeMatrixMemory(C, 3, 3);
  FreeMatrixMemory(A, 3, 3);
  FreeMatrixMemory(B, 3, 3);
end;

procedure TForm1.MathTypesDemoClick(Sender: TObject);
var
  Vp, Vc: VcPtr;
  Mp: MtPtr;
  K, L, i, j: IntType;
  s: string;
    
  procedure MatTimesVec(var A: Vector; const B: Matrix; const C: Vector; N, M: IntType);
  // A must be var because Vector is the array of RealType
  // Vector access: A[i] or C[j]
  // Matrix is the atrray of pointers and can be always declared as const
  // Matrix access: B[i]^[j] because B[i]^ is a Vector
  // see declarations in the units MathTypes and ComplexType
  var
    i, j: IntType;
    s: RealType;
  begin
    for i := 1 to N do
    begin
      s := 0.0;
      for j := 1 to M do
        s := s + B[i]^[j]*C[j];
      A[i] := s;  
    end;
  end;
  
  procedure InitMatVec(const A: VcPtr; const B: MtPtr; N, M: IntType);
  // Both A and B are pointers and should be declared as const
  // Vector access: A^[i]
  // Matrix access: B^[i]^[j]
  var
    i, j: IntType;
  begin
    for i := 1 to N do
      for j := 1 to M do
        B^[i]^[j] := i*j;
    
    for j := 1 to M do
      A^[j] := j;  
  end;

begin
  K := 2;
  L := 3;
  GetMatrixMemory(Mp, K, L);
  GetVectorMemory(Vp, K);
  GetVectorMemory(Vc, L);

  InitMatVec(Vc, Mp, K, L);

  Memo3.Clear;
  Memo3.Lines.Add('Mp:');
  for i := 1 to K do
  begin
    s := '';
    for j := 1 to L do
      s := s  +' [ '+ FloatToStr(Mp^[i]^[j])+' ] ';
    Memo3.Lines.Add(s);
  end;
  Memo3.Lines.Add('-----------------------------------------------');

  Memo3.Lines.Add('Vc:');
  s := '';
  for j := 1 to L do
    s := s +' [ '+ FloatToStr(Vc^[j])+' ] ';
  Memo3.Lines.Add(s);
  Memo3.Lines.Add('-----------------------------------------------');

  { Vp^ is Vector, Mp^ is Matrix }
  MatTimesVec(Vp^, Mp^, Vc^, K, L);
  Memo3.Lines.Add('Vp:');
  s := '';
  for i := 1 to K do
    s := s + ' [ '+ FloatToStr(Vp^[i])+' ] ';
  Memo3.Lines.Add(s);

  FreeVectorMemory(Vp, K);
  FreeVectorMemory(Vc, L);
  FreeMatrixMemory(Mp, K, L);
end;
  
procedure TForm1.Label3Click(Sender: TObject);
begin
    ShellExecute(0,'open','http://www.shokhirev.com/nikolai.html','','',SW_SHOW);
end;

end.