unit arrays;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
{$INLINE ON}
(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)

interface

uses
  Classes, SysUtils,
  base, base2, textfile, mathC;

type
    TDoubleArray=array [0..1023] of Double;
    PDoubleArray=^TDoubleArray;

type
   TArray=class(TObject)
         MaxSize:NativeInt;
     {$IFNDEF HeapArrays}
      class function NewInstance: TObject;override;
      procedure FreeInstance;override;
     {$ENDIF}
      constructor createNul;
      procedure MatPrint(ch:tTextDevice; direction:integer);virtual;abstract;
      procedure MatWrite(ch:tTextDevice);virtual;abstract;
      procedure Read(list:TStringList;var p:integer);virtual;abstract;
   end;

   TArray1=Class(TArray)
      Lbound1:NativeInt;
      Size1  :NativeInt;
      constructor create(x1,x2:double);overload;
      constructor create(x1,x2:NativeInt);overload;
      procedure dim(x1,x2:NativeInt);overload;
      procedure dim(x1,x2:double);overload;
      procedure resize(s1:NativeInt);overload;
      procedure resize(x1:double);overload;
      procedure redim(x:double);overload;
      procedure redim(x1,x2:double);overload;               // change lbound
      function Size:NativeInt;overload;
      function Size(d:Double):NativeInt;overload;
      function Lbound:NativeInt;overload;
      function Ubound:NativeInt;overload;
      function Lbound(d:Double):NativeInt;overload;
      function Ubound(d:Double):NativeInt;overload;
      function index(x:NativeInt):NativeInt;overload;
      function index(x:double):NativeInt;overload;
      function index(x:complex):NativeInt;overload;
      procedure AssignVarilen(list:TstringList);virtual;abstract;
     protected
      procedure init(lb1,ub1:NativeInt);virtual;abstract;
      procedure init0(lb1,ub1:NativeInt);
   end;

   TArray2=Class(TArray)
      Lbound1:NativeInt;
      Size1  :NativeInt;
      Lbound2:NativeInt;
      Size2  :NativeInt;
      constructor create(x1,x2,y1,y2:double);overload;
      constructor create(x1,x2,y1,y2:NativeInt);overload;
      procedure dim(x1,x2,y1,y2:double);overload;
      procedure dim(x1,x2,y1,y2:NativeInt);overload;
      procedure resize(s1,s2:NativeInt);overload;
      procedure resize(x1,x2:double);overload;
      procedure resize(x1:double);overload;   // x1行x1列
      procedure redim(x,y:double);overload;
      procedure redim(x1,x2,y1,y2:double);overload;
      function Size:NativeInt;overload;
      function Size(d:Double):NativeInt;overload;
      function Lbound(d:Double):NativeInt;overload;
      function Ubound(d:Double):NativeInt;overload;
      function index(x,y:NativeInt):NativeInt;overload;
      function index(x,y:double):NativeInt;overload;
      function index(x:double; y:complex):NativeInt;overload;
      function index(x:complex; y:double):NativeInt;overload;
      function index(x,y:complex):NativeInt;overload;
     protected
      procedure init(lb1,ub1,lb2,ub2:NativeInt);virtual;abstract;
      procedure init0(lb1,ub1,lb2,ub2:NativeInt);
   end;

   TArray3=Class(TArray)
      Lbound1:NativeInt;
      Size1  :NativeInt;
      Lbound2:NativeInt;
      Size2  :NativeInt;
      Lbound3:NativeInt;
      Size3  :NativeInt;
      constructor create(x1,x2,y1,y2,z1,z2:double);
      procedure dim(x1,x2,y1,y2,z1,z2:double);overload;
      procedure dim(x1,x2,y1,y2,z1,z2:NativeInt);overload;
      procedure resize(s1,s2,s3:NativeInt);overload;
      procedure resize(x1,x2,x3:double);overload;
      procedure redim(x,y,z:double);overload;
      procedure redim(x1,x2,y1,y2,z1,z2:double);overload; //change Lbounds
      function Size:NativeInt;overload;
      function Size(d:Double):NativeInt;overload;
      function Lbound(d:Double):NativeInt;overload;
      function Ubound(d:Double):NativeInt;overload;
      function index(x,y,z:NativeInt):NativeInt; overload;
      function index(x,y,z:double):NativeInt; overload;
     protected
      procedure init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);virtual;abstract;
      procedure init0(lb1,ub1,lb2,ub2,lb3,ub3:NativeInt);
   end;

   TArray4=Class(TArray)
      Lbound1:NativeInt;
      Size1  :NativeInt;
      Lbound2:NativeInt;
      Size2  :NativeInt;
      Lbound3:NativeInt;
      Size3  :NativeInt;
      Lbound4:NativeInt;
      Size4  :NativeInt;
      constructor create(x1,x2,y1,y2,z1,z2,w1,w2:double);
      procedure dim(x1,x2,y1,y2,z1,z2,w1,w2:double);overload;
      procedure dim(x1,x2,y1,y2,z1,z2,w1,w2:NativeInt);overload;
      procedure resize(s1,s2,s3,s4:NativeInt);overload;
      procedure resize(x1,x2,x3,x4:double);overload;
      procedure redim(x,y,z,w:double);overload;
      procedure redim(x1,x2,y1,y2,z1,z2,w1,w2:double);overload; //change Lbounds
      function Size:NativeInt;overload;
      function Size(d:Double):NativeInt;overload;
      function Lbound(d:Double):NativeInt;overload;
      function Ubound(d:Double):NativeInt;overload;
      function index(x,y,z,w:NativeInt):NativeInt; overload;
      function index(x,y,z,w:double):NativeInt; overload;
     protected
      procedure init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);virtual;abstract;
      procedure init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
   end;




   TArray2N=class;

   TArray1N=Class(TArray1)
      elements:PDoubleArray;
      procedure subst(a:TArray1N);overload;
      procedure subst(a:TArray2N);overload;
      procedure trn(a:TArray2N);overload;
      procedure add(a,b:TArray1N);
      procedure sub(a,b:TArray1N);
      procedure prod(a:TArray1N; b:TArray2N); overload;
      procedure prod(a:TArray2N; b:TArray1N); overload;
      procedure scalar(x:double; a:TArray1N);
      procedure con;overload;
      procedure con(x:double);overload;
      procedure zer;overload;
      procedure zer(x:double);overload;
      procedure CROSS(a,b:TArray1N);
      procedure row(a:TArray2N;n:integer); overload;
      procedure column(a:TArray2N;n:integer);overload;
      procedure row(a:TArray2N;n:double); overload;
      procedure column(a:TArray2N;n:double); overload;
      destructor destroy;override;
      function InputDirective:string;
      function NewCopy:TArray1N;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      function kindlist:ansistring;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      procedure AssignVarilen(list:TstringList);override;
      procedure LetWithTrace(ch:tTextDevice; name: ansistring; index1:double; value: double);
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1:NativeInt);override;
      constructor createCopy(a:TArray1N);
      procedure CROSSsub(a,b:TArray1N);
    end;

   TArray2N=Class(TArray2)
      elements:PDoubleArray;
      procedure subst(a:TArray1N);overload;
      procedure subst(a:TArray2N);overload;
      procedure add(a,b:TArray2N);
      procedure sub(a,b:TArray2N);
      procedure prod(a:TArray2N; b:TArray2N);
      procedure INV(a:TArray2N);
      procedure TRN(a:TArray1N); overload;
      procedure TRN(a:TArray2N); overload;
      procedure scalar(x:double; a:TArray2N);
      procedure power(a:Tarray2N; x:double);
      procedure zer;overload;
      procedure zer(x:double);overload;
      procedure CON;overload;
      procedure CON(x:double);overload;
      procedure IDN;          overload;
      procedure IDN(x:double);overload;
      procedure row(a:TArray2N;m,n:integer); overload;
      procedure column(a:TArray2N;m,n:integer); overload;
      procedure SubstRow1(n:integer; a:TArray1N);overload;
      procedure SubstRow2(m,n:integer; a:TArray2N);overload;
      procedure SubstColumn1(n:integer; a:TArray1N); overload;
      procedure SubstColumn2(m,n:integer; a:TArray2N);overload;
      procedure row(a:TArray2N;m,n:double); overload;
      procedure column(a:TArray2N;m,n:double); overload;
      procedure SubstRow1(n:double; a:TArray1N);overload;
      procedure SubstRow2(m,n:double; a:TArray2N);overload;
      procedure SubstColumn1(n:double; a:TArray1N); overload;
      procedure SubstColumn2(m,n:double; a:TArray2N);overload;
      destructor destroy;override;
      function InputDirective:string;
      function NewCopy:TArray2N;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      function kindlist:ansistring;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      procedure LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2:double; value: double);
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
      constructor createCopy(a:TArray2N);

     private
      procedure init(lb1,ub1,lb2,ub2:NativeInt);override;
      procedure prodsub(a:TArray2N; b:TArray2N);
      procedure TRNSub(a:TArray2N);
      procedure determinant(var n:double);
      function inverse:TArray2N;
    end;

   TArray3N=Class(TArray3)
      elements:PDoubleArray;
      procedure subst(a:TArray3N);
      procedure add(a,b:TArray3N);
      procedure sub(a,b:TArray3N);
      procedure scalar(x:double; a:TArray3N);
      procedure zer;overload;
      procedure zer(x:double);overload;
      procedure CON;overload;
      procedure CON(x:double);overload;
      destructor destroy;override;
      function InputDirective:string;
      function NewCopy:TArray3N;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      function kindlist:ansistring;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      procedure LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3:double; value: double);
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt); override;
      constructor createCopy(a:TArray3N);

    end;

   TArray4N=Class(TArray4)
      elements:PDoubleArray;
      procedure subst(a:TArray4N);
      procedure add(a,b:TArray4N);
      procedure sub(a,b:TArray4N);
      procedure scalar(x:double; a:TArray4N);
      procedure zer;overload;
      procedure zer(x:double);overload;
      procedure CON;overload;
      procedure CON(x:double);overload;
      destructor destroy;override;
      function InputDirective:string;
      function NewCopy:TArray4N;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      function kindlist:ansistring;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      procedure LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3,index4:double; value: double);
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt); override;
      constructor createCopy(a:TArray4N);

    end;



   TArray1S=Class(TArray1)
      elements:PStringArray;
      destructor destroy;override;
      function InputDirective:string;
      function kindlist:ansistring;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      procedure AssignVarilen(list:TstringList);override;
      function NulCopy:TArray1S;
      function NewCopy:TArray1S;
      function newcopySubstring(i,j:Integer):TArray1S;
      function newcopySubstringByte(i,j:integer):TArray1S;
      procedure Subst(a:TArray1S);                            // aを削除する
      procedure SubstSubstring(i,j:integer; a:TArray1S);      // aを削除する
      procedure SubstSubstringByte(i,j:integer; a:TArray1S);  // aを削除する
      class function Concat(a,b:TArray1S):TArray1S; overload;       // a,bを削除する
      class function Concat(a:TArray1S; const s:string):TArray1S; overload; // aを削除する
      class function Concat(const s:String; b:TArray1S):TArray1S; overload; // bを削除する
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1:NativeInt); override;
      constructor CreateNulCopy(a:TArray1S);
      constructor createCopy(a:TArray1S);
      constructor CreateConcat(a,b:TArray1S);
      procedure Substring(i,j:integer);
      procedure SubStringByte(i,j:integer);
    end;

   TArray2S=Class(TArray2)
      elements:PStringArray;
      destructor destroy;override;
      function InputDirective:string;
      function kindlist:ansistring;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      function NulCopy:TArray2S;
      function NewCopy:TArray2S;
      function newcopySubstring(i,j:integer):TArray2S;
      function newcopySubstringByte(i,j:integer):TArray2S;
      procedure Subst(a:TArray2S);                            // aを削除する
      procedure SubstSubstring(i,j:integer; a:TArray2S);      // aを削除する
      procedure SubstSubstringByte(i,j:integer; a:TArray2S);  // aを削除する
      class function Concat(a,b:TArray2S):TArray2S; overload;       // a,bを削除する
      class function Concat(a:TArray2S; const s:string):TArray2S; overload; // aを削除する
      class function Concat(const s:String; b:TArray2S):TArray2S; overload; // bを削除する
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1,lb2,ub2:NativeInt); override;
      constructor createCopy(a:TArray2S);
      constructor CreateNulCopy(a:TArray2S);
      constructor CreateConcat(a,b:TArray2S);
      procedure Substring(i,j:integer);
      procedure SubStringByte(i,j:integer);
    end;

   TArray3S=Class(TArray3)
      elements:PStringArray;
      destructor destroy;override;
      function InputDirective:string;
      function kindlist:ansistring;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      function NewCopy:TArray3S;
      function NulCopy:TArray3S;
      function newcopySubstring(i,j:integer):TArray3S;
      function newcopySubstringByte(i,j:integer):TArray3S;
      procedure Subst(a:TArray3S);                            // aを削除する
      procedure SubstSubstring(i,j:integer; a:TArray3S);      // aを削除する
      procedure SubstSubstringByte(i,j:integer; a:TArray3S);  // aを削除する
      class function Concat(a,b:TArray3S):TArray3S; overload;       // a,bを削除する
      class function Concat(a:TArray3S; const s:string):TArray3S; overload; // aを削除する
      class function Concat(const s:String; b:TArray3S):TArray3S; overload; // bを削除する
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);override;
      constructor createCopy(a:TArray3S);
      constructor CreateNulCopy(a:TArray3S);
      constructor CreateConcat(a,b:TArray3S);
      procedure Substring(i,j:integer);
      procedure SubStringByte(i,j:integer);

    end;

   TArray4S=Class(TArray4)
      elements:PStringArray;
      destructor destroy;override;
      function InputDirective:string;
      function kindlist:ansistring;
      procedure MatPrint(ch:tTextDevice; direction:integer);override;
      procedure MatWrite(ch:tTextDevice);override;
      procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
      function NewCopy:TArray4S;
      function NulCopy:TArray4S;
      function newcopySubstring(i,j:integer):TArray4S;
      function newcopySubstringByte(i,j:integer):TArray4S;
      procedure Subst(a:TArray4S);                            // aを削除する
      procedure SubstSubstring(i,j:integer; a:TArray4S);      // aを削除する
      procedure SubstSubstringByte(i,j:integer; a:TArray4S);  // aを削除する
      class function Concat(a,b:TArray4S):TArray4S; overload;       // a,bを削除する
      class function Concat(a:TArray4S; const s:string):TArray4S; overload; // aを削除する
      class function Concat(const s:String; b:TArray4S):TArray4S; overload; // bを削除する
      procedure WriteTo(p:Pointer; size1:integer);
      procedure ReadFrom(p:Pointer; size1:integer);
     private
      procedure init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);override;
      constructor createCopy(a:TArray4S);
      constructor CreateNulCopy(a:TArray4S);
      constructor CreateConcat(a,b:TArray4S);
      procedure Substring(i,j:integer);
      procedure SubStringByte(i,j:integer);

    end;

