Unit Matrices;

interface

uses Windows,Classes,Forms,Dialogs,SysUtils;

//                Максимально возможный размер для обмана компилятора.
const             MT_MAXDIMENSION = 1024 * 1024;
//                Большой массив. Не создавайте его, пожалуйста :(
type              TDoubleArray = array[0..MT_MAXDIMENSION] of double;
//                И указатель на него. Их можно создавать.
                  PDoubleArray = ^TDoubleArray;
//                Большой массив указателей.
type              TPDoubleArray =array[0..MT_MAXDIMENSION] of PDoubleArray;
//                И указатель на него - как матрица в Це.
                  PPDoubleArray =^TPDoubleArray;
//                Это - вектор.
type
  PVector = ^TVector;
  TVector = object
public
  // Флаг, указывающий на то, что содержимое было модифицировано
  Modified        : Boolean;
  // Количество элементов вектора.
  nSize           : integer;
  // Указатель на массив элементов.
  Elements        : PDoubleArray;
  // Параметры конструктора - количество элементов вектора.
  constructor     Create(Size:integer);
  destructor      Destroy;
  procedure       ReCreate(Size:integer);
  // Функции для доступа к элементам - возвращают числа.
  function        GetElement(i:integer):double;
  procedure       SetElement(i:integer;v:double);
  // Функции для доступа к элементам - возвращают строки.
  function        GetString(i:integer):string;
  procedure       SetString(i:integer;s:string);
  // Дублирование ИЗ. Размеры должны совпадать.
  function        _CopyFrom(var Vec:TVector):Boolean;
  // Обнуление вектора.
  procedure       Zero;
  // Установка элементов вектора из массива.
  function        FromArray(var Arr:array of double):Boolean;
  // Сложение векторов и присваивание результата исходному вектору.
  function        Add(var Vec:TVector):Boolean;
  // Вычитание векторов и присваивание результата исходному вектору.
  function        Sub(var Vec:TVector):Boolean;
  // Получение модуля вектора.
  function        Abs : double;
  // Нормализация вектора.
  function        Normalize:Boolean;
  // Умножение вектора на число совмещенное с присваиванием.
  procedure       ScalarMul(Mul:double);
  // Векторное умножение и помещение результата в исходный вектор.
  procedure       CrossProduct(var V1,V2:TVector);
  // Получение результата скалярного умножения на вектор.
  function        DotProduct(var V:TVector):double;
  // Сравнение двух векторов
  function        Compare(var Vec:TVector):Boolean;
end;

{ ========================================================================
  Для быстрой работы с матрицами, помимо основного массива для данных,
распределяется еще один такой же блок памяти (для быстрого транспонирова-
ния и создания резервных копий) а также память для двух пар векторов -
столбцов, содержащих указатели на строки и столбцы матриц.
P.S. Саму матрицу можно назвать полуматрицей.
======================================================================== }

type              PMatrix=^TMatrix;
                  TMatrix=object
private
  //              Вспомогательные (i.e. основные) адреса данных.
  MemChunk	  : pointer;
  RowStorage      : pointer;
  Rows1,Rows2     : PPDoubleArray;
  Cols1,Cols2     : PPDoubleArray;
