unit arraysd;
{$MODE DELPHI}{$H+}

interface

uses
  Classes, SysUtils,
  base, base2,arithmet, mathd, arrays, textfile;

type
    TNumberArray=array [0..1023] of Number;
    PNumberArray=^TNumberArray;
type
   TArray2d=class;

      TArray1d=Class(TArray1)
         elements:PNumberArray;
         procedure subst(a:TArray1d);overload;
         procedure subst(a:TArray2d);overload;
         procedure trn(a:TArray2d);overload;
         procedure add(a,b:TArray1d);
         procedure sub(a,b:TArray1d);
         procedure prod(a:TArray1d; b:TArray2d); overload;
         procedure prod(a:TArray2d; b:TArray1d); overload;
         procedure scalar(x:double; a:TArray1d); overload;
         procedure scalar(x:Number; a:TArray1d); overload;
         procedure con;overload;
         procedure con(x:double);overload;
         procedure con(x:Number);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:Number);overload;
         procedure CROSS(a,b:TArray1d);
         procedure row(a:TArray2d;n:integer);overload;
         procedure column(a:TArray2d;n:integer);overload;
         procedure row(a:TArray2d;n:Double); overload;
         procedure column(a:TArray2d;n:Double); overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray1d;
         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:Number; value: Number);
         function Array1N:TArray1N;
         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);

        private
         procedure init(lb1,ub1:NativeInt);override;
         constructor createCopy(a:TArray1d);
         procedure CROSSsub(a,b:TArray1d);
       end;

      TArray2d=Class(TArray2)
         elements:PNumberArray;
         procedure subst(a:TArray2d);
         procedure add(a,b:TArray2d);
         procedure sub(a,b:TArray2d);
         procedure prod(a:TArray2d; b:TArray2d);
         procedure INV(a:TArray2d);
         procedure TRN(a:TArray1d); overload;
         procedure TRN(a:TArray2d); overload;
         procedure scalar(x:double;a:TArray2d); overload;
         procedure scalar(x:Number;a:TArray2d); overload;
         procedure power(a:Tarray2d; x:double); overload;
         procedure power(a:Tarray2d; n:Number); overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:Number);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:Number);overload;
         procedure IDN;          overload;
         procedure IDN(x:double);overload;
         procedure IDN(x:Number);overload;
         procedure row(a:TArray2d;m,n:integer); overload;
         procedure column(a:TArray2d;m,n:integer); overload;
         procedure SubstRow1(n:integer; a:TArray1d);overload;
         procedure SubstRow2(m,n:integer; a:TArray2d);overload;
         procedure SubstColumn1(n:integer; a:TArray1d); overload;
         procedure SubstColumn2(m,n:integer; a:TArray2d);overload;
         procedure row(a:TArray2d;m,n:Double); overload;
         procedure column(a:TArray2d;m,n:Double); overload;
         procedure SubstRow1(n:Double; a:TArray1d);overload;
         procedure SubstRow2(m,n:Double; a:TArray2d);overload;
         procedure SubstColumn1(n:Double; a:TArray1d); overload;
         procedure SubstColumn2(m,n:Double; a:TArray2d);overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray2d;
         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:Number; value: Number);
         function Array2N:TArray2N;
         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);
        private
         procedure init(lb1,ub1,lb2,ub2:NativeInt);override;
         constructor createCopy(a:TArray2d);
         procedure prodsub(a:TArray2d; b:TArray2d);
         procedure TRNSub(a:TArray2d);
         procedure determinant(var n:Number);
         function inverse:TArray2d;
       end;

      TArray3d=Class(TArray3)
         elements:PNumberArray;
         procedure subst(a:TArray3d);
         procedure add(a,b:TArray3d);
         procedure sub(a,b:TArray3d);
         procedure scalar(x:double;a:TArray3d);overload;
         procedure scalar(x:Number;a:TArray3d);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:Number);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:Number);overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray3d;
         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:Number; value: Number);

         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:TArray3d);

       end;

      TArray4d=Class(TArray4)
         elements:PNumberArray;
         procedure subst(a:TArray4d);
         procedure add(a,b:TArray4d);
         procedure sub(a,b:TArray4d);
         procedure scalar(x:double; a:TArray4d);overload;
         procedure scalar(x:Number;a:TArray4d);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:Number);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:Number);overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray4d;
         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:Number; value: Number);
         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:TArray4d);

       end;




   function dot(a,b:TArray1d):Number; overload;
   function DET(a:TArray2d):Number;   overload;

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

   function matrixIDN(a:TArray2d): TArray2d; overload;
   function matrixIDN(a:TArray2d; x:double): TArray2d; overload;
   function matrixTRN(a,b:TArray2d): TArray2d; overload;
   function matrixTRN(a:TArray2d; b:TArray1d): TArray2d; overload;
   function matrixINV(a,b:TArray2d):TArray2d;overload;
   function matrixCNJ(a,b:TArray1d):TArray1d;overload;
   function matrixCNJ(a,b:TArray2d):TArray2d;overload;
   function matrixCNJ(a,b:TArray3d):TArray3d;overload;
   function matrixCNJ(a,b:TArray4d):TArray4d;overload;
   function matrixPOWER(a,b:TArray2d; x:double):TArray2d; overload;
   function matrixScalar(a:TArray1d; x:double; b:TArray1d):TArray1d;overload;
   function matrixScalar(a:TArray2d; x:double; b:TArray2d):TArray2d;overload;
   function matrixScalar(a:TArray3d; x:double; b:TArray3d):TArray3d;overload;
   function matrixScalar(a:TArray4d; x:double; b:TArray4d):TArray4d;overload;
   function matrixProd(a,b:TArray1d; c:TArray2d):TArray1d;overload;
   function matrixProd(a,b,c:TArray2d):TArray2d;overload;
   function matrixAdd(a,b,c:TArray1d):TArray1d;overload;
   function matrixSbt(a,b,c:TArray1d):TArray1d;overload;
   function matrixAdd(a,b,c:TArray2d):TArray2d;overload;
   function matrixSbt(a,b,c:TArray2d):TArray2d;overload;
   function matrixAdd(a,b,c:TArray3d):TArray3d;overload;
   function matrixSbt(a,b,c:TArray3d):TArray3d;overload;
   function matrixAdd(a,b,c:TArray4d):TArray4d;overload;
   function matrixSbt(a,b,c:TArray4d):TArray4d;overload;
   function matrixInit(a:TArray1d; args:array of const): TArray1d;overload;
   function matrixRow1(a:TArray1d;b:TArray2d; i:double):Tarray1d;
   function matrixColumn1(a:TArray1d;b:TArray2d; i:double):Tarray1d;
   function matrixRow2(a:TArray2d; b:TArray2d; i,j:double):Tarray2d;
   function matrixColumn2(a:TArray2d; b:TArray2d; i,j:double):Tarray2d;