function dot(a,b:TArray1N):double; overload;
function DET(a:TArray2N):double;   overload;

function ConCatArray(const s:string; b:TArray1S):TArray1S;overload;
function ConCatArray(a:TArray1S; const s:string):TArray1S;overload;
function ConCatArray(a,b:TArray1S):TArray1S;overload;
function ConCatArray(const s:string; b:TArray2S):TArray2S;overload;
function ConCatArray(a:TArray2S; const s:string):TArray2S;overload;
function ConCatArray(a,b:TArray2S):TArray2S;overload;
function ConCatArray(const s:string; b:TArray3S):TArray3S;overload;
function ConCatArray(a:TArray3S; const s:string):TArray3S;overload;
function ConCatArray(a,b:TArray3S):TArray3S;overload;


{*********************}
{Transformation Arrays}
{*********************}

{
type
   TransArray=array[0..3,0..3]of double;

function  shift(a,b:double):TransArray;
function  scale(a,b:double):TransArray;
function  scale(a:double):TransArray;
function  rotate(a:double):TransArray;
function  rotatedeg(a:double):TransArray;
function  shear(a:double):TransArray;
function  sheardeg(a:double):TransArray;
}

{*****************}
{Matrix operations}
{*****************}
function matrixIDN(a:TArray2N): TArray2N; overload;
function matrixIDN(a:TArray2N; x:double): TArray2N; overload;
function matrixTRN(a,b:TArray2N): TArray2N; overload;
function matrixTRN(a:TArray2N; b:TArray1N): TArray2N; overload;
function matrixINV(a,b:TArray2N):Tarray2N;overload;
function matrixCNJ(a,b:TArray1N):Tarray1N;overload;
function matrixCNJ(a,b:TArray2N):Tarray2N;overload;
function matrixCNJ(a,b:TArray3N):Tarray3N;overload;
function matrixCNJ(a,b:TArray4N):Tarray4N;overload;
function matrixPOWER(a,b:TArray2N; x:double):Tarray2N; overload;
function matrixScalar(a:TArray1N; x:double; b:TArray1N):Tarray1N;overload;
function matrixScalar(a:TArray2N; x:double; b:TArray2N):Tarray2N;overload;
function matrixScalar(a:TArray3N; x:double; b:TArray3N):Tarray3N;overload;
function matrixScalar(a:TArray4N; x:double; b:TArray4N):Tarray4N;overload;
function matrixProd(a,b:TArray1N; c:TArray2N):Tarray1N;overload;
function matrixProd(a,b,c:TArray2N):Tarray2N;overload;
function matrixAdd(a,b,c:TArray1N):Tarray1N;overload;
function matrixSbt(a,b,c:TArray1N):Tarray1N;overload;
function matrixAdd(a,b,c:TArray2N):Tarray2N;overload;
function matrixSbt(a,b,c:TArray2N):Tarray2N;overload;
function matrixAdd(a,b,c:TArray3N):Tarray3N;overload;
function matrixSbt(a,b,c:TArray3N):Tarray3N;overload;
function matrixAdd(a,b,c:TArray4N):Tarray4N;overload;
function matrixSbt(a,b,c:TArray4N):Tarray4N;overload;
function matrixInit(a:TArray1N; b:array of double): TArray1N;overload;
function matrixRow1(a:TArray1N;b:TArray2N; i:double):Tarray1N;
function matrixColumn1(a:TArray1N;b:TArray2N; i:double):Tarray1N;
function matrixRow2(a:TArray2N; b:TArray2N; i,j:double):Tarray2N;
function matrixColumn2(a:TArray2N; b:TArray2N; i,j:double):Tarray2N;

implementation
uses {$IFNDEF HeapArrays}vstack,{$ENDIF}baslib;

{$IFNDEF HeapArrays}
class function TArray.NewInstance: TObject;
begin
   result:=InitInstance(getMemory(instancesize));
end;

procedure TArray.FreeInstance;
begin
   freeMemory(instanceSize)
end;
{$ENDIF}


constructor TArray.createNul;
begin
   inherited create;
end;

procedure TArray1.init0(lb1,ub1:NativeInt);
var
   Ubound1:NativeInt;
begin
    lbound1:=lb1;
    Ubound1:=ub1;
    Size1:=Ubound1-Lbound1+1;
    if size1<0 then size1:=0;
    maxsize:=size1;
    {$IFDEF CPUx64}
    {$ELSE}
    if MaxSize >= $80000000 div sizeOf(Double) then
                                       setexception( -103);
    {$ENDIF}
end;

procedure TArray1N.init(lb1,ub1:NativeInt);
begin
    init0(lb1,ub1);
    if maxsize>0 then
    {$IFDEF HeapArrays}
     Elements:=AllocMem(Maxsize*SizeOf(Double));
    {$ELSE}
     Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
    {$ENDIF}
end;

constructor TArray1.create(x1,x2:double);overload;
begin
    inherited create;
    init(SysIntRound(x1),SysIntRound(x2));
end;

constructor TArray1.create(x1,x2:NativeInt);overload;
begin
    inherited create;
    init(x1,x2);
end;

destructor TArray1N.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
    FreeMem(Elements,Maxsize*SizeOf(Double));
  {$ELSE}
    FreeMemory(Maxsize*SizeOf(Double));
  {$ENDIF}
  inherited destroy;
end;

procedure TArray1.dim(x1,x2:double);
begin
   dim(SysIntRound(x1),SysIntRound(x2))
end;

procedure TArray1.dim(x1,x2:NativeInt);
begin
  if maxsize=0 then
     init(x1,x2)
  else
     if (x1<>Lbound) or (x2<>Ubound) then
     setexception(5001);
end;


procedure TArray1.resize(s1:NativeInt);overload;
begin
   if (0<=s1) and  (s1<=maxsize) then
      size1:=s1
   else
      setexception(5001);
end;

procedure TArray1.resize(x1:double);overload;
begin
   resize(SysIntRound(x1))
end;

procedure TArray1.redim(x:double); overload;
var
  ub1:NativeInt;
  NewSize:NativeInt;
begin
  ub1:=SysIntRound(x);
  NewSize:=ub1-LBound1+1;
  if (0<=Newsize)then
   if (NewSize<=Maxsize) then
     begin
        Size1:=NewSize;
     end
   else  setexception(5001)
  else setexception(6005)
end;


procedure TArray1.redim(x1,x2:double);overload;
var
  lb1:NativeInt;
  NewSize1:NativeInt;
begin
  lb1:=SysIntRound(x1);
  NewSize1:=SysIntRound(x2)-lb1+1;
  if (0<=NewSize1) then
     if (NewSize1<=Maxsize) then
         begin
            Lbound1:=lb1;       // Lboundもかえる
            Size1:=NewSize1;
         end
     else setexception(5001)
   else setexception(6005)
end;

function TArray1.Size:NativeInt;overload;
begin
   Size:=Size1;
end;

function TArray1.Lbound:NativeInt; overload;
begin
   LBound:=Lbound1
end;

function TArray1.Ubound:NativeInt; overload;
begin
   Ubound:=Lbound1 + Size1 - 1
end;

function TArray1.Size(d:Double):NativeInt; inline; overload;
begin
   if SysIntRound(d)=1 then
      result:=size1
   else
      setexception(4004)
end;

function TArray1.Lbound(d:Double):NativeInt; overload;
begin
   if SysIntRound(d)=1 then
      result:=Lbound1
   else
      setexception(4008)
end;

function TArray1.Ubound(d:Double):NativeInt; overload;
begin
    case SysIntRound(d) of
     1:  result:=Lbound1 + Size1 - 1;
    else
       setexception(4009)
    end;
end;
function TArray1.index(x:NativeInt):NativeInt;overload;
begin
   result:=x-Lbound1;
   {$IFNDEF OmitIndexCheck}
   if (result<0) or (result>=size1) then
      setexception(2001)
   {$ENDIF}
end;