public
  // Флаг, указывающий на то, что содержимое было модифицировано
  Modified        : Boolean;
  // Количество строк и столбцов матрицы (меняется при транспонировании)
  nCols, nRows    : integer;
  // Указатель на массив указателей на элементы
  Elements        : PPDoubleArray;
  //              Размер одной целой полуматрицы в байтах.
  MatrixSize      : integer;
  // Параметры конструктора - количество строк и столбцов матрицы
  constructor     Create(Rows,Cols:integer);
  destructor      Destroy;
  procedure       ReCreate(Rows,Cols:integer);
  // =====================================================================
  // Функции для доступа к элементам - возвращают числа.
  function        GetElement(i,j:integer):Double;
  procedure       SetElement(i,j:integer;Element:Double);
  // Функции для доступа к элементам - возвращают строки.
  function        GetString(i,j:integer):string;
  procedure       SetString(i,j:integer;s:string);
  // Дублирование ИЗ. Размеры должны совпадать.
  function        _CopyFrom(var Mat:TMatrix):Boolean;
  // Обнуление матрицы
  procedure       Zero;
  // Установка в единичную матрицу
  procedure       Identity;
  // Выделение подматрицы размеров {Mat.nRows X Mat.nCols}, левый верхний
  // угол которой находится в строке Row и столбце Col исходной матрицы
  function        GetSubMat(var Mat:TMatrix;Row,Col:integer):Boolean;
  // То же, но копирование подматрицы в исходную матрицу.
  function        SetSubMat(var Mat:TMatrix;Row,Col:integer):Boolean;
  // Выделение V.nSize элементов строки в вектор V со столбца Col.
  function        RowToVector(var V:TVector;Row,Col:integer):Boolean;
  // Веделение V.nSize элементов вектора в строку со столбца Col.
  function        VectorToRow(var V:TVector;Row,Col:integer):Boolean;
  // Выделение V.nSize элементов столбца в вектор V со строки Row.
  function        ColToVector(var V:TVector;Row,Col:integer):Boolean;
  // Веделение V.nSize элементов вектора в столбец со строки Row.
  function        VectorToCol(var V:TVector;Row,Col:integer):Boolean;
  // Копирование nCols элементов одномерного массива в строку Row
  function        ArrayToRow(var Arr:array of double;Row:integer):Boolean;
  // Копирование такущей матрицы в теневую (не вызывать Transpose)
  procedure       Duplicate;
  // Восстановление такущей матрицы из теневой (можно вызывать Transpose)
  procedure       Restore;
  // =====================================================================
  // Сложение матриц и присваивание результата исходной матрице.
  function        Add(var Mat:TMatrix):Boolean;
  // Вычитание матриц и присваивание результата исходной матрице.
  function        Sub(var Mat:TMatrix):Boolean;
  // Умножение матрицы на число и присваивание результата исходной матрице.
  procedure       ScalarMul(Mult:double);
  // Умножение матриц и присваивание результата исходной матрице.
  function        Mul(var Mul1,Mul2:TMatrix):Boolean;
  // Умножение слева на вектор и помещение результата в вектор Dst
  function        VectorMul(var Vec,Dst:TVector):Boolean;
  // Транспонирование матрицы. Поля nRows и nCols меняются соответственно.
  // Примечание - теневая матрица портится.
  procedure       Transpose;
  // Сравнение двух матриц
  function        Compare(var Mat:TMatrix):Boolean;
  // =====================================================================
  // Вычисление произведения X = A^-1 * X. Исходная матрица испорчена,
  // результат помещен в вектор X.
  // Внимание !!! Текущая версия этого метода не позволяет достоверно
  // отделить все те случаи, когда исходная система неопределенна или
  // несовместна. Но работеает очень быстро !
  function        Solve(var X: TVector):Boolean;
  // Обращение матрицы. Примечания: см. о предыдущей функции.
  function        Inverse:Boolean;
  // Вычисление определителя по схеме единственного деления.
  // Содержимое исходной матрицы портится.
  function        Determ:Double;
end;

// Два производных класса вводятся в отладочных целях
type
  TConsoleMatrix = object(TMatrix)
    procedure display;
    procedure StreamDisplay(var Stream : TStream);
  end;

type
  TConsoleVector = object(TVector)
    procedure display;
    procedure StreamDisplay(var Stream : TStream);
  end;

// Два производных класса обладают методами ввода-вывода ч/з потоки
const VectorID : array[0..3] of char = 'VTID';
const MatrixID : array[0..3] of char = 'MTID';

type PStreamableVector = ^TStreamableVector;
  TStreamableVector = object(TConsoleVector)
  private
    szName          : array[0..256] of char;
  public
    constructor     Create(Size:integer);
    procedure       SetName(Name:string);
    function        GetName:string;
    procedure       SaveToStream(var Stream : TStream);
    procedure       SaveToStreamAsText(var Stream : TStream);
    procedure       SaveToFile(FileName : string);
    function        LoadFromStream(var Stream : TStream):Boolean;
    function        LoadFromStreamAsText(var Stream : TStream):Boolean;
    function        LoadFromFile(FileName : string):Boolean;
    function        CopyFrom(var Vec:TStreamableVector):Boolean;
  end;

type
  PStreamableMatrix = ^TStreamableMatrix;
  TStreamableMatrix = object(TConsoleMatrix)
  private
    szName          : array[0..256] of char;
  public
    constructor     Create(Rows,Cols:integer);
    procedure       SetName(Name:string);
    function        GetName:string;
    procedure       SaveToStream(var Stream : TStream);
    procedure       SaveToStreamAsText(var Stream : TStream);
    procedure       SaveToFile(FileName : string);
    function        LoadFromStream(var Stream : TStream):Boolean;
    function        LoadFromStreamAsText(var Stream : TStream):Boolean;
    function        LoadFromFile(FileName : string):Boolean;
    function        CopyFrom(var Mat:TStreamableMatrix):Boolean;
  end;

// =======================================================================
procedure ResizeVector(var V:TVector;n:integer);

implementation

uses MiscRoutines;
// =======================================================================
const __8087    : DWORD = $FFFFFFFF;
const _fltused_ : DWORD = $FFFFFFFF;
{$LINK VTVBD.OBJ}
procedure
  mp_vtVecByDouble(Vec,D:pointer;N:integer);Pascal;external;
{$LINK VTVA.OBJ}
procedure
  mp_vtVecAbs(Vec,Abs:pointer;N:integer);Pascal;external;
{$LINK VTDP.OBJ}
procedure
  mp_vtDotProduct(Vec1,Vec2,Prod:pointer;N:integer);Pascal;external;
{$LINK VTCP.OBJ}
procedure
  mp_vtCrossProduct(Vec1,Vec2,Dst:pointer);Pascal;external;
{$LINK VTN.OBJ}
function
  mp_vtVectorNormalize(Vec:pointer;N:integer):integer;Pascal;external;
{$LINK MTMV.OBJ}
procedure
  mp_mtMatVec(Rows,Vec,Dst:pointer;R,C:integer);Pascal;external;
{$LINK MTMD.OBJ}
procedure
  mp_mtMatDouble(Rows:pointer;D:pointer;R,C:integer);Pascal;external;
{$LINK MTMM.OBJ}
procedure
  mp_mtMatMat(Rows1,Rows2,RowsD:pointer;M,N,P:integer);Pascal;external;
{$LINK MTS.OBJ}
function
  mp_mtMatSolve(Rows,B:pointer;N:integer):integer;Pascal;external;
{$LINK MTI.OBJ}
function
  mp_mtMatInverse(RowsS,RowsD:pointer;N:integer):integer;Pascal;external;
{$LINK MTD.OBJ}
procedure
  mp_mtMatDeterm(RowsS,Res:pointer;N:integer);Pascal;external;