implementation
uses baslibc;

procedure TArray1d.init(lb1,ub1:NativeInt);
begin
    init0(lb1,ub1);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Number));
    zer;     //2024.02.02
end;

destructor TArray1d.destroy;
begin
  if elements<>nil then
     FreeMem(Elements,Maxsize*SizeOf(Number));
  inherited destroy;
end;


constructor TArray1d.createCopy(a:TArray1d);
var
  i:NativeInt;
begin
   TArray.create;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Maxsize:=Size1;
   if maxsize>0 then
       begin
         Elements:=AllocMem(Maxsize*SizeOf(Number));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

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


procedure TArray2d.init(lb1,ub1,lb2,ub2:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Number));
    zer;     //2024.02.02
end;

destructor TArray2d.destroy;
begin
   if elements<>nil then
      FreeMem(Elements,Maxsize*SizeOf(Number));
   inherited destroy;
end;

constructor TArray2d.createCopy(a:TArray2d);
var
i:NativeInt;
begin
   TArray.create;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Maxsize:=Size1*size2;
   if maxsize>0 then
       begin
         Elements:=AllocMem(Maxsize*SizeOf(Number));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

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

procedure TArray3d.init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2,lb3,ub3);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Number));
    zer;     //2024.02.02
end;

destructor TArray3d.destroy;
begin
   if elements<>nil then
      FreeMem(Elements,Maxsize*SizeOf(Number));
   inherited destroy;