function TArray1.index(x:double):NativeInt; overload;
begin
   result:=SysIntRound(x)-Lbound1;
   {$IFNDEF OmitIndexCheck}
   if (result<0) or (result>=size1) then
      setexception(2001)
   {$ENDIF}
end;

function TArray1.index(x:complex):NativeInt; overload;
begin
  result:=index(testreal(x))
end;


constructor TArray1N.createCopy(a:TArray1N);
var
  i:NativeInt;
begin
   //TArray.create;
   inherited createnul;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Maxsize:=Size1;
   if maxsize>0 then
       begin
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Double));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
        {$ENDIF}
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray1N.NewCopy:TArray1N;
begin
   result:=TArray1N.createCopy(self)
end;


procedure TArray2.init0(lb1,ub1,lb2,ub2:NativeInt);
var
   Ubound1,UBound2:NativeInt;
   MaxSizeTemp:Int64;
begin
    lbound1:=lb1;
    Ubound1:=ub1;
    Lbound2:=lb2;
    Ubound2:=ub2;
    Size1:=Ubound1-Lbound1+1;
    Size2:=Ubound2-Lbound2+1;
    if Size1<0 then Size1:=0;
    if Size2<0 then Size2:=0;
    {$IFDEF CPUx64}
    maxsize:=size1 * size2;
    {$ELSE}
    MaxSizeTemp:=INT64(Size1)*Int64(Size2);
    if MaxSizeTemp >= $80000000 div sizeOf(Double) then
                                       setexception( -103);
     MaxSize:=MaxSizeTemp;
    {$ENDIF}
end;

procedure TArray2N.init(lb1,ub1,lb2,ub2:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2);
    if maxsize>0 then
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(Double));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
    {$ENDIF}      end;

constructor TArray2.create(x1,x2,y1,y2:double);overload;
begin
   inherited create;
   init(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2));
end;

constructor TArray2.create(x1,x2,y1,y2:NativeInt);overload;
begin
   inherited create;
   init(x1,x2,y1,y2);
end;

destructor TArray2N.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
   FreeMem(Elements,Maxsize*SizeOf(Double));
  {$ELSE}
   FreeMemory(Maxsize*SizeOf(Double));
  {$ENDIF}
    inherited destroy;
end;

procedure TArray2.dim(x1,x2,y1,y2:double);
begin
     dim(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2))
end;

procedure TArray2.dim(x1,x2,y1,y2:NativeInt);
begin
  if maxsize=0 then
     init(x1,x2,y1,y2)
  else if (x1<>Lbound1) or (x2<>UBound(1)) or (y1<>Lbound2) or (y2<Ubound(2)) then
     setexception(5001);
end;

procedure TArray2.resize(x1,x2:double);overload;
begin
   resize(SysIntRound(x1),SysIntRound(x2))
end;

procedure TArray2.resize(s1,s2:NativeInt);overload;
begin
   if (0<=s1) and  (0<=s2) and  (s1*s2<=maxsize) then
      begin
        size1:=s1;
        size2:=s2;
      end
   else
      setexception(5001);
end;

procedure TArray2.resize(x1:double);overload;
var
   s1:NativeInt;
begin
   s1:=SysIntRound(x1);
   ReSize(s1,s1)
end;


procedure TArray2.redim(x,y:double);overload;
var
  ub1,ub2:NativeInt;
  NewSize1,newsize2:NativeInt;
begin
  ub1:=SysIntRound(x);
  ub2:=SysIntRound(y);
  NewSize1:=ub1-LBound1+1;
  NewSize2:=ub2-LBound2+1;
  if (0<=Newsize1) and (0<=NewSize2) then
    if (NewSize1*NewSize2<=Maxsize) then
     begin
        Size1:=NewSize1;
        Size2:=NewSize2;
     end
    else setexception(5001)
  else setexception(6005)
end;


procedure TArray2.redim(x1,x2,y1,y2:double);overload;
var
  lb1,lb2:NativeInt;
  NewSize1,NewSize2:NativeInt;
begin
  lb1:=SysIntRound(x1);
  lb2:=SysIntRound(y1);
  NewSize1:=SysIntRound(x2)-lb1+1;
  NewSize2:=SysIntRound(y2)-lb2+1;
  if (0<=NewSize1) and (0<=NewSize2) then
       if (NewSize1*NewSize2<=Maxsize) then
         begin
            Lbound1:=lb1;       // Lboundもかえる
            Size1:=NewSize1;
            Lbound2:=lb2;       // Lboundもかえる
            Size2:=NewSize2;
         end
      else  setexception(5001)
    else setexception(6005)
end;


function TArray2.Size:NativeInt;overload; inline;
begin
  result:=size1*size2;
end;

function TArray2.Size(d:Double):NativeInt;overload;
begin
   case  SysIntRound(d) of
     1:  result:=size1;
     2:  result:=size2;
   else
      setexception(4004)
   end
end;

function TArray2.Lbound(d:Double):NativeInt; overload;
begin
   case SysIntRound(d) of
     1: result:=Lbound1;
     2: result:=Lbound2;
   else
      setexception(4008)
   end;
end;

function TArray2.Ubound(d:Double):NativeInt; overload;
begin
    case SysIntRound(d) of
     1:  result:=Lbound1 + Size1 - 1;
     2:  result:=Lbound2 + Size2 - 1;
    else
       setexception(4009)
    end;
end;

function TArray2.index(x,y:double):NativeInt;   inline;
var
   i,j:NativeInt;
begin
   i:=SysIntRound(x)-Lbound1;
   j:=SysIntRound(y)-Lbound2;
   {$IFNDEF OmitIndexCheck}
   if (0<=i) and (i<size1) and (0<=j) and (j<size2)  then
   {$ENDIF}
      result:=i*size2 + j
   {$IFNDEF OmitIndexCheck}
   else
      setexception(2001)
   {$ENDIF}
end;

function TArray2.index(x:double; y:complex):NativeInt;overload;
begin
  result:=index(testreal(x), testreal(y))
end;

function TArray2.index(x:complex; y:double):NativeInt;overload;
begin
  result:=index(testreal(x), testreal(y))
end;

function TArray2.index(x,y:complex):NativeInt;overload;
begin
  result:=index(testreal(x), testreal(y))
end;



function TArray2.index(x,y:NativeInt):NativeInt;   inline;
var
   i,j:NativeInt;
begin
   i:=x-Lbound1;
   j:=y-Lbound2;
   {$IFNDEF OmitIndexCheck}
   if (0<=i) and (i<size1) and (0<=j) and (j<size2)  then
   {$ENDIF}
      result:=i*size2 + j
   {$IFNDEF OmitIndexCheck}
   else
      setexception(2001)
   {$ENDIF}
end;

constructor TArray2N.createCopy(a:TArray2N);
var
i:NativeInt;
begin
   inherited createnul;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Maxsize:=Size1*size2;
   if maxsize>0 then
       begin
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Double));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
        {$ENDIF}
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray2N.NewCopy:TArray2N;
begin
   result:=TArray2N.createCopy(self)
end;




procedure TArray3.init0(lb1,ub1,lb2,ub2,lb3,ub3:NativeInt);
var
   Ubound1,UBound2,Ubound3:NativeInt;
   MaxSizeTemp:Int64;
begin
    lbound1:=lb1;
    Ubound1:=ub1;
    Lbound2:=lb2;
    Ubound2:=ub2;
    Lbound3:=lb3;
    Ubound3:=ub3;
    Size1:=Ubound1-Lbound1+1;
    Size2:=Ubound2-Lbound2+1;
    Size3:=Ubound3-Lbound3+1;
    if Size1<0 then Size1:=0;
    if Size2<0 then Size2:=0;
    if Size3<0 then Size3:=0;
    {$IFDEF CPUx64}
    maxsize:=size1 * size2 * size3;
    {$ELSE}
    MaxSizeTemp:=INT64(Size1)*Int64(Size2) * INT64(size3);
    if MaxSizeTemp >= $80000000 div sizeOf(Double) then
                                       setexception( -103);
    MaxSize:=MaxSizeTemp;
    {$ENDIF}
end;

procedure TArray3N.init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2,lb3,ub3);
    if maxsize>0 then
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(Double));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
    {$ENDIF}
end;

constructor TArray3.create(x1,x2,y1,y2,z1,z2:double);
begin
   inherited create;
   init(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2),
        SysIntRound(z1),SysIntRound(z2));
end;

destructor TArray3N.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
    FreeMem(Elements,Maxsize*SizeOf(Double));
  {$ELSE}
    FreeMemory(Maxsize*SizeOf(Double));
  {$ENDIF}
    inherited destroy;
end;


procedure TArray3.dim(x1,x2,y1,y2,z1,z2:double); overload;
begin
    dim(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2),
        SysIntRound(z1),SysIntRound(z2))
end;


procedure TArray3.dim(x1,x2,y1,y2,z1,z2:NativeInt); overload;
begin
  if maxsize=0 then
     init(x1,x2,y1,y2,z1,z2)
  else if (x1<>Lbound1)and(x2<>Ubound(1))and(y1<>Lbound1)and(y2<>Ubound(2))
                                         and(z1<>Lbound3)and(z2<>Ubound(3)) then
     setexception(5001);
end;

procedure TArray3.resize(x1,x2,x3:double);overload;
begin
   resize(SysIntRound(x1),SysIntRound(x2),SysIntRound(x3))
end;

procedure TArray3.resize(s1,s2,s3:NativeInt);overload;
begin
   if (0<=s1) and  (0<=s2) and  (0<=s3) and (s1*s2*s3<=maxsize) then
      begin
        size1:=s1;
        size2:=s2;
        size3:=s3;
      end
   else
      setexception(5001);
end;

procedure TArray3.redim(x,y,z:double);overload;
var
  ub1,ub2,ub3:NativeInt;
  NewSize1,newsize2,NewSize3:NativeInt;
begin
  ub1:=SysIntRound(x);
  ub2:=SysIntRound(y);
  ub3:=SysIntRound(z);
  NewSize1:=ub1-LBound1+1;
  NewSize2:=ub2-LBound2+1;
  NewSize3:=ub3-LBound3+1;
  if (0<=Newsize1) and (0<=NewSize2)  and (0<=NewSize3)then
     if (NewSize1*NewSize2*NewSize3<=Maxsize) then
     begin
        Size1:=NewSize1;
        Size2:=NewSize2;
        Size3:=NewSize3;
     end
     else  setexception(5001)
  else setexception(6005)
end;


procedure TArray3.redim(x1,x2,y1,y2,z1,z2:double); overload;
var
  lb1,lb2,lb3:NativeInt;
  NewSize1,NewSize2,NewSize3:NativeInt;
begin
  lb1:=SysIntRound(x1);
  lb2:=SysIntRound(y1);
  lb3:=SysIntRound(z1);
  NewSize1:=SysIntRound(x2)-lb1+1;
  NewSize2:=SysIntRound(y2)-lb2+1;
  NewSize3:=SysIntRound(z2)-lb3+1;
  if (0<=NewSize1) and (0<=NewSize2) and (0<=NewSize3) then
     if (NewSize1*NewSize2*NewSize3<=Maxsize) then
     begin
        Lbound1:=lb1;       // Lboundもかえる
        Size1:=NewSize1;
        Lbound2:=lb2;       // Lboundもかえる
        Size2:=NewSize2;
        Lbound3:=lb3;       // Lboundもかえる
        Size3:=NewSize3;
     end
     else  setexception(5001)
   else setexception(6005)