// =======================================================================

constructor TVector.Create;
begin
  Modified:=False;
  Elements := nil;
  nSize:=Size;
  if(Size<=0) then exit;
  GetMem(pointer(Elements),nSize*sizeof(double));
end;

constructor TStreamableVector.Create;
begin
  SetName('');
  TVector.Create(Size);
end;

destructor TVector.Destroy;
begin
  if(Elements<>nil) then
  begin
    FreeMem(pointer(Elements));
    Elements:=nil;
    nSize:=0;
  end;
end;

procedure TVector.ReCreate;
begin
  Destroy;
  Create(Size);
end;

function TVector.GetElement;
begin
  GetElement:=Elements^[i];
end;

procedure TVector.SetElement;
begin
  Elements^[i]:=v;
end;

function TVector.GetString;
begin
  GetString:=Format('%.4g',[Elements^[i]]);
end;

procedure TVector.SetString;
begin
  Elements^[i]:=StrToFloat(s);
end;

function TVector._CopyFrom;
begin
  Result:=False;
  if(Vec.nSize<>nSize) then exit;
  memCopyMemory(Elements,Vec.Elements,nSize*sizeof(double));
  Result:=True;
end;

function TStreamableVector.CopyFrom;
begin
  Result:=False;
  if(Vec.nSize<>nSize) then exit;
  memCopyMemory(Elements,Vec.Elements,nSize*sizeof(double));
  StrCopy(szName,Vec.szName);
  Result:=True;
end;

procedure TVector.Zero;
{var
  i : integer;}
begin
  memZeroMemory(Elements,nSize*sizeof(double));
{  for i:=0 to nSize-1 do
    Elements^[i]:=0.0;}
end;

function TVector.FromArray;
var
  i : integer;
begin
  Result:=False;
  if((Low(Arr)<>0)or(High(Arr)<>(nSize-1))) then exit;
  for i:=0 to nSize-1 do
    Elements^[i]:=Arr[i];
  Result:=True;
end;

function TVector.Add;
var
  i : integer;
begin
  Result:=False;
  if(Vec.nSize<>nSize) then exit;
  for i:=0 to nSize-1 do
    Elements^[i]:=Elements^[i]+Vec.Elements^[i];
  Result:=True;
end;

function TVector.Sub;
var
  i : integer;
begin
  Result:=False;
  if(Vec.nSize<>nSize) then exit;
  for i:=0 to nSize-1 do
    Elements^[i]:=Elements^[i]-Vec.Elements^[i];
  Result:=True;
end;

function TVector.Abs;
{var
  i : integer;
  s : double;}
begin
//  Abs := Sqrt(DotProduct(Self)); // редкая для Паскаля красота !
{  s := 0.0;
  for i:=0 to nSize-1 do
    s := s + Elements^[i]*Elements^[i];
  Abs := sqrt(s);}
  mp_vtVecAbs(Elements,@Result,nSize);
end;

function TVector.Normalize;
{var
  i : integer;
  m : double;}
begin
{  m := Abs;
  if(m=0.0) then exit;
  m := 1/m;
  vtVecByDouble(Elements,@m,nSize);
  for i:=0 to nSize-1 do
    Elements^[i]:=Elements^[i]/m;}
  if(mp_vtVectorNormalize(Elements,nSize)=0) then
    Result:=False
  else
    Result:=True;
end;

procedure TVector.ScalarMul;
{var
  i : integer;}
begin
  mp_vtVecByDouble(Elements,@Mul,nSize);
{  for i:=0 to nSize-1 do
    Elements^[i]:=Elements^[i]*Mul;}
end;

procedure TVector.CrossProduct;
begin
  if((V1.nSize=3)and(V2.nSize=3)and(nsize=3)) then
{  begin
    Elements^[0]:=
      V1.Elements^[1]*V2.Elements^[2]-V1.Elements^[2]*V2.Elements^[1];
    Elements^[1]:=
      V1.Elements^[2]*V2.Elements^[0]-V1.Elements^[0]*V2.Elements^[2];
    Elements^[2]:=
      V1.Elements^[0]*V2.Elements^[1]-V1.Elements^[1]*V2.Elements^[0];
  end;}
  mp_vtCrossProduct(V1.Elements,V2.Elements,Elements);
end;

function TVector.DotProduct;
{var
  i : integer;
  s : double;}
