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);
      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);
      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:TArray2d);
      procedure scalar(x:double;a:TArray2d); overload;
      procedure scalar(x:Number;a:TArray2d); 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;
      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;



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

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

end;

destructor TArray1d.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
    FreeMem(Elements,Maxsize*SizeOf(Number));
  {$ELSE}
    FreeMemory(Maxsize*SizeOf(Number));
  {$ENDIF}
  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
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Number));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
        {$ENDIF}
         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
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(Number));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
    {$ENDIF}
end;

destructor TArray2d.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
   FreeMem(Elements,Maxsize*SizeOf(Number));
  {$ELSE}
   FreeMemory(Maxsize*SizeOf(Number));
  {$ENDIF}
  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
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Number));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
        {$ENDIF}
         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
    {$IFDEF HeapArrays}
       Elements:=AllocMem(Maxsize*SizeOf(Number));
    {$ELSE}
       Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
    {$ENDIF}
end;

destructor TArray3d.destroy;
begin
  if elements<>nil then
  {$IFDEF HeapArrays}
    FreeMem(Elements,Maxsize*SizeOf(Number));
  {$ELSE}
    FreeMemory(Maxsize*SizeOf(Number));
  {$ENDIF}
  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
        {$IFDEF HeapArrays}
         Elements:=AllocMem(Maxsize*SizeOf(Number));
        {$ELSE}
         Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
        {$ENDIF}
         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
     {$IFDEF HeapArrays}
        Elements:=AllocMem(Maxsize*SizeOf(Number));
     {$ELSE}
        Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
     {$ENDIF}
 end;

 destructor TArray4d.destroy;
 begin
   if elements<>nil then
   {$IFDEF HeapArrays}
     FreeMem(Elements,Maxsize*SizeOf(Number));
   {$ELSE}
     FreeMemory(Maxsize*SizeOf(Number));
   {$ENDIF}
   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
         {$IFDEF HeapArrays}
          Elements:=AllocMem(Maxsize*SizeOf(Number));
         {$ELSE}
          Elements:=GetZeroMemory(Maxsize*SizeOf(Number));
         {$ENDIF}
          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 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 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 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<b.size2 then setexception(5001);
   c:=TArray1d.create(1, b.size2);
   //c.zer;
   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<a.size1 then setexception(5001);
   c:=TArray1d.create(1, a.size1);
   //c.zer;
   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]:=0;
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]:=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 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 TArray2d.subst(a:TArray2d);
var
   i:NativeInt;
begin
   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 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 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 a.Size1 * b.Size2 >MaxSize then
      setexception(5001);
   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
   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
   c:=TArray2d.create(1, a.Size2, 1, a.size1);
   c.TRNSub(a);
   subst(c)
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.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]:=0;
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 TArray3d.subst(a:TArray3d);
var
   i:NativeInt;
begin
   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 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 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]:=0;
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 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 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 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]:=0;
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 size1=0));
        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 size1=0));
        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 size1=0));
        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;


end.