end;

function TArray3.Size:NativeInt;overload;    inline;
begin
   result:=size1*size2*size3
end;


function TArray3.Size(d:Double):NativeInt;overload; inline;
begin
   case  SysIntRound(d) of
     1:  result:=size1;
     2:  result:=size2;
     3:  result:=size3;
   else
      setexception(4004)
   end
end;

function TArray3.Lbound(d:Double):NativeInt;overload;
begin
   case SysIntRound(d) of
     1: result:=Lbound1;
     2: result:=Lbound2;
     3: result:=Lbound3;
   else
      setexception(4008)
   end;
end;

function TArray3.Ubound(d:Double):NativeInt; overload;
begin
    case SysIntRound(d) of
     1:  result:=Lbound1 + Size1 - 1;
     2:  result:=Lbound2 + Size2 - 1;
     3:  result:=Lbound3 + Size3 - 1;
    else
       setexception(4009)
    end;
end;

function TArray3.index(x,y,z:NativeInt):NativeInt; inline;
var
   i,j,k:NativeInt;
begin
   i:=x-Lbound1;
   j:=y-Lbound2;
   k:=z-Lbound3;
   {$IFNDEF OmitIndexCheck}
   if (0<=i) and (i<size1) and (0<=j) and (j<size2) and (0<=k) and (k<size3) then
   {$ENDIF}
      result:=(i*size2 + j)*size3 + k
   {$IFNDEF OmitIndexCheck}
   else
      setexception(2001)
   {$ENDIF}
end;

function TArray3.index(x,y,z:double):NativeInt; inline;
var
   i,j,k:NativeInt;
begin
   i:=SysIntRound(x)-Lbound1;
   j:=SysIntRound(y)-Lbound2;
   k:=SysIntRound(z)-Lbound3;
   {$IFNDEF OmitIndexCheck}
   if (0<=i) and (i<size1) and (0<=j) and (j<size2) and (0<=k) and (k<size3) then
   {$ENDIF}
      result:=(i*size2 + j)*size3 + k
   {$IFNDEF OmitIndexCheck}
   else
      setexception(2001)
   {$ENDIF}
end;

constructor TArray3N.createCopy(a:TArray3N);
var
  i:NativeInt;
begin
   //TArray.create;
   inherited createnul;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Lbound3:=a.Lbound3;
   Size3:=a.Size3;
   Maxsize:=Size1*size2*size3;
   if maxsize>0 then
       begin
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Double));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
        {$ENDIF}
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray3N.NewCopy:TArray3N;
begin
   result:=TArray3N.createCopy(self)
end;


{TARray4}

procedure TArray4.init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
   var
      Ubound1,UBound2,Ubound3,UBound4:NativeInt;
      MaxSizeTemp:Int64;
   begin
       Lbound1:=lb1;
       Ubound1:=ub1;
       Lbound2:=lb2;
       Ubound2:=ub2;
       Lbound3:=lb3;
       Ubound3:=ub3;
       LBound4:=lb4;
       UBound4:=ub4;
       Size1:=Ubound1-Lbound1+1;
       Size2:=Ubound2-Lbound2+1;
       Size3:=Ubound3-Lbound3+1;
       Size4:=Ubound4-Lbound4+1;
       if Size1<0 then Size1:=0;
       if Size2<0 then Size2:=0;
       if Size3<0 then Size3:=0;
       if Size4<0 then Size4:=0;
       {$IFDEF CPUx64}
       maxsize:=size1 * size2 * size3 * size4;
       {$ELSE}
       MaxSizeTemp:=INT64(Size1)*Int64(Size2) * INT64(size3) * INT64(size4);
       if MaxSizeTemp >= $80000000 div sizeOf(Double) then
                                          setexception( -103);
           MaxSize:=MaxSizeTemp;
       {$ENDIF}

   end;


 procedure TArray4N.init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
   begin
       init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4);
       if maxsize>0 then
       {$IFDEF HeapArrays}
          Elements:=AllocMem(Maxsize*SizeOf(Double));
       {$ELSE}
          Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
       {$ENDIF}
   end;


constructor TArray4.create(x1,x2,y1,y2,z1,z2,w1,w2:double);
   begin
      inherited create;
      init(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2),
           SysIntRound(z1),SysIntRound(z2),SysIntRound(w1),SysIntRound(w2));
   end;

destructor TArray4N.destroy;
begin
    if elements<>nil then
     {$IFDEF HeapArrays}
       FreeMem(Elements,Maxsize*SizeOf(Double));
     {$ELSE}
       FreeMemory(Maxsize*SizeOf(Double));
     {$ENDIF}
     inherited destroy;
   end;


procedure TArray4.dim(x1,x2,y1,y2,z1,z2,w1,w2:double); overload;
   begin
       dim(SysIntRound(x1),SysIntRound(x2),SysIntRound(y1),SysIntRound(y2),
           SysIntRound(z1),SysIntRound(z2),SysIntRound(w1),SysIntRound(w2))
   end;


   procedure TArray4.dim(x1,x2,y1,y2,z1,z2,w1,w2:NativeInt); overload;
   begin
     if maxsize=0 then
        init(x1,x2,y1,y2,z1,z2,w1,w2)
     else if (x1<>Lbound1)and(x2<>Ubound(1))and(y1<>Lbound1)and(y2<>Ubound(2))
          and(z1<>Lbound3)and(z2<>Ubound(3))and(w1<>Lbound4)and(w2<>Ubound(4)) then
        setexception(5001);
   end;

   procedure TArray4.resize(x1,x2,x3,x4:double);overload;
   begin
      resize(SysIntRound(x1),SysIntRound(x2),SysIntRound(x3),SysIntRound(x4))
   end;

   procedure TArray4.resize(s1,s2,s3,s4:NativeInt);overload;
   begin
      if (0<=s1) and (0<=s2) and (0<=s3) and (0<=s4) and (s1*s2*s3*s4<=maxsize) then
         begin
           size1:=s1;
           size2:=s2;
           size3:=s3;
           size4:=s4;
         end
      else
         setexception(5001);
   end;

   procedure TArray4.redim(x,y,z,w:double);overload;
   var
     ub1,ub2,ub3,ub4:NativeInt;
     NewSize1,newsize2,NewSize3,NewSize4:NativeInt;
   begin
     ub1:=SysIntRound(x);
     ub2:=SysIntRound(y);
     ub3:=SysIntRound(z);
     ub4:=SysIntRound(w);
     NewSize1:=ub1-LBound1+1;
     NewSize2:=ub2-LBound2+1;
     NewSize3:=ub3-LBound3+1;
     NewSize4:=ub4-LBound4+1;
     if (0<=Newsize1) and (0<=NewSize2) and (0<=NewSize3) and (0<=NewSize4) then
       if (NewSize1*NewSize2*NewSize3*NewSize4<=Maxsize) then
           begin
           Size1:=NewSize1;
           Size2:=NewSize2;
           Size3:=NewSize3;
           Size4:=NewSize4;
           end
           else   setexception(5001)
       else setexception(6005)
   end;


   procedure TArray4.redim(x1,x2,y1,y2,z1,z2,w1,w2:double); overload;
   var
     lb1,lb2,lb3,lb4:NativeInt;
     NewSize1,NewSize2,NewSize3,NewSize4:NativeInt;
   begin
     lb1:=SysIntRound(x1);
     lb2:=SysIntRound(y1);
     lb3:=SysIntRound(z1);
     lb4:=SysIntRound(w1);
     NewSize1:=SysIntRound(x2)-lb1+1;
     NewSize2:=SysIntRound(y2)-lb2+1;
     NewSize3:=SysIntRound(z2)-lb3+1;
     NewSize4:=SysIntRound(w2)-lb4+1;
     if (0<=NewSize1) and (0<=NewSize2) and (0<=NewSize3)  and (0<=NewSize4) then
        if  (NewSize1*NewSize2*NewSize3*NewSize4<=Maxsize) then
            begin
               Lbound1:=lb1;       // Lboundもかえる
               Size1:=NewSize1;
               Lbound2:=lb2;       // Lboundもかえる
               Size2:=NewSize2;
               Lbound3:=lb3;       // Lboundもかえる
               Size3:=NewSize3;
               Lbound4:=lb4;       // Lboundもかえる
               Size4:=NewSize4;
            end
         else  setexception(5001)
      else setexception(6005)
   end;

   function TArray4.Size:NativeInt;overload;    inline;
   begin
      result:=size1*size2*size3*size4
   end;


   function TArray4.Size(d:Double):NativeInt;overload; inline;
   begin
      case  SysIntRound(d) of
        1:  result:=size1;
        2:  result:=size2;
        3:  result:=size3;
        4:  result:=size4;
      else
         setexception(4004)
      end
   end;

   function TArray4.Lbound(d:Double):NativeInt;overload;
   begin
      case SysIntRound(d) of
        1: result:=Lbound1;
        2: result:=Lbound2;
        3: result:=Lbound3;
        4: result:=Lbound4;
      else
         setexception(4008)
      end;
   end;

   function TArray4.Ubound(d:Double):NativeInt; overload;
   begin
       case SysIntRound(d) of
        1:  result:=Lbound1 + Size1 - 1;
        2:  result:=Lbound2 + Size2 - 1;
        3:  result:=Lbound3 + Size3 - 1;
        4:  result:=Lbound4 + Size4 - 1;
       else
          setexception(4009)
       end;
   end;

   function TArray4.index(x,y,z,w:NativeInt):NativeInt; inline;
   var
      i,j,k,l:NativeInt;
   begin
      i:=x-Lbound1;
      j:=y-Lbound2;
      k:=z-Lbound3;
      l:=w-Lbound4;
      {$IFNDEF OmitIndexCheck}
      if (0<=i) and (i<size1) and (0<=j) and (j<size2)
                              and (0<=k) and (k<size3)
                              and (0<=l) and (l<size4) then
      {$ENDIF}
         result:=((i*size2 + j)*size3 + k)*size4 + l
     {$IFNDEF OmitIndexCheck}
      else
         setexception(2001)
     {$ENDIF}
   end;

   function TArray4.index(x,y,z,w:double):NativeInt; inline;
   var
      i,j,k,l:NativeInt;
   begin
      i:=SysIntRound(x)-Lbound1;
      j:=SysIntRound(y)-Lbound2;
      k:=SysIntRound(z)-Lbound3;
      l:=SysIntRound(w)-Lbound4;
      {$IFNDEF OmitIndexCheck}
      if (0<=i) and (i<size1) and (0<=j) and (j<size2)
                              and (0<=k) and (k<size3)
                              and (0<=l) and (l<size4) then
      {$ENDIF}
         result:=((i*size2 + j)*size3 + k)*size4 + l
      {$IFNDEF OmitIndexCheck}
      else
         setexception(2001)
      {$ENDIF}
   end;

constructor TArray4N.createCopy(a:TArray4N);
var
  i:NativeInt;
begin
   //TArray.create;
   inherited createnul;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Lbound3:=a.Lbound3;
   Size3:=a.Size3;
   Lbound4:=a.Lbound4;
   Size4:=a.Size4;
   Maxsize:=Size1*size2*size3*size4;
   if maxsize>0 then
       begin
        {$IFDEF HeapArrays}
           Elements:=AllocMem(Maxsize*SizeOf(Double));
        {$ELSE}
           Elements:=GetZeroMemory(Maxsize*SizeOf(Double));
        {$ENDIF}
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;


 function TArray4N.NewCopy:TArray4N;