begin
//  DotProduct := 0;
  if(V.nSize<>nSize) then exit;
{  s := 0.0;
  for i:=0 to nSize-1 do
    s := s + Elements^[i]*V.Elements^[i];
  DotProduct := s;}
  mp_vtDotProduct(Elements,V.Elements,@Result,nSize);
end;

function TVector.Compare;
begin
  Result:=False;
  if(Vec.nSize<>nSize) then exit;
  Result:=memCompareMemory(Vec.Elements,Elements,nSize*sizeof(double));
end;

// =======================================================================
constructor TMatrix.Create;
var
  i, vsize, cksize	: integer;
begin
  Modified:=False;
  MemChunk:=nil;
  Rows1:=nil;
  Rows2:=nil;
  Cols1:=nil;
  Cols2:=nil;
  RowStorage:=nil;
  Elements := nil;
  nCols:=Cols;
  nRows:=Rows;
  if((Cols<=0)or(Rows<=0)) then exit;
  vsize := (nCols + nRows) * sizeof(PDouble);
  MatrixSize := nCols * nRows * sizeof(double);
  // Займемся ручным распределением памяти ! :)
  // Удвоенный размер матрицы
  cksize := MatrixSize * 2;
  // плюс удвоенный размер вектора - столбца указателей
  cksize := cksize + vsize * 2;
  // плюс размер буфера указателей для процедуры решения системы
  if(nCols>nRows) then
    GetMem(MemChunk,cksize+nCols*sizeof(PDouble))
  else
    GetMem(MemChunk,cksize+nRows*sizeof(PDouble));
  Rows1 := PPDoubleArray(DWORD(MemChunk) + cksize - 2 * vsize);
  Cols1 := PPDoubleArray(DWORD(Rows1) + nRows * sizeof(PDouble));
  Rows2 := PPDoubleArray(DWORD(Rows1) + vsize);
  Cols2 := PPDoubleArray(DWORD(Rows2) + nRows * sizeof(PDouble));
  // Первая пара векторов - столбцов содержит указатели на элементы,
  // сгруппированные по строкам
  Rows1^[0] := PDoubleArray(MemChunk);
  Rows2^[0] := PDoubleArray(DWORD(MemChunk)+nCols*nRows*sizeof(double));
  for i:=1 to nRows-1 do
  begin
    Rows1^[i] :=
      PDoubleArray(DWORD(Rows1^[i-1]) + nCols*sizeof(double));
    Rows2^[i] :=
      PDoubleArray(DWORD(Rows2^[i-1]) + nCols*sizeof(double));
  end;
  // Вторая пара векторов - столбцов содержит указатели на элементы,
  // сгруппированные по столбцам
  Cols1^[0] := Rows1^[0];
  Cols2^[0] := Rows2^[0];
  for i:=1 to nCols-1 do
  begin
    Cols1^[i] :=
      PDoubleArray(DWORD(Cols1^[i-1]) + nRows * sizeof(Double));
    Cols2^[i] :=
      PDoubleArray(DWORD(Cols2^[i-1]) + nRows * sizeof(Double));
  end;
  Elements := Rows1;
  RowStorage := pointer(DWORD(MemChunk) + cksize);
end;

constructor TStreamableMatrix.Create;
begin
  SetName('');
  TMatrix.Create(Rows,Cols);
end;

destructor TMatrix.Destroy;
begin
  if(MemChunk<>nil) then
  begin
    FreeMem(MemChunk);
    MemChunk:=nil;
  end;
  Rows1:=nil;
  Rows2:=nil;
  Cols1:=nil;
  Cols2:=nil;
  Elements:=nil;
  RowStorage:=nil;
  nCols:=0;
  nRows:=0;
end;

procedure TMatrix.ReCreate;
begin
  Destroy;
  Create(Rows,Cols);
end;

function TMatrix.GetElement(i,j:integer):Double;
begin
  Result:=Elements^[i]^[j];
end;

procedure TMatrix.SetElement(i,j:integer;Element:Double);
begin
  Elements^[i]^[j]:=Element;
end;

function TMatrix.GetString;
begin
  Result:=Format('%.5g',[Elements^[i]^[j]]);
end;

procedure TMatrix.SetString;
begin
  Elements^[i]^[j]:=StrToFloat(s);
end;

function TMatrix._CopyFrom;
begin
  Result:=False;
  if((Mat.nCols<>nCols)or(Mat.nRows<>nRows)) then exit;
  memCopyMemory(Elements^[0],Mat.Elements^[0],MatrixSize);
  Result:=True;
end;

function TStreamableMatrix.CopyFrom;
begin
  Result:=False;
  if((Mat.nCols<>nCols)or(Mat.nRows<>nRows)) then exit;
  memCopyMemory(Elements^[0],Mat.Elements^[0],MatrixSize);
  StrCopy(szName,Mat.szName);
  Result:=True;
end;

function TMatrix.GetSubMat(var Mat:TMatrix;Row,Col:integer):Boolean;
var
  i,j : integer;
begin
  Result:=False;
  if((Col<0)or((Col+Mat.nCols)>nCols)or
     (Row<0)or((Row+Mat.nRows)>nRows)) then exit;
  for i:=0 to Mat.nRows-1 do
    for j:=0 to Mat.nCols-1 do
      Mat.Elements^[i]^[j]:=Elements^[i+Row]^[j+Col];
  Result:=True;