end;
 constructor TArray3d.createCopy(a:TArray3d);
var
  i:NativeInt;
begin
   TArray.create;
   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
         Elements:=AllocMem(Maxsize*SizeOf(Number));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

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





 procedure TArray4d.init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
 begin
     init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4);
     if maxsize>0 then
        Elements:=AllocMem(Maxsize*SizeOf(Number));
     zer;     //2024.02.02
 end;

 destructor TArray4d.destroy;
 begin
   if elements<>nil then
      FreeMem(Elements,Maxsize*SizeOf(Number));
   inherited destroy;
 end;

 constructor TArray4d.createCopy(a:TArray4d);
 var
   i:NativeInt;
 begin
    TArray.create;
    Lbound1:=a.Lbound1;
    Size1:=a.Size1;
    Lbound2:=a.Lbound2;
    Size2:=a.Size2;
    Lbound3:=a.Lbound3;
    Size3:=a.Size3;
    Lbound4:=a.Lbound3;
    Size4:=a.Size4;
    Maxsize:=Size1*size2*size3*size4;
    if maxsize>0 then
        begin
          Elements:=AllocMem(Maxsize*SizeOf(Number));
          for i:=0 to maxsize-1 do
              elements^[i]:=a.elements^[i];
        end;
 end;

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


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

procedure TArray1d.subst(a:TArray1d);
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 TArray1d.subst(a:TArray2d);
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 TArray1d.trn(a:TArray2d);           //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 TArray1d.add(a,b:TArray1d);
var
   c:TArray1d;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray1d.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 TArray1d.sub(a,b:TArray1d);
var
   c:TArray1d;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray1d.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 TArray1d.prod(a:TArray1d; b:TArray2d); overload;
var
   i,j:NativeInt;
   c:TArray1d;
begin
   if a.size1<>b.size1 then setexception(6001);
   if MaxSize=0 then
      dim(b.lbound2,b.lbound2+b.size2-1);
   //if maxsize<b.size2 then setexception(5001);
   c:=TArray1d.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 TArray1d.prod(a:TArray2d; b:TArray1d); overload;
var
   i,j:NativeInt;
   c:TArray1d;
begin
   if a.size2<>b.size1 then setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1);
   //if maxsize<a.size1 then setexception(5001);
   c:=TArray1d.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 TArray1d.scalar(x:double; a:TArray1d);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

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

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

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

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

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

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

procedure TArray1d.zer(x:Number);overload;
begin
   zer
end;

procedure TArray1d.CROSSsub(a,b:TArray1d);
var
   i:NativeInt;
   x,y:Number;
begin
   for i:=0 to 2 do
     begin
       elements^[i mod 3]:=zero^;
       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 TArray1d.CROSS(a,b:TArray1d);
var
  c:TArray1d;
begin
   if (a.size<3) or (b.size<3) then setexception(6001);
   if MaxSize<3 then setexception(5001);
   c:=TArray1d.create(1,3);
   try
     c.CrossSub(a,b);
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray1d.row(a:TArray2d;n:integer);
var
  i:integer;
  x:Number;
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 TArray1d.column(a:TArray2d;n:integer);
var
  i:integer;
  x:Number;
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 TArray1d.row(a:TArray2d; n:double);
begin
     row(a, System.Round(n))
end;

procedure TArray1d.column(a:TArray2d; n:double);
begin
    column(a, System.Round(n))
end;


{********}
{TArray2d}
{********}


procedure TArray2d.subst(a:TArray2d);
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 TArray2d.add(a,b:TArray2d);
var
   c:TArray2d;
   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:=TArray2d.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 TArray2d.sub(a,b:TArray2d);