begin
   result:=TArray4N.createCopy(self)
end;



{**************}
{MAT OPERATIONS}
{**************}

procedure TArray1N.subst(a:TArray1N);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   if a.size1>maxsize then setexception(5001);
   Size1:=a.Size1;
   for i:=0 to a.size1-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1N.subst(a:TArray2N);
var
   i:NativeInt;
begin
   if a.size1<>1 then setexception(6001);
   if MaxSize=0 then
      dim(a.Lbound2,a.lbound2+a.size2-1);
   if a.size2>maxsize then setexception(5001);
   Size1:=a.Size2;
   for i:=0 to a.size2-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1N.trn(a:TArray2N);           //aが縦ベクトルのとき用いる
var
   i:NativeInt;
begin
   if a.size2<>1 then setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1);
    if a.size1>maxsize then setexception(5001);
   Size1:=a.Size1;
   for i:=0 to a.size1-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1N.add(a,b:TArray1N);
var
   c:TArray1N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   c:=TArray1N.create(1,a.size1);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray1N.sub(a,b:TArray1N);
var
   c:TArray1N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   c:=TArray1N.create(1,a.size1);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray1N.prod(a:TArray1N; b:TArray2N); overload;
var
   i,j:NativeInt;
   c:TArray1N;
begin
   if a.size1<>b.size1 then setexception(6001);
   if MaxSize=0 then
      dim(b.lbound2,b.lbound2+b.size2-1);
   c:=TArray1N.create(1, b.size2);
   try
     for j:=0 to b.size2-1 do
       for i:=0 to b.size1 -1 do
         c.elements^[j]:=c.elements^[j]+ a.elements^[i]*b.elements^[i*b.size2+j];
     subst(c);
   finally
     c.free;
   end;

end;

procedure TArray1N.prod(a:TArray2N; b:TArray1N); overload;
var
   i,j:NativeInt;
   c:TArray1N;
begin
   if a.size2<>b.size1 then setexception(6001);
   c:=TArray1N.create(1, a.size1);
   try
     for i:=0 to a.size1-1 do
       for j:=0 to a.size2 -1 do
         c.elements^[i]:=c.elements^[i]+ a.elements^[i*a.size2+j]*b.elements^[j];
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray1N.scalar(x:double; a:TArray1N);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray1N.CON(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray1N.CON;
begin
  CON(1)
end;

procedure TArray1N.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size1-1 do
      elements^[i]:=0;
end;

procedure TArray1N.zer(x:double);overload;
begin
   zer
end;

procedure TArray1N.CROSSsub(a,b:TArray1N);
var
   i:NativeInt;
   x,y:double;
begin
   for i:=0 to 2 do
     begin
       elements^[i mod 3]:=0;
       x:=a.elements^[(i+1) mod 3];
       x:=x*b.elements^[(i+2) mod 3];
       y:=b.elements^[(i+1) mod 3];
       y:=y*a.elements^[(i+2) mod 3];
       elements^[i mod 3]:=elements^[i mod 3]+x-y;
    end;
end;

procedure TArray1N.CROSS(a,b:TArray1N);
var
  c:TArray1N;
begin
   if (a.size<3) or (b.size<3) then setexception(6001);
   if MaxSize<3 then setexception(5001);
   c:=TArray1N.create(1,3);
   try
     c.CrossSub(a,b);
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray1N.row(a:TArray2N;n:integer);
var
  i:integer;
  x:double;
begin
   if maxsize=0 then
      dim(1,a.size2);
   if maxsize<a.size2 then
          setexception(5001);
   size1:=a.size2;
   for i:=0 to size1 -1 do
       begin
         with a do
            x:=elements^[index(n,lbound2+i)];
         elements^[i]:=x;
       end;
end;

procedure TArray1N.column(a:TArray2N;n:integer);
var
  i:integer;
  x:double;
begin
   if maxsize=0 then
      dim(1,a.size1);
   if maxsize<a.size1 then
          setexception(5001);
   size1:=a.size1;
   for i:=0 to size1 -1 do
       begin
         with a do
            x:=elements^[index(lbound1+i,n)];
         elements^[i]:=x;
       end;
end;

procedure TArray1N.row(a:TArray2N;n:double);
begin
   row(a,System.Round(n))
end;

procedure TArray1N.column(a:TArray2N;n:double);
begin
   column(a,System.Round(n))
end;

{********}
{TArray2N}
{********}

procedure TArray2N.subst(a:TArray1N);
var
   i:NativeInt;
begin
   if size1<>1 then setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound,a.Lbound,a.lbound+a.size1-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(1,a.size1);
   for i:=0 to size-1 do
          elements^[i]:=a.elements^[i]
end;


procedure TArray2N.subst(a:TArray2N);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2);
   for i:=0 to size-1 do
          elements^[i]:=A.elements^[i]
end;

procedure TArray2N.add(a,b:TArray2N);
var
   c:TArray2N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray2N.create(1, a.size1, 1, a.size2);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray2N.sub(a,b:TArray2N);
var
   c:TArray2N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray2N.create(1, a.size1, 1, a.size2);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray2N.ProdSub(a:TArray2N; b:TArray2N);
var
  i,j,k:NativeInt;
begin
   for i:=0 to size1-1 do
      for j:=0 to size2-1 do
         for k:=0 to a.size2-1 do
            elements^[size2*i+j]:=elements^[Size2*i+j]+a.elements^[a.Size2*i+k]*b.elements^[b.size2*k+j];
end;

procedure TArray2N.prod(a:TArray2N; b:TArray2N);
var
  c:TArray2N;
  //i,j,k:NativeInt;
begin
   if (a.Size2<>b.Size1)  then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,b.Lbound2,b.lbound2+b.size2-1)
   else
      resize(a.size1, b.Size2);
   //if a.Size1 * b.Size2 >MaxSize then
   //   setexception(5001);
   c:=TArray2N.create(1, a.size1, 1, b.size2);
   try
     c.ProdSub(a,b);
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray2N.INV(a:TArray2N);
var
   c:TArray2N;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   c:=a.inverse;
   subst(c);
   c.free;
end;

procedure TArray2N.TRNSub(a:TArray2N);
var
   i,j:NativeInt;
begin
   for i:=0 to size1 -1 do
     for j:=0 to size2 -1 do
        elements^[j+size2*i]:=a.elements^[i+a.Size2*j];
end;

procedure TArray2N.TRN(a:TArray2N);
var
   c:TArray2N;
begin
   if MaxSize=0 then
      dim(a.lbound2,a.lbound2+a.size2-1,a.Lbound1,a.lbound1+a.size1-1)
   else
      resize(a.size2, a.size1);
   c:=TArray2N.create(1, a.Size2, 1, a.size1);
   c.TRNSub(a);
   subst(c);
   c.free;           //2025/10/04
end;

procedure TArray2N.TRN(a:TArray1N);       //2025/10/04 //ver.1.2.2.4
var
   c:TArray2N;
   i:nativeint;
begin
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1,a.Lbound,a.lbound)
   else
      resize(a.size, 1);
   for i:=0 to size1 -1 do
        elements^[i]:=a.elements^[i];
end;

procedure TArray2N.scalar(x:double; a:TArray2N);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray2N.power(a:Tarray2N; x:double);       //a<>selfに限る
var
  a1:TArray2N;
  i,n:NativeInt;
begin
  if a.size1<>a.size2 then
     setexception(6001);
  if MaxSize=0 then
     dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound1,a.lbound1+a.size1-1);
  n:=system.Round(x);
  if n=0 then
       IDN
  else
    begin
      if n>0 then
          begin
            subst(a);
            for i:=2 to n do
                prod(self,a);
          end
       else
          begin
             n:=-n;
             a1:=TArray2N.create(1, a.Size2, 1, a.size1);
             a1:=a.inverse;
             subst(a1);
             for i:=2 to n do
                 prod(self,a1);
             a1.free;
          end ;
  end;

end;



procedure TArray2N.con;
begin
  CON(1)
end;

procedure TArray2N.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray2N.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray2N.zer(x:double);overload;
begin
   zer
end;


procedure TArray2N.IDN;          overload;
begin
   IDN(1)
end;

procedure TArray2N.IDN(x:double);overload;
var
   i:NativeInt;
begin
   if size1<>size2 then setexception(6004);
   zer;
   for i:=0 to size1-1 do
       elements^[i+size2*i]:=x
end;



procedure TArray2N.row(a:TArray2N; m,n:integer);
var
  i,j:integer;
  x:double;
begin
   size1:=n-m+1;
   size2:=a.size2;
   if maxsize=0 then
       dim(1,size1,1,size2);
   for j:=0 to n-m do          //行
    for i:=0 to size2 -1 do    //列
      begin
         with a do
             x:=elements^[index(j+m,lbound2+i)];
          elements^[j*size2 + i  ]:=x;
      end;
 end;

procedure TArray2N.column(a:TArray2N; m,n:integer);
var
  i,j:integer;
  x:double;
begin
   size1:=a.size1;
   size2:=n-m+1;
   if maxsize=0 then
       dim(1,size1,1,size2);
   for j:=0 to n-m do          //列
    for i:=0 to size1 -1 do    //行
      begin
         with a do
             x:=elements^[index(lbound1+i,m+j)];
          elements^[i*size2 + j  ]:=x;
      end;
 end;

procedure TArray2N.SubstRow1(n:integer; a:TArray1N);
var
  i:integer;
  x:double;
begin
  if a.size1<>size2 then
     setexception(6001);
  for i:=0 to size2-1 do
      begin
        x:=a.elements^[i];
        elements^[index(n, lbound2+i)]:=x;
      end;
end;

procedure TArray2N.SubstColumn1(n:integer; a:TArray1N);
var
  i:integer;
  x:double;
begin
  if a.size1<>size1 then
     setexception(6001);
  for i:=0 to size1-1 do
      begin
        x:=a.elements^[i];
        elements^[index(lbound1+i, n)]:=x;
      end;
end;

procedure TArray2N.SubstRow2(m,n:integer; a:TArray2N);
var
  i,j,k,m0,n0:integer;
  x:double;
begin
  if a.size2<>size2 then
     setexception(6001);
  m0:=m-lbound1;         //0ベースの行位置(始まり)
  n0:=n-lbound1;         //0ベースの行位置(終わり）

  k:=a.size1-(n-m+1);    //増加する行数
  if (size1+k)*size2>maxsize then
     setexception(5001);

  if k>0 then
     begin
       //後方へ移す
      for j:=size1-1 downto n0+1  do                           //n0行以降を後方に移動
          for i:=0 to size2-1 do                                //j行全体をコピー
           begin
                x:=elements^[ j*size2 +i];                        // j行i列要素
                elements^[(j+k)*size2 +i]:=x;                  // (j+k)行i列要素にする
           end;
     end
  else if k<0 then
     begin
       //前方へ移す
        for j:=n0+1 to size1-1  do                            //n0行以降を前方に移動
           for i:=0 to size2-1 do
            begin
              x:=elements^[ j*size2 + i];                        // j行i列要素
               elements^[(j+k)*size2 +i]:=x;
            end;
    end;

  size1:=size1+k;          //新しい行数

  for j:=0 to a.size1-1  do                                  //aの各行(j行)に対し
    for i:=0 to size2-1 do                                //j行全体をコピー
      begin
        with a do
           x:=a.elements^[j*size2 + i ];                        // j行i列要素
        elements^[index(m+j, lbound2+i)]:=x;                 //(m+j)行i列要素
      end;