end;

function TMatrix.SetSubMat(var Mat:TMatrix;Row,Col:integer):Boolean;
var
  i,j : integer;
begin
  Result:=False;
  if((Col<0)or((Col+Mat.nCols)>nCols)or
     (Row<0)or((Row+Mat.nRows)>nRows)) then exit;
  for i:=0 to Mat.nRows-1 do
    for j:=0 to Mat.nCols-1 do
      Elements^[i+Row]^[j+Col]:=Mat.Elements^[i]^[j];
  Result:=True;
end;

function TMatrix.RowToVector;
var i : integer;
begin
  Result:=False;
  if((Row<0)or(Col<0)or(Row>=nRows)or((V.nSize+Col)>nCols)) then exit;
  for i:=0 to V.nSize-1 do
    V.Elements^[i]:=Elements^[Row]^[Col+i];
  Result:=True;
end;

function TMatrix.VectorToRow;
var i : integer;
begin
  Result:=False;
  if((Row<0)or(Col<0)or(Row>=nRows)or((V.nSize+Col)>nCols)) then exit;
  for i:=0 to V.nSize-1 do
    Elements^[Row]^[Col+i]:=V.Elements^[i];
  Result:=True;
end;

function TMatrix.ColToVector;
var i : integer;
begin
  Result:=False;
  if((Row<0)or(Col<0)or(Col>=nCols)or((V.nSize+Row)>nRows)) then exit;
  for i:=0 to V.nSize-1 do
    V.Elements^[i]:=Elements^[Row+i]^[Col];
  Result:=True;
end;

function TMatrix.VectorToCol;
var i : integer;
begin
  Result:=False;
  if((Row<0)or(Col<0)or(Col>=nCols)or((V.nSize+Row)>nRows)) then exit;
  for i:=0 to V.nSize-1 do
    Elements^[Row+i]^[Col]:=V.Elements^[i];
  Result:=True;
end;

function TMatrix.ArrayToRow;
var
  i : integer;
begin
  Result:=False;
  if((Row<0)or(Row>=nRows)or(High(Arr)<>(nCols-1))) then exit;
  for i:=0 to nCols-1 do
    Elements^[Row]^[i]:=Arr[i];
  Result:=True;
end;

function TMatrix.Compare;
begin
  Result:=False;
  if((Mat.nCols<>nCols)or(Mat.nRows<>nRows)) then exit;
  Result:=memCompareMemory(Mat.Elements^[0],Elements^[0],MatrixSize);
end;

procedure TMatrix.Duplicate;
begin
  if((Elements=Rows1)or(Elements=Cols1)) then
    memCopyMemory(pointer(DWORD(MemChunk)+DWORD(MatrixSize)),
      MemChunk,
      MatrixSize)
  else
    memCopyMemory(MemChunk,
      pointer(DWORD(MemChunk)+DWORD(MatrixSize)),
      MatrixSize);
end;

procedure TMatrix.Restore;
begin
  if((Elements=Rows1)or(Elements=Cols1)) then
    memCopyMemory(MemChunk,
      pointer(DWORD(MemChunk)+DWORD(MatrixSize)),
      MatrixSize)
  else
    memCopyMemory(pointer(DWORD(MemChunk)+DWORD(MatrixSize)),
      MemChunk,
      MatrixSize);
end;

function TMatrix.Add;
var i,j : integer;
begin
  Result:=False;
  if((Mat.nCols<>nCols) or (Mat.nRows<>nRows)) then exit;
  for i:=0 to nRows-1 do
    for j:=0 to nRows-1 do
      Elements^[i]^[j]:=Elements^[i]^[j]+Mat.Elements^[i]^[j];
  Result:=True;
end;

function TMatrix.Sub;
var i,j : integer;
begin
  Result:=False;
  if((Mat.nCols<>nCols) or (Mat.nRows<>nRows)) then exit;
  for i:=0 to nRows-1 do
    for j:=0 to nRows-1 do
      Elements^[i]^[j]:=Elements^[i]^[j]-Mat.Elements^[i]^[j];
  Result:=True;
end;

procedure TMatrix.ScalarMul;
{var
  i,j : integer;}
begin
  mp_mtMatDouble(Elements,@Mult,nRows,nCols);
{  for i:=0 to nRows-1 do
    vtVecByDouble(Elements^[i],mult,nCols);
    for j:=0 to nRows-1 do
      Elements^[i]^[j]:=Elements^[i]^[j]*mult;}
end;

function TMatrix.Mul;
{var
  i,j,k : integer;
  s : double;}
begin
  Result:=False;
  if((nRows<>Mul1.nRows)or(Mul1.nCols<>Mul2.nRows)or(Mul2.nCols<>nCols))
    then exit;
{  for i:=0 to nRows-1 do
    for j:=0 to nCols-1 do
    begin
      s := 0.0;
      for k:=0 to Mul1.nCols-1 do
        s := s + Mul1.Elements^[i]^[k]*Mul2.Elements^[k]^[j];
      Elements^[i]^[j]:=s;
    end;}
  mp_mtMatMat(Mul1.Elements,Mul2.Elements,Elements,
    nRows,Mul1.nCols,nCols);
  Result:=True;