var
   c:TArray2d;
   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:=TArray2d.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 TArray2d.ProdSub(a:TArray2d; b:TArray2d);
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 TArray2d.prod(a:TArray2d; b:TArray2d);
var
  c:TArray2d;
  //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);
   c:=TArray2d.create(1, a.size1, 1, b.size2);
   try
     c.ProdSub(a,b);
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray2d.INV(a:TArray2d);
var
   c:TArray2d;
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 TArray2d.TRNSub(a:TArray2d);
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 TArray2d.TRN(a:TArray2d);
var
   c:TArray2d;
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:=TArray2d.create(1, a.Size2, 1, a.size1);
   c.TRNSub(a);
   subst(c)
end;

procedure TArray2d.TRN(a:TArray1d);       //2025/10/04 //ver.1.2.2.4
var
   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 TArray2d.scalar(x:double; a:TArray2d);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

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

procedure TArray2d.power(a:Tarray2d; x:double);
var
  a1:TArray2d;
  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:=TArray2d.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 TArray2d.power(a:Tarray2d; n:Number);
begin
  power(a,extendedVal(n));
end;


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

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

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

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

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

procedure TArray2d.zer(x:Number);overload;
begin
   zer
end;


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

procedure TArray2d.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 TArray2d.IDN(x:Number);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 TArray2d.row(a:TArray2d; m,n:integer);
var
  i,j:integer;
  x:Number;
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 TArray2d.column(a:TArray2d; m,n:integer);
var
  i,j:integer;
  x:Number;
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 TArray2d.SubstRow1(n:integer; a:TArray1d);
var
  i:integer;
  x:Number;
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 TArray2d.SubstColumn1(n:integer; a:TArray1d);
var
  i:integer;
  x:Number;
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 TArray2d.SubstRow2(m,n:integer; a:TArray2d);
var
  i,j,k,m0,n0:integer;
  x:Number;
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 TArray2d.SubstColumn2(m,n:integer; a:TArray2d);
var
  i,j,k,m0,n0:integer;
  c:TArray2d;
  x:Number;
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:=TArray2d.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 TArray2d.row(a:TArray2d;m,n:Double);
begin
  row(a,System.Round(m),System.Round(n))
end;

procedure TArray2d.column(a:TArray2d;m,n:Double);
begin
  column(a,System.Round(m),System.Round(n))
end;

procedure TArray2d.SubstRow1(n:Double; a:TArray1d);
begin
   SubstRow1(System.Round(n), a)
end;

procedure TArray2d.SubstRow2(m,n:Double; a:TArray2d);
begin
   SubstRow2(System.Round(m),System.Round(n), a)
end;

procedure TArray2d.SubstColumn1(n:Double; a:TArray1d);
begin
   SubstColumn1(System.Round(n), a)
end;

procedure TArray2d.SubstColumn2(m,n:Double; a:TArray2d);
begin
   SubstColumn2(System.Round(m),System.Round(n), a)
end;



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

procedure TArray3d.subst(a:TArray3d);
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 TArray3d.add(a,b:TArray3d);
var
   c:TArray3d;
   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:=TArray3d.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 TArray3d.sub(a,b:TArray3d);
var
   c:TArray3d;
   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:=TArray3d.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 TArray3d.scalar(x:double; a:TArray3d);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

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

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

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

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

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

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

procedure TArray3d.zer(x:Number);overload;
begin
   zer
end;