end;

procedure TArray2N.SubstColumn2(m,n:integer; a:TArray2N);
var
  i,j,k,m0,n0:integer;
  c:TArray2N;
  x:double;
begin
  if a.size1<>size1 then                //行数が一致するか？
     setexception(6001);

   m0:=m-lbound1;         //0ベースの行位置(始まり)
   n0:=n-lbound1;         //0ベースの行位置(終わり）

  k:=a.size2-(n-m+1);    //増加する列数
  if size1*(size2+k)>maxsize then
     setexception(5001);

  c:=TArray2N.create(lbound1,size1,lbound2,size2+k);
  try
      for j:=0 to c.size2-1 do
        for i:=0 to c.size1-1 do
          begin
             if j<m0 then
                   x:=elements^[i*size2+j]
             else if j<=n0+k then
                   with a do
                     x:=elements[i*size2+j-m0]
             else
                   x:=elements[i*size2+j-k];
             with c do
                      elements^[i*size2+j]:=x;
           end;
      subst(c);
   finally
      c.free;
   end;
end;

procedure TArray2N.row(a:TArray2N;m,n:double);
begin
  row(a,System.Round(m),System.Round(n))
end;

procedure TArray2N.column(a:TArray2N;m,n:double);
begin
  column(a,System.Round(m),System.Round(n))
end;

procedure TArray2N.SubstRow1(n:double; a:TArray1N);
begin
   SubstRow1(System.Round(n), a)
end;

procedure TArray2N.SubstRow2(m,n:double; a:TArray2N);
begin
   SubstRow2(System.Round(m),System.Round(n), a)
end;

procedure TArray2N.SubstColumn1(n:double; a:TArray1N);
begin
   SubstColumn1(System.Round(n), a)
end;

procedure TArray2N.SubstColumn2(m,n:double; a:TArray2N);
begin
   SubstColumn2(System.Round(m),System.Round(n), a)
end;


{********}
{TArray3N}
{********}

procedure TArray3N.subst(a:TArray3N);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2,a.size3);
   for i:=0 to size-1 do
          elements^[i]:=a.elements^[i]

end;

procedure TArray3N.add(a,b:TArray3N);
var
   c:TArray3N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray3N.create(1, a.size1, 1, a.size2, 1, a.size3);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray3N.sub(a,b:TArray3N);
var
   c:TArray3N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray3N.create(1, a.size1, 1, a.size2, 1, a.size3);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray3N.scalar(x:double; a:TArray3N);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray3N.con;
begin
  CON(1)
end;

procedure TArray3N.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray3N.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray3N.zer(x:double);overload;
begin
   zer
end;

{TArray4N}

procedure TArray4N.subst(a:TArray4N);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1,a.Lbound4,a.lbound4+a.size4-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2,a.size3,a.size4);
   for i:=0 to size-1 do
          elements^[i]:=a.elements^[i]

end;

procedure TArray4N.add(a,b:TArray4N);
var
   c:TArray4N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)
                                               or (a.Size4<>b.Size4)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1,a.Lbound4,a.lbound4+a.size4-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray4N.create(1, a.size1, 1, a.size2, 1, a.size3, 1, size4);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray4N.sub(a,b:TArray4N);
var
   c:TArray4N;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)
                                               or (a.Size4<>b.Size4)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1,a.Lbound4,a.lbound4+a.size4-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray4N.create(1, a.size1, 1, a.size2, 1, a.size3, 1, size4);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray4N.scalar(x:double; a:TArray4N);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray4N.con;
begin
  CON(1)
end;

procedure TArray4N.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray4N.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray4N.zer(x:double);overload;
begin
   zer
end;

{***********************}
 {String Array Operations}
 {***********************}
 procedure SubstStr(var a:StringArray; size:NativeInt; s:string);
 var
   i:NativeInt;
 begin
   for i:=0 to size-1 do
      a[i]:=s
 end;

 procedure SubstNul(var a:StringArray; size:NativeInt);
 begin
   substStr(a,size,'')
 end;

procedure CopyFrom(var a:StringArray; size:NativeInt; const b:StringArray);
 var
   i:NativeInt;
 begin
   for i:=0 to size-1 do
      a[i]:=b[i]
 end;

procedure SubstArraySubstring(var a:StringArray; size:NativeInt;i,j:integer; const s:string); overload;
 var
   k:NativeInt;
begin
   for k:=0 to size-1 do
      SubstSubstring(a[k],i,j,s)
end;

procedure SubstArraySubstring(var a:StringArray; size:NativeInt; i,j:integer; const b:StringArray);overload;
 var
   k:NativeInt;
begin
   for k:=0 to size-1 do
      SubstSubstring(a[k],i,j,b[k])
end;

procedure SubstArraySubstringByte(var a:StringArray; size:NativeInt;i,j:integer; const s:string); overload;
 var
   k:NativeInt;
begin
   for k:=0 to size-1 do
      SubstSubstringByte(a[k],i,j,s)
end;

procedure SubstArraySubstringByte(var a:StringArray; size:NativeInt; i,j:integer; const b:StringArray);overload;
 var
   k:NativeInt;
begin
   for k:=0 to size-1 do
      SubstSubstringByte(a[k],i,j,b[k])
end;

procedure ConcatArrays(var a:stringArray; size:NativeInt; const b,c:StringArray);
 var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      a[i]:=b[i]+c[i]
end;

procedure leftConcat(var a:StringArray; size:NativeInt; const s:string);
 var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      a[i]:=s+a[i]
end;

procedure rightConcat(var a:StringArray; size:NativeInt; const s:string);
 var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      a[i]:=a[i]+s
end;

procedure ArraySubstring(var a:StringArray; size:NativeInt; i,j:integer);
var
   k:NativeInt;
begin
   for k:=0 to size-1 do
       a[k]:=baslib.substring(a[k],i,j)
end;

procedure ArraySubstringByte(var a:StringArray; size:NativeInt; i,j:integer);
var
   k:NativeInt;
begin
   for k:=0 to size-1 do
       a[k]:=baslib.substringByte(a[k],i,j)
end;
 {*************}
 {String Arrays}
 {*************}

procedure TArray1S.init(lb1,ub1:NativeInt);
begin
    init0(lb1,ub1);
    if maxsize>0 then
    {$IFDEF HeapArrays}
      Elements:=AllocMem(Maxsize*SizeOf(AnsiString));
    {$ELSE}
      Elements:=GetZeroMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
end;

destructor TArray1S.destroy;
var
   i:NativeInt;
begin
  if elements<>nil then
  begin
    for i:=0 to maxsize-1 do elements^[i]:='';
    {$IFDEF HeapArrays}
      FreeMem(Elements,Maxsize*SizeOf(AnsiString));
    {$ELSE}
      FreeMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
  end;
  inherited destroy;
end;

constructor TArray1S.CreateNulCopy(a:TArray1S);
begin
  create(a.lbound1, a.Size1-a.lbound1+1);
end;

constructor TArray1S.createCopy(a:TArray1S);
begin
   CreateNulCopy(a);
   copyfrom(elements^,size,a.elements^)
end;

constructor TArray1S.CreateConcat(a,b:TArray1S);
begin
   CreateNulCopy(a);
   ConcatArrays(elements^,size,a.elements^,b.elements^)
end;

function TArray1S.NewCopy:TArray1S;
begin
  result:=TArray1S.createCopy(self);
end;

function TArray1S.NulCopy:TArray1S;
begin
    result:=TArray1S.CreateNulCopy(self);
end;

procedure TArray1S.Substring(i,j:integer);
begin
   ArraySubstring(elements^,size,i,j)
end;

procedure TArray1S.SubStringByte(i,j:integer);
begin
   ArraySubstringByte(elements^,size,i,j)
end;

function TArray1S.newcopySubstring(i,j:integer):TArray1S;
begin
  result:=NewCopy;
  result.Substring(i,j);
end;

function TArray1S.newcopySubstringByte(i,j:integer):TArray1S;
begin
  result:=NewCopy;
  result.SubstringByte(i,j);
end;