end;

function TMatrix.VectorMul(var Vec,Dst:TVector):Boolean;
{var
  i,k : integer;
  s : double;}
begin
  Result:=False;
  if(Vec.nSize<>nCols) then exit;
{  for i:=0 to nRows do
  begin
    s:=0.0;
    for k:=0 to nCols do
      s:=s+Elements^[i]^[k]*Vec.Elements^[k];
    Dst.Elements^[i]:=s;
  end;}
  mp_mtMatVec(Elements,Vec.Elements,Dst.Elements,nRows,nCols);
  Result:=True;
end;

procedure TMatrix.Transpose;
var
  i,j : integer;
begin
  if Elements = Rows1 then
  begin
    for j:=0 to nRows-1 do
      for i:=0 to nCols-1 do
        Cols2^[i]^[j] := Rows1^[j]^[i];
    Elements := Cols2;
  end
  else
    if Elements = Cols2 then
    begin
      for j:=0 to nRows-1 do
        for i:=0 to nCols-1 do
          Rows1^[i]^[j] := Cols2^[j]^[i];
      Elements := Rows1;
    end
    else
      if Elements = Rows2 then
      begin
        for j:=0 to nRows-1 do
          for i:=0 to nCols-1 do
            Cols1^[i]^[j] := Rows2^[j]^[i];
        Elements := Cols1;
      end
      else
//        if Elements = Cols1 then
        begin
          for j:=0 to nRows-1 do
            for i:=0 to nCols-1 do
              Rows2^[i]^[j] := Cols1^[j]^[i];
          Elements := Rows2;
        end;
  i:=nCols;
  nCols:=nRows;
  nRows:=i;
end;

procedure TMatrix.Zero;
{var
  i, j : integer;}
begin
{  for i:=0 to nRows-1 do
    for j:=0 to nCols-1 do
      Elements^[i]^[j]:=0;}
  memZeroMemory(Elements^[0],MatrixSize);
end;

procedure TMatrix.Identity;
var
  i,l : integer;
begin
  memZeroMemory(Elements^[0],MatrixSize);
  if(nCols>nRows) then l:=nRows-1 else l:=nCols-1;
  for i:=0 to l do
    Elements^[i]^[i]:=1;
end;

function TMatrix.Solve(var X: TVector):Boolean;
begin
  Result:=False;
  if(X.nSize<>nRows) then exit;
  memCopyMemory(RowStorage,Elements,nRows*sizeof(PDouble));
  try
    mp_mtMatSolve(RowStorage,X.Elements,nRows);
  except
    on EMathError do exit;
  end;
  Result:=True;
end;

function TMatrix.Inverse;
var
  m: TMatrix;
  i,j : integer;
begin
  Result:=False;
  if(nCols<>nRows) then exit;
  m.Create(nCols,nCols);
  m.Identity;
  memCopyMemory(RowStorage,Elements,nRows*sizeof(PDouble));
  try
    mp_mtMatInverse(RowStorage,m.Elements,nRows);
  except
    on EMathError do
    begin
      m.Destroy;
      exit;
    end;
  end;
  Result:=True;
  for i:=0 to nCols-1 do
    for j:=0 to nCols-1 do
    begin
      Elements^[i]^[j]:=m.Elements^[i]^[j];
    end;
end;

function TMatrix.Determ;
begin
  if(nCols<>nRows) then exit;
  memCopyMemory(RowStorage,Elements,nRows*sizeof(PDouble));
  try
    mp_mtMatDeterm(RowStorage,@Result,nCols);
  except
    on EMathError do Result:=0;
  end;
end;

// =======================================================================

procedure TConsoleVector.Display;
var
  i : integer;