procedure TArray4d.subst(a:TArray4d);
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 TArray4d.add(a,b:TArray4d);
var
   c:TArray4d;
   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:=TArray4d.create(1, a.size1, 1, a.size2, 1, a.size3, 1, a.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 TArray4d.sub(a,b:TArray4d);
var
   c:TArray4d;
   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:=TArray4d.create(1, a.size1, 1, a.size2, 1, a.size3, 1, a.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 TArray4d.scalar(x:double; a:TArray4d);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

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

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

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

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

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

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

procedure TArray4d.zer(x:Number);overload;
begin
   zer
end;

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

procedure TArray1d.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(DStr(elements^[i])+' ')
     end;
   ch.newline;
   ch.newline;
end;

procedure TArray2d.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(DStr(elements^[i*size2 + j])+' ')
         end;
       ch.newline;
     end;
   ch.newline
end;

procedure TArray3d.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(DStr(elements^[(i*size2 + j)*size3 + k ])+' ')
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

procedure TArray4d.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(DStr(elements^[((i*size2 + j)*size3 + k)*size4 +l ])+' ')
                  end;
                ch.newline;
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

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

procedure TArray2d.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(DStr(elements^[i]))
     end;
end;

procedure TArray3d.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(DStr(elements^[i]))
     end;
end;

procedure TArray4d.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(DStr(elements^[i]))
     end;
end;

procedure TArray1d.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 TArray2d.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 TArray3d.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 TArray4d.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 TArray1d.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

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

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

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

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

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

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

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

procedure TArray1d.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;

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

function dot(a,b:TArray1d):Number;
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:TArray2d):Number;
begin
   a.Determinant(result)
end;

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


procedure matinv(size:NativeInt; p:PNumberArray;  pv:PIntArray; var det:Number);
{$MAXFPUREGISTERS 0}
  function a(i,j:NativeInt):PNumber;
  begin
     result:=@p^[i+j*size]
  end;
var
  i,j,k,tmp:NativeInt;
  t,u,temp:Number;
  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 mathd.abs(temp)<mathd.abs(a(j,i)^)*EPS then temp:=0;
                   a(j,i)^:=temp;
                 end
           end;
     end;
  EXIT:
end;

procedure TArray2d.determinant(var n:Number);
{$MAXFPUREGISTERS 0}
var
  i,j:NativeInt;
  det:Number;
  a:PNumberArray;
  pv:PIntArray;
begin
  if size1=size2 then
    begin
      getmem(pv,size1*sizeof(NativeInt));
      getmem(a,size1*size2*sizeof(Number));
         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(Number));
            freemem(pv,size1*sizeof(NativeInt));
         end
    end
  else
     setexception(6002);
end;

function TArray2d.inverse:TArray2d;
var
  i,j:NativeInt;
  det:Number;
  p:PNumberArray;
  pv:PIntArray;
begin
   result:=nil;
   if size1=size2 then
   begin
     getmem(pv,size1*sizeof(NativeInt)+size1*size2*sizeof(Number));
     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(Number));
        end
     except
           result.free;
           result:=nil;
           raise;
     end;
   end
  else
     setexception(6003);
end;

function TArray1d.Array1N:TArray1N;
var
   i:NativeInt;
begin
   result:=TArray1N.create(Lbound,Ubound);
   try
     for i:=0 to size1 -1 do
       result.elements^[i]:=(elements^[i]);
   except
     result.free;
     result:=nil;
     raise;
   end;
end;

function TArray2d.Array2N:TArray2N;
var
   i:NativeInt;
begin
   result:=TArray2N.create(Lbound(1),Ubound(1), Lbound(2), Ubound(2));
   try
     for i:=0 to size - 1 do
       result.elements^[i]:=(elements^[i]);
   except
     result.free;
     result:=nil;
     raise;
   end;
end;

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

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

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

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

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

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

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


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

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


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

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


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

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


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

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

function matrixIDN(a:TArray2d; x:double): TArray2d;
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:TArray2d): TArray2d;
begin
  result:=a;
  result.trn(b);
end;

function matrixTRN(a:TArray2d; b:TArray1d): TArray2d;
begin
  result:=a;
  result.trn(b);
end;


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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




function matrixInit(a:TArray1d; args:array of const): TArray1d;
var
  i:integer;
  x:number;
begin
 result:=a;
 with result do
   for i:=0 to size1-1 do
     begin
       with args[i] do
        case VType of
          vtObject:begin
                     if VObject is TNumber then
                          x:=TNumber(VObject).value;
                      VObject.free
                   end;
        end;
       elements^[i]:=x
     end;
end;

function matrixRow1(a:TArray1d;b:TArray2d; i:double):Tarray1d;
begin
  result:=a;
  result.row(b,System.Round(i));
end;

function matrixColumn1(a:TArray1d;b:TArray2d; i:double):Tarray1d;
begin
  result:=a;
  result.Column(b,System.Round(i));
end;

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

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

end.