procedure TArray1S.Subst(a:TArray1S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size) ;
         CopyFrom(elements^,size,a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray1S.SubstSubstring(i,j:integer; a:TArray1S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size) ;
         SubstArraySubstring(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray1S.SubstSubstringByte(i,j:integer; a:TArray1S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size) ;
         SubstArraySubstringByte(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;


class function TArray1S.Concat(a,b:TArray1S):TArray1S; overload;       // a,bを削除する
begin
  try
    if a.size<>b.size then setexception(6101);
    result:=a.NulCopy;
    ConcatArrays(result.elements^,result.size,a.elements^,b.elements^);
  finally
    a.free;
    b.free;
  end;
end;

class function TArray1S.Concat(a:TArray1S; const s:string):TArray1S; overload; // aを削除する
begin
  try
    result:=a.NewCopy;
    RightConcat(result.elements^,result.size,s);
  finally
    a.free;
  end;
end;

class function TArray1S.Concat(const s:String; b:TArray1S):TArray1S; overload; // bを削除する
begin
  try
    result:=b.NewCopy;
    LeftConcat(result.elements^,result.size,s);
  finally
    b.free;
  end;
end;


procedure TArray2S.init(lb1,ub1,lb2,ub2:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2);
    if maxsize>0 then
    {$IFDEF HeapArrays}
      Elements:=AllocMem(Maxsize*SizeOf(AnsiString));
    {$ELSE}
      Elements:=GetZeroMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}               end;

destructor TArray2S.destroy;
var
   i:NativeInt;
begin
  if elements<>nil then
    begin
    for i:=0 to maxsize-1 do elements^[i]:='';
    {$IFDEF HeapArrays}
      FreeMem(Elements,Maxsize*SizeOf(AnsiString));
    {$ELSE}
      FreeMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
    end;
  inherited destroy;
end;


constructor TArray2S.CreateNulCopy(a:TArray2S);
begin
  create(a.lbound1, a.Size1-a.lbound1+1, a.lbound2, a.Size2-a.lbound2+1);
end;

constructor TArray2S.createCopy(a:TArray2S);
begin
   CreateNulCopy(a);
   copyfrom(elements^,size,a.elements^)
end;

constructor TArray2S.CreateConcat(a,b:TArray2S);
begin
   CreateNulCopy(a);
   ConcatArrays(elements^,size,a.elements^,b.elements^)
end;

function TArray2S.NewCopy:TArray2S;
begin
  result:=TArray2S.createCopy(self);
end;

function TArray2S.NulCopy:TArray2S;
begin
    result:=TArray2S.CreateNulCopy(self);
end;

procedure TArray2S.Substring(i,j:integer);
begin
   ArraySubstring(elements^,size,i,j)
end;

procedure TArray2S.SubStringByte(i,j:integer);
begin
   ArraySubstringByte(elements^,size,i,j)
end;

function TArray2S.newcopySubstring(i,j:integer):TArray2S;
begin
  result:=NewCopy;
  result.Substring(i,j);
end;

function TArray2S.newcopySubstringByte(i,j:integer):TArray2S;
begin
  result:=NewCopy;
  result.SubstringByte(i,j);
end;

procedure TArray2S.Subst(a:TArray2S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1,a.size2) ;
         CopyFrom(elements^,size,a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray2S.SubstSubstring(i,j:integer; a:TArray2S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1,a.size2) ;
         SubstArraySubstring(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray2S.SubstSubstringByte(i,j:integer; a:TArray2S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1,a.size2) ;
         SubstArraySubstringByte(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;


class function TArray2S.Concat(a,b:TArray2S):TArray2S; overload;       // a,bを削除する
begin
  try
    if a.size<>b.size then setexception(6101);
    result:=a.NulCopy;
    ConcatArrays(result.elements^,result.size,a.elements^,b.elements^);
  finally
    a.free;
    b.free;
  end;
end;

class function TArray2S.Concat(a:TArray2S; const s:string):TArray2S; overload; // aを削除する
begin
  try
    result:=a.NewCopy;
    RightConcat(result.elements^,result.size,s);
  finally
    a.free;
  end;
end;

class function TArray2S.Concat(const s:String; b:TArray2S):TArray2S; overload; // bを削除する
begin
  try
    result:=b.NewCopy;
    LeftConcat(result.elements^,result.size,s);
  finally
    b.free;
  end;
end;





destructor TArray3S.destroy;
var
   i:NativeInt;
begin
  if elements<>nil then
  begin
    for i:=0 to maxsize-1 do elements^[i]:='';
    {$IFDEF HeapArrays}
      FreeMem(Elements,Maxsize*SizeOf(AnsiString));
    {$ELSE}
      FreeMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
  end;
  inherited destroy;
end;


destructor TArray4S.destroy;
var
   i:NativeInt;
begin
  if elements<>nil then
  begin
    for i:=0 to maxsize-1 do elements^[i]:='';
    {$IFDEF HeapArrays}
      FreeMem(Elements,Maxsize*SizeOf(AnsiString));
    {$ELSE}
      FreeMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
   end;
   inherited destroy;
end;


procedure TArray3S.init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2,lb3, ub3);
    if maxsize>0 then
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(AnsiString));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
end;

constructor TArray3S.CreateNulCopy(a:TArray3S);
begin
  create(a.lbound1, a.Size1-a.lbound1+1, a.lbound2, a.Size2-a.lbound2+1,
                                         a.lbound3, a.Size3-a.lbound3+1);
end;

constructor TArray3S.createCopy(a:TArray3S);
begin
   CreateNulCopy(a);
   copyfrom(elements^,size,a.elements^)
end;

constructor TArray3S.CreateConcat(a,b:TArray3S);
begin
   CreateNulCopy(a);
   ConcatArrays(elements^,size,a.elements^,b.elements^)
end;

function TArray3S.NewCopy:TArray3S;
begin
  result:=TArray3S.createCopy(self);
end;

function TArray3S.NulCopy:TArray3S;
begin
    result:=TArray3S.CreateNulCopy(self);
end;

procedure TArray3S.Substring(i,j:integer);
begin
   ArraySubstring(elements^,size,i,j)
end;

procedure TArray3S.SubStringByte(i,j:integer);
begin
   ArraySubstringByte(elements^,size,i,j)
end;

function TArray3S.newcopySubstring(i,j:integer):TArray3S;
begin
  result:=NewCopy;
  result.Substring(i,j);
end;

function TArray3S.newcopySubstringByte(i,j:integer):TArray3S;
begin
  result:=NewCopy;
  result.SubstringByte(i,j);
end;

procedure TArray3S.Subst(a:TArray3S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3) ;
         CopyFrom(elements^,size,a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray3S.SubstSubstring(i,j:integer; a:TArray3S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3) ;
         SubstArraySubstring(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray3S.SubstSubstringByte(i,j:integer; a:TArray3S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3) ;
         SubstArraySubstringByte(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;


class function TArray3S.Concat(a,b:TArray3S):TArray3S; overload;       // a,bを削除する
begin
  try
    if a.size<>b.size then setexception(6101);
    result:=a.NulCopy;
    ConcatArrays(result.elements^,result.size,a.elements^,b.elements^);
  finally
    a.free;
    b.free;
  end;
end;

class function TArray3S.Concat(a:TArray3S; const s:string):TArray3S; overload; // aを削除する
begin
  try
    result:=a.NewCopy;
    RightConcat(result.elements^,result.size,s);
  finally
    a.free;
  end;
end;

class function TArray3S.Concat(const s:String; b:TArray3S):TArray3S; overload; // bを削除する
begin
  try
    result:=b.NewCopy;
    LeftConcat(result.elements^,result.size,s);
  finally
    b.free;
  end;
end;


 procedure TArray4S.init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4);
    if maxsize>0 then
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(AnsiString));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(AnsiString));
    {$ENDIF}
end;

constructor TArray4S.CreateNulCopy(a:TArray4S);
begin
  create(a.lbound1, a.Size1-a.lbound1+1, a.lbound2, a.Size2-a.lbound2+1,
         a.lbound3, a.Size3-a.lbound3+1, a.lbound4, a.size4-a.lbound4+1);
end;

constructor TArray4S.createCopy(a:TArray4S);
begin
   CreateNulCopy(a);
   copyfrom(elements^,size,a.elements^)
end;

constructor TArray4S.CreateConcat(a,b:TArray4S);
begin
   CreateNulCopy(a);
   ConcatArrays(elements^,size,a.elements^,b.elements^)
end;

function TArray4S.NewCopy:TArray4S;
begin
  result:=TArray4S.createCopy(self);
end;

function TArray4S.NulCopy:TArray4S;
begin
    result:=TArray4S.CreateNulCopy(self);
end;

procedure TArray4S.Substring(i,j:integer);
begin
   ArraySubstring(elements^,size,i,j)
end;

procedure TArray4S.SubStringByte(i,j:integer);
begin
   ArraySubstringByte(elements^,size,i,j)
end;

function TArray4S.newcopySubstring(i,j:integer):TArray4S;
begin
  result:=NewCopy;
  result.Substring(i,j);
end;

function TArray4S.newcopySubstringByte(i,j:integer):TArray4S;
begin
  result:=NewCopy;
  result.SubstringByte(i,j);
end;

procedure TArray4S.Subst(a:TArray4S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3, a.size4) ;
         CopyFrom(elements^,size,a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray4S.SubstSubstring(i,j:integer; a:TArray4S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3, a.size4) ;
         SubstArraySubstring(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;

procedure TArray4S.SubstSubstringByte(i,j:integer; a:TArray4S);
begin
  try
    if Maxsize>=a.size then
       begin
         resize(a.size1, a.size2, a.size3, a.size4) ;
         SubstArraySubstringByte(elements^,size,i,j, a.elements^)
       end
    else
      setexception(5001)
  finally
    a.free
  end;
end;


class function TArray4S.Concat(a,b:TArray4S):TArray4S; overload;       // a,bを削除する
begin
  try
    if a.size<>b.size then setexception(6101);
    result:=a.NulCopy;
    ConcatArrays(result.elements^,result.size,a.elements^,b.elements^);
  finally
    a.free;
    b.free;
  end;
end;

class function TArray4S.Concat(a:TArray4S; const s:string):TArray4S; overload; // aを削除する
begin
  try
    result:=a.NewCopy;
    RightConcat(result.elements^,result.size,s);
  finally
    a.free;
  end;
end;

class function TArray4S.Concat(const s:String; b:TArray4S):TArray4S; overload; // bを削除する
begin
  try
    result:=b.NewCopy;
    LeftConcat(result.elements^,result.size,s);
  finally
    b.free;
  end;
end;

function ConCatArray(const s:string; b:TArray1S):TArray1S;overload;
begin
  result:=TArray1S.Concat(s,b)
end;
function ConCatArray(a:TArray1S; const s:string):TArray1S;overload;
begin
  result:=TArray1S.Concat(a,s)
end;
function ConCatArray(a,b:TArray1S):TArray1S;overload;
begin
  result:=TArray1S.Concat(a,b)
end;


function ConCatArray(const s:string; b:TArray2S):TArray2S;overload;
begin
  result:=TArray2S.Concat(s,b)
end;
function ConCatArray(a:TArray2S; const s:string):TArray2S;overload;
begin
  result:=TArray2S.Concat(a,s)
end;
function ConCatArray(a,b:TArray2S):TArray2S;overload;
begin
  result:=TArray2S.Concat(a,b)
end;


function ConCatArray(const s:string; b:TArray3S):TArray3S;overload;
begin
  result:=TArray3S.Concat(s,b)
end;
function ConCatArray(a:TArray3S; const s:string):TArray3S;overload;
begin
  result:=TArray3S.Concat(a,s)
end;
function ConCatArray(a,b:TArray3S):TArray3S;overload;
begin
  result:=TArray3S.Concat(a,b)
end;




{*******}
{MAT I/O}
{*******}

procedure TArray1N.MatPrint(ch:tTextDevice; direction:integer);
var
   i:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
        if direction<>0 then ch.NewZone;
        ch.AppendStrV2(elements^[i])
     end;
   ch.newline;
   ch.newline;
end;

procedure TArray2N.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
          if direction<>0 then ch.NewZone;
          ch.AppendStrV2(elements^[i*size2 + j])
         end;
       ch.newline;
     end;
   ch.newline
end;

procedure TArray3N.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                if direction<>0 then ch.NewZone;
                ch.AppendStrV2(elements^[(i*size2 + j)*size3 + k])
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

procedure TArray4N.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k,l:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                  for l:=0 to size4-1 do
                  begin
                    if direction<>0 then ch.NewZone;
                    ch.AppendStrV2(elements^[((i*size2 + j)*size3 + k)*size4+l])
                  end;
                ch.newline;
              end;
           ch.newline;
         end;
       ch.newline;
     end;
end;


procedure TArray1S.MatPrint(ch:tTextDevice; direction:integer);
var
   i:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
        if direction<>0 then ch.NewZone;
        ch.AppendStrV2(elements^[i])
     end;
   ch.newline;
   ch.newline;
end;

procedure TArray2S.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
          if direction<>0 then ch.NewZone;
          ch.AppendStrV2(elements^[i*size2 + j])
         end;
       ch.newline;
     end;
   ch.newline
end;

procedure TArray3S.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                if direction<>0 then ch.NewZone;
                ch.AppendStrV2(elements^[(i*size2 + j)*size3 + k])
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

procedure TArray4S.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k,l:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                for l:=0 to size4 -1  do
                   begin
                      if direction<>0 then ch.NewZone;
                      ch.AppendStrV2(elements^[((i*size2 + j)*size3 + k)*size4+l])
                   end;
                ch.newline;
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;


procedure TArray1N.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size1 -1 do
     begin
        if i>0 then
           ch.WriteSeparator(false);
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray2N.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size2=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray3N.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size3=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray4N.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size4=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;


procedure TArray1S.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size1 -1 do
     begin
        if i>0 then
           ch.WriteSeparator(false);
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray2S.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size2=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray3S.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size3=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;

procedure TArray4S.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size4=0));  //2025.05.29
        ch.AppendStrV2(elements^[i])
     end;
end;




procedure TArray1N.Read(list:TStringList;var p:Integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=StrToFloat(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray2N.Read(list:TStringList;var p:Integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=StrToFloat(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray3N.Read(list:TStringList;var p:Integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=StrToFloat(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray4N.Read(list:TStringList;var p:Integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=StrToFloat(list.Strings[p]);
      inc(p)
    end;
end;


function TArray1N.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray2N.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray3N.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray4N.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;


function TArray1N.InputDirective:string;
begin
    result:=StringOfChar('n',size1);
end;

function TArray2N.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2);
end;

function TArray3N.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2*Size3);
end;

function TArray4N.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2*Size3*size4);
end;


function TArray1S.kindlist:ansistring;
begin
  result:=StringOfChar('s',size);
end;

function TArray2S.kindlist:ansistring;
begin
  result:=StringOfChar('s',size);
end;

function TArray3S.kindlist:ansistring;
begin
  result:=StringOfChar('s',size);
end;

function TArray4S.kindlist:ansistring;
begin
  result:=StringOfChar('s',size);
end;

function TArray1S.InputDirective:string;
begin
    result:=StringOfChar('s',size1);
end;

function TArray2S.InputDirective:string;
begin
    result:=StringOfChar('s',size1*Size2);
end;

function TArray3S.InputDirective:string;
begin
    result:=StringOfChar('s',size1*Size2*Size3);
end;

function TArray4S.InputDirective:string;
begin
    result:=StringOfChar('s',size1*Size2*Size3*Size4);
end;

procedure TArray1S.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=list.Strings[p];
      inc(p)
    end;
end;

procedure TArray2S.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=list.Strings[p];
      inc(p)
    end;
end;

procedure TArray3S.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=list.Strings[p];
      inc(p)
    end;
end;

procedure TArray4S.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=list.Strings[p];
      inc(p)
    end;
end;


procedure TArray1S.AssignVarilen(list:TstringList);
var
  i:NativeInt;
begin
  ReSize(list.count);
  with list do
    for i:=0 to Count-1 do
      elements^[i]:=Strings[i];
end;

procedure TArray1N.AssignVarilen(list:TstringList);
var
  i:NativeInt;
begin
  ReSize(list.count);
  with list do
    for i:=0 to Count-1 do
      elements^[i]:=StrToFloat(Strings[i]);
end;

procedure TArray1N.LetWithTrace(ch:tTextDevice; name: ansistring; index1:double; value: double);
begin
   elements^[index(index1)]:=value;
   if ch<>nil then
      ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(index1))+')=',
                                                         value, TNewLine.create]);
end;

procedure TArray2N.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2:double; value: double);
begin
   elements^[index(index1,index2)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(index1))+ ','+
                                            Format17(SysIntRound(index2))+ ')=',
                                                         value, TNewLine.create]);
end;

procedure TArray3N.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3:double; value: double);
begin
   elements^[index(index1,index2,index3)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(index1))+ ','+
                                            Format17(SysIntRound(index2))+ ','+
                                            Format17(SysIntRound(index3))+ ')=',
                                                         value, TNewLine.create]);