begin
  for i:=0 to nSize-1 do
    write(GetString(i),#9);
  writeln;
  writeln;
end;

procedure TConsoleVector.StreamDisplay;
var
  i : integer;
begin
  for i:=0 to nSize-1 do
    fPrint(Stream,GetString(i)+#9);
  fPrint(Stream,#13);
end;

procedure TConsoleMatrix.Display;
var
  i,j : integer;
begin
  for i:=0 to nRows-1 do
  begin
    for j:=0 to nCols-1 do
      write(GetString(i,j),#9);
    writeln;
  end;
  writeln;
end;

procedure TConsoleMatrix.StreamDisplay;
var
  i,j : integer;
begin
  for i:=0 to nRows-1 do
  begin
    for j:=0 to nCols-1 do
      fPrint(Stream,GetString(i,j)+#9);
    fPrint(Stream,#13);
  end;
end;

// =======================================================================

procedure TStreamableVector.SetName;
begin
  StrLCopy(szName,PChar(Name),sizeof(szName)-1);
end;

function TStreamableVector.GetName;
begin
  Result:=string(szName);
end;

procedure TStreamableVector.SaveToStream;
var
  l : integer;
begin
  l := StrLen(szName);
  Stream.WriteBuffer(VectorID,sizeof(MatrixID));
  Stream.WriteBuffer(l,sizeof(l));
  Stream.WriteBuffer(szName,l);
  Stream.WriteBuffer(nSize,sizeof(nSize));
  Stream.WriteBuffer(Elements^,nSize*sizeof(double));
end;

function TStreamableVector.LoadFromStream;
var
  l : integer;
  c : char;
  s : integer;
begin
  Result:=False;
  for l:=0 to 3 do
  begin
    Stream.ReadBuffer(c,sizeof(c));
    if(c<>VectorID[l]) then exit;
  end;
  Stream.ReadBuffer(l,sizeof(l));
  if(l>254) then l:=254;
  Stream.ReadBuffer(szName,l);
  szName[l+1]:=#0;
  Stream.ReadBuffer(s,sizeof(s));
  if((s<=0)or(s>MT_MAXDIMENSION)) then exit;
  Recreate(s);
  Stream.ReadBuffer(Elements^,nSize*sizeof(double));
end;

procedure TStreamableVector.SaveToFile;
var
  F       : TextFile;
  i       : integer;
{  Resp    : integer;
  FSD     : TSaveDialog;}
begin
{  if(FileExists(FileName)) then
  begin
    Resp:=AskYNC('Файл "'+ExtractFileName(FileName)+'" уже существует.'+#13+
      'Заместить существующий файл - ?');
    if(Resp=idCancel) then Exit;
    if(Resp=idNo) then
    begin
      Application.CreateForm(TSaveDialog,FSD);
      FSD.DefaultExt:='*.txt';
      FSD.Filter:=
        'Текст в кодировке Windows (*.txt)|*.txt|'+
        'Текст в кодировке MS-DOS (*.txt)|*.txt|'+
        'Все файлы (*.*)|*.*';
      FSD.FilterIndex:=1;
      FSD.InitialDir:='.';
      FSD.Title:='Сохранение текстового описания';
      FSD.Options:=[ofOverwritePrompt, ofHideReadOnly];
      if(not FSD.Execute) then exit;
      AssignFile(F,FSD.FileName);
    end
    else // if resp == idyes
      AssignFile(F,FileName);
  end
  else // if file_not_exist(filename)}
    AssignFile(F,FileName);
  Rewrite(F);
  writeln(F,'Vector "',GetName,'"',' ',nSize);
  for i:=0 to nSize-1 do
    write(F,GetString(i),#9);
  writeln(F);
  CloseFile(F);
end;

procedure TStreamableVector.SaveToStreamAsText;
var
  i : integer;
  crlf : string;
begin
  crlf := #13+#10;
  fPrint(Stream,
    'Vector "'+GetName+'" '+IntToStr(nSize)+crlf);
  for i:=0 to nSize-1 do
    fPrint(Stream,GetString(i)+#9);
  fPrint(Stream,crlf);
end;

function TStreamableVector.LoadFromStreamAsText;
var
  st,name : string;
  i,s     : integer;
  count   : integer;
begin
  Result:=False;
  st:=fSmartScan(Stream);
  if(st<>'Vector') then exit;
  name:=fSmartScan(Stream);
  s := StrToInt(fSmartScan(Stream));
  if((s<=0)or(s>=MT_MAXDIMENSION)) then exit;
  Recreate(s);
  SetName(Name);
  count := 0;
  try
    for i:=0 to nSize-1 do
    begin
      st:=fSmartScan(Stream);
      if(Stream.Position>=Stream.Size) then break;
      SetString(i,st);
      count:=count+1;
    end;
  except
    on EConvertError do
    begin
      Recreate(0);
    end;
  end;
  if(count=(nSize)) then
    Result:=True
  else
    Result:=False;
end;

function TStreamableVector.LoadFromFile;
var
  S       : TFileStream;
begin
  Result:=False;
  try
    S := TFileStream.Create(FileName,fmOpenRead);
    Result := LoadFromStreamAsText(TStream(S));
    S.Destroy;
  except
    on EFOpenError do
      MessageBox(GetActiveWindow(),
        PChar('Невозможно загрузить файл "'+FileName+'"'+#13+
        'Вероятно, файл не существует'),
        'TStreamableVector.LoadFromFile',MB_OK or MB_ICONHAND);
  end;
end;

procedure TStreamableMatrix.SetName;
begin
  StrLCopy(szName,PChar(Name),sizeof(szName)-1);
end;

function TStreamableMatrix.GetName;
begin
  Result:=string(szName);
end;

procedure TStreamableMatrix.SaveToStream;
var
  l : integer;
begin
  l:=StrLen(szName);
  if(l>254) then l:=254;
  Stream.WriteBuffer(MatrixID,sizeof(MatrixID));
  Stream.WriteBuffer(l,sizeof(l));
  Stream.WriteBuffer(szName,l);
  Assert((nRows>0)and(nCols>0)
    and(nRows<MT_MAXDIMENSION)and(nCols<MT_MAXDIMENSION));
  Stream.WriteBuffer(nRows,sizeof(nRows));
  Stream.WriteBuffer(nCols,sizeof(nCols));
  Stream.WriteBuffer(Elements^[0]^,MatrixSize);
end;

function TStreamableMatrix.LoadFromStream;
var
  l : integer;
  c : char;
  w,h : integer;
begin
  Result:=False;
  for l:=0 to 3 do
  begin
    Stream.ReadBuffer(c,sizeof(c));
    if(c<>MatrixID[l]) then exit;
  end;
  Stream.ReadBuffer(l,sizeof(l));
  Assert((l>=0)and(l<=254));
  if(l>0) then Stream.ReadBuffer(szName,l);
  szName[l]:=#0;
  Stream.ReadBuffer(h,sizeof(h));
  Stream.ReadBuffer(w,sizeof(w));
  Assert((w>0)and(h>0)and(w<MT_MAXDIMENSION)and(h<MT_MAXDIMENSION));
  Recreate(h,w);
  Stream.ReadBuffer(Elements^[0]^,MatrixSize);
end;

procedure TStreamableMatrix.SaveToFile;
var
  F       : TextFile;
  i,j     : integer;
{  Resp    : integer;
  FSD     : TSaveDialog;}
begin
{  if(FileExists(FileName)) then
  begin
    Resp:=AskYNC('Файл "'+ExtractFileName(FileName)+'" уже существует.'+#13+
      'Заместить существующий файл - ?');
    if(Resp=idCancel) then Exit;
    if(Resp=idNo) then
    begin
      Application.CreateForm(TSaveDialog,FSD);
      FSD.DefaultExt:='*.txt';
      FSD.Filter:=
        'Текст в кодировке Windows (*.txt)|*.txt|'+
        'Текст в кодировке MS-DOS (*.txt)|*.txt|'+
        'Все файлы (*.*)|*.*';
      FSD.FilterIndex:=1;
      FSD.InitialDir:='.';
      FSD.Title:='Сохранение текстового описания';
      FSD.Options:=[ofOverwritePrompt,ofHideReadOnly];
      if(not FSD.Execute) then exit;
      AssignFile(F,FSD.FileName);
    end
    else // if resp == idyes
      AssignFile(F,FileName);
  end
  else // if file_not_exist(filename)}
    AssignFile(F,FileName);
  Rewrite(F);
  writeln(F,'Matrix "',GetName,'"',' ',nRows,' ',nCols);
  for i:=0 to nRows-1 do
  begin
    for j:=0 to nCols-1 do
      write(F,GetString(i,j),#9);
    writeln(F);
  end;
  writeln(F);
  CloseFile(F);
end;

procedure TStreamableMatrix.SaveToStreamAsText;
var
  i,j : integer;
  crlf : string;
begin
  crlf := #13+#10;
  fPrint(Stream,
    'Matrix "'+GetName+'" '+IntToStr(nRows)+' '+IntToStr(nCols)+crlf);
  for i:=0 to nRows-1 do
  begin
    for j:=0 to nCols-1 do
      fPrint(Stream,GetString(i,j)+#9);
    fPrint(Stream,crlf);
  end;
  fPrint(Stream,crlf);
end;

function TStreamableMatrix.LoadFromStreamAsText;
var
  st,name : string;
  i,j,r,c : integer;
  count   : integer;
begin
  Result:=False;
  st:=fSmartScan(Stream);
  if(st<>'Matrix') then exit;
  name:=fSmartScan(Stream);
  r := StrToInt(fSmartScan(Stream));
  c := StrToInt(fSmartScan(Stream));
  if((r>=MT_MAXDIMENSION)or(c>=MT_MAXDIMENSION)or(r<0)or(c<0)) then exit;
  Recreate(r,c);
  SetName(Name);
  count:=0;
  try
    for i:=0 to nRows-1 do
      for j:=0 to nCols-1 do
      begin
        st:=fSmartScan(Stream);
        if(Stream.Position>=Stream.Size) then break;
        SetString(i,j,st);
        count:=count+1;
      end;
  except
    on EConvertError do
    begin
      Recreate(0,0);
      exit;
    end;
  end;
  if(count=(nCols*nRows)) then
    Result:=True
  else
    Result:=False;
end;

function TStreamableMatrix.LoadFromFile;
var
  S : TFileStream;
begin
  Result:=False;
  try
    S := TFileStream.Create(FileName,fmOpenRead);
    Result := LoadFromStreamAsText(TStream(S));
    S.Destroy;
  except
    on EFOpenError do
      MessageBox(GetActiveWindow(),
        PChar('Невозможно загрузить файл "'+FileName+'"'+#13+
        'Вероятно, файл не существует'),
        'TStreamableMatrix.LoadFromFile',MB_OK or MB_ICONHAND);
  end;
end;

procedure ResizeVector(var V:TVector;n:integer);
var
  tv : TVector;
  i : integer;
  OldSize : integer;
begin
  if(V.nSize>n) then
  begin
    tv.Create(n);
    for i:=0 to n-1 do tv.Elements^[i]:=V.Elements^[i];
    V.Recreate(n);
    V._CopyFrom(tv);
    tv.Destroy;
  end
  else if(V.nSize<n) then
  begin
    tv.Create(V.nSize);
    tv._CopyFrom(V);
    OldSize:=V.nSize;
    V.Recreate(n);
    V.Zero;
    for i:=0 to OldSize-1 do V.Elements^[i]:=tv.Elements^[i];
    tv.Destroy;
  end;
end;

end.