end;

procedure TArray4N.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3,index4:double; value: double);
begin
   elements^[index(index1,index2,index3,index4)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(index1))+ ','+
                                            Format17(SysIntRound(index2))+ ','+
                                            Format17(SysIntRound(index3))+ ','+
                                            Format17(SysIntRound(index4))+ ')=',
                                                         value, TNewLine.create]);
end;

{**********}
{ DOT & DET}
{**********}

function dot(a,b:TArray1N):double;
var
   i:NativeInt;
begin
   if a.size1<>b.size1 then setexception(6001);
   result:=0;
   try
     for i:=0 to a.size-1 do
       result:=result+a.elements^[i]*b.elements^[i]
   except
      on EOverFlow do
      begin
      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
         raise EExtype.create(1009)
      end;
   end;
end;

function DET(a:TArray2N):double;
begin
   a.Determinant(result)
end;

{**************}
{INVERSE MATRIX}
{**************}


procedure matinv(size:NativeInt; p:PExtendedArray;  pv:PIntArray; var det:extended);
{$MAXFPUREGISTERS 0}
  function a(i,j:NativeInt):PExtended;
  begin
     result:=@p^[i+j*size]
  end;
var
  i,j,k,tmp:NativeInt;
  t,u,temp:extended;
  eps:double;
label
  EXIT;
begin
  eps:=1; FEPS(eps); eps:=eps/2;
  for k:=0 to size-1 do pv^[k]:=k;
  det:=1;
  for k:=0 to size-1 do
     begin
        i:=k;
        while  (i<size) and (a(i,k)^=0.0) do inc(i);
        if i=size then
           begin det:=0.0; goto EXIT end
        else if i<>k then
           begin
              tmp:=pv^[i]; pv^[i]:=pv^[k]; pv^[k]:=tmp;
              for j:=0 to size-1 do
                  begin  temp:=a(i,j)^; a(i,j)^:=a(k,j)^; a(k,j)^:=temp end;
              det:=-det;
           end;

        t:=a(k,k)^;
        det:=det*t;
        for i:=0 to size-1 do
            a(k,i)^:=a(k,i)^/t;
        a(k,k)^:=1.0/t;
        for j:=0 to size-1 do
          if j<>k then
           begin
            u:=a(j,k)^;
            for i:=0 to k-1 do
                 begin
                   a(j,i)^:=a(j,i)^-a(k,i)^*u;
                 end;
            a(j,k)^:=-u/t;
            for i:=k+1 to size-1 do
                 begin
                   temp:=a(j,i)^-a(k,i)^*u;
                   if abs(temp)<abs(a(j,i)^)*EPS then temp:=0;
                   a(j,i)^:=temp;
                 end
           end;
     end;
  EXIT:
end;

procedure TArray2N.determinant(var n:double);
{$MAXFPUREGISTERS 0}
var
  i,j:NativeInt;
  det:extended;
  a:PExtendedArray;
  pv:PIntArray;
begin
  if size1=size2 then
    begin
      getmem(pv,size1*sizeof(NativeInt));
      getmem(a,size1*size2*sizeof(extended));
         try
            for i:=0 to size1-1 do
              for j:=0 to size2-1 do
                a^[i+j*size1]:=elements^[i*size2+j];
            matinv(size1,a,pv,det);
            n:=det;
         finally
            freemem(a,size1*size2*sizeof(extended));
            freemem(pv,size1*sizeof(NativeInt));
         end
    end
  else
     setexception(6002);
end;

function TArray2N.inverse:TArray2N;
var
  i,j:NativeInt;
  det:extended;
  p:PExtendedArray;
  pv:PIntArray;
begin
   result:=nil;
   if size1=size2 then
   begin
     getmem(pv,size1*sizeof(NativeInt)+size1*size2*sizeof(extended));
     try
        try
            p:=@pv^[size1];
            for i:=0 to size1-1 do
              for j:=0 to size2-1 do
                p^[i+j*size1]:=elements^[i*size2+j];
            matinv(size1,p,pv,det);
            if det=0 then
               setexception(3009)
            else
              begin
                result:=NewCopy;
                if result=nil then
                   setexception(ArraySizeOverflow)
                else
                begin
                  try
                    for i:=0 to size1-1 do
                      for j:=0 to size2-1 do
                        result.elements^[i*size2+pv[j]]:=p^[i+j*size1];
                  except
                    on EMathError do
                       begin
                      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                       end;
                    on EDivByZero do
                       begin
                      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                       end;
                  end;
                end;
              end;
        finally
            freemem(pv,size1*sizeof(NativeInt)+size1*size2*sizeof(extended));
        end
     except
           result.free;
           result:=nil;
           raise;
     end;
   end
  else
     setexception(6003);
end;

{********************}
{Writeto and ReadFrom}
{********************}

procedure TArray1N.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PDoubleArray(p)^[i]:=elements^[i];
end;

procedure TArray1N.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PDoubleArray(p)^[i];
end;


procedure TArray2N.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PDoubleArray(p)^[i]:=elements^[i];
end;

procedure TArray2N.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PDoubleArray(p)^[i];
end;


procedure TArray3N.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PDoubleArray(p)^[i]:=elements^[i];
end;

procedure TArray3N.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PDoubleArray(p)^[i];
end;


procedure TArray4N.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PDoubleArray(p)^[i]:=elements^[i];
end;

procedure TArray4N.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PDoubleArray(p)^[i];
end;


procedure TArray1S.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PStringArray(p)^[i]:=elements^[i];
end;

procedure TArray1S.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PStringArray(p)^[i];
end;


procedure TArray2S.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PStringArray(p)^[i]:=elements^[i];
end;

procedure TArray2S.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PStringArray(p)^[i];
end;


procedure TArray3S.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PStringArray(p)^[i]:=elements^[i];
end;

procedure TArray3S.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PStringArray(p)^[i];
end;


procedure TArray4S.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PStringArray(p)^[i]:=elements^[i];
end;

procedure TArray4S.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PStringArray(p)^[i];
end;

{*****************}
{Matrix operations}
{*****************}

function matrixIDN(a:TArray2N): TArray2N;   //aをIDNにする
begin
  result:=a;
  result.idn;
end;

function matrixIDN(a:TArray2N; x:double): TArray2N;
var
  i:integer;
begin
  i:=System.Round(x);
  result:=a;
  with result do
    begin
      if maxsize=0 then
         dim(1,i,1,i)
      else
         resize(i);
      idn;
    end;
end;

function matrixTRN(a,b:TArray2N): TArray2N;
begin
  result:=a;
  result.trn(b);
end;

function matrixTRN(a:TArray2N; b:TArray1N): TArray2N;
begin
  result:=a;
  result.trn(b);
end;

function matrixINV(a,b:TArray2N):Tarray2N;
begin
  result:=a;
  result.INV(b);
end;

function matrixCNJ(a,b:TArray1N):Tarray1N;
begin
  result:=a;
  result.subst(b);
end;

function matrixCNJ(a,b:TArray2N):Tarray2N;
begin
  result:=a;
  result.subst(b);
end;

function matrixCNJ(a,b:TArray3N):Tarray3N;
begin
  result:=a;
  result.subst(b);
end;

function matrixCNJ(a,b:TArray4N):Tarray4N;
begin
  result:=a;
  result.subst(b);
end;

function matrixPOWER(a,b:TArray2N; x:double):Tarray2N;
begin
  result:=a;
  result.power(b,x);
end;

function matrixScalar(a:TArray1N; x:double; b:TArray1N):Tarray1N;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray2N; x:double; b:TArray2N):Tarray2N;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray3N; x:double; b:TArray3N):Tarray3N;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray4N; x:double; b:TArray4N):Tarray4N;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixProd(a,b:TArray1N; c:TArray2N):Tarray1N;
begin
  result:=a;
  result.prod(b,c);
end;

function matrixProd(a,b,c:TArray2N):Tarray2N;
begin
  result:=a;
  result.prod(b,c);
end;

function matrixAdd(a,b,c:TArray1N):Tarray1N;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray1N):Tarray1N;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray2N):Tarray2N;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray2N):Tarray2N;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray3N):Tarray3N;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray3N):Tarray3N;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray4N):Tarray4N;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray4N):Tarray4N;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixInit(a:TArray1N; b:array of double): TArray1N;
var
  i:integer;
begin
 result:=a;
 with result do
   for i:=0 to size1-1 do
     begin
       elements^[i]:=b[i]
     end;
end;

function matrixRow1(a:TArray1N;b:TArray2N; i:double):Tarray1N;
begin
  result:=a;
  result.row(b,System.Round(i));
end;

function matrixColumn1(a:TArray1N;b:TArray2N; i:double):Tarray1N;
begin
  result:=a;
  result.Column(b,System.Round(i));
end;

function matrixRow2(a:TArray2N; b:TArray2N; i,j:double):Tarray2N;
begin
  result:=a;
  result.row(b,System.Round(i),System.Round(j));
end;

function matrixColumn2(a:TArray2N; b:TArray2N; i,j:double):Tarray2N;
begin
  result:=a;
  result.Column(b,System.Round(i),System.Round(j));
end;

end.

