// 07/10/2021: Remaniement de la classe TMatriceCreuse
unit unitMatricesCreusesArray2D;
{$NOTE This unit is very suitable for usual speleological networks, but requires much memory for huge systems (over 3000 nodes)}
{$INCLUDE CompilationParameters.inc}
{$IFDEF USE_METHODE_GRADIENT_CONJUGUE}
  {$ERROR Cette unité doit être utilisée uniquement en mode Array2D}
{$ELSE USE_METHODE_GRADIENT_CONJUGUE}
  {$NOTE Uniquement pour la factorisation de Cholesky}
{$ENDIF USE_METHODE_GRADIENT_CONJUGUE}


interface
uses
  StructuresDonnees, GHTopoGeneralFunctions, unitDatesUtils, unitGHTopoViseesUtils,  unitColorsUtils, unitSolveEquationsPolynomes,  Classes, SysUtils, Math, // anciennement Include   
  Graphics
  ;
type TGHTopoFloat = type single;

type

{ TRowOfMatrix }

 TRowOfMatrix = record
  private
    FValues: array of TGHTopoFloat;
  public
    procedure Redim(const N: integer);
    function  getNbElements(): integer;
    procedure setValue(const Idx: integer; const V: TGHTopoFloat);
    function  getValue(const Idx: integer): TGHTopoFloat;
end;

type

{ TMatriceCreuse }

 TMatriceCreuse = class
   private
     FMatrixName  : string;
     FRowsOfMatrix: array of TRowOfMatrix;
     FMaxRow: integer;
     FMaxCol: integer;
     FLowIndexes  : array of Integer;              // tableau des premiers index de valeurs non nulles
     FHighIndexes : array of Integer;
   public
     function  Initialiser(const NbRows, NbCols: integer; const Name: string): boolean;
     procedure Finaliser();

     property  MaxRow: integer read FMaxRow;
     property  MaxCol: integer read FMaxCol;

     procedure SetValeur(const I, J: integer; const V: TGHTopoFloat); inline;
     function  GetValeur(const I, J: integer): TGHTopoFloat; inline;
     // idx des éléments non nuls
     function  getIdxMinOfRow(const I: integer): integer;
     function  getIdxMaxOfRow(const I: integer): integer;

     procedure RecenserLowIndexes();
     procedure RecenserHighIndexes();
     procedure RemoveAllZeroes();
     // affichage de la matrice sous forme de texte
     procedure Lister();
     // affichage de la matrice sous forme d'image
     procedure CreerRepresentationMatriceEnImage(const QFileName: string);

     function  getNbLignes(): integer;
     function  getNbColonnes(): integer;
  end;

implementation

{ TRowOfMatrix }

procedure TRowOfMatrix.Redim(const N: integer);
var
  i: Integer;
begin
  SetLength(FValues, N);
  if (n > 0) then for i := Low(FValues) to High(FValues) do FValues[i] := 0.00;
end;

function TRowOfMatrix.getNbElements: integer;
begin
  result := length(FValues);
end;

procedure TRowOfMatrix.setValue(const Idx: integer; const V: TGHTopoFloat);
begin
  FValues[Idx] := V;
end;

function TRowOfMatrix.getValue(const Idx: integer): TGHTopoFloat;
begin
  Result := FValues[Idx];
end;
//******************************************************************************




function TMatriceCreuse.GetValeur(const I, J: integer): TGHTopoFloat;
begin
  result := FRowsOfMatrix[i].getValue(j);
 end;

function TMatriceCreuse.getIdxMinOfRow(const I: integer): integer;
begin
  result := FLowIndexes[I];
end;

function TMatriceCreuse.getIdxMaxOfRow(const I: integer): integer;
begin
  result := FHighIndexes[I];
end;

procedure TMatriceCreuse.SetValeur(const I, J: integer; const V: TGHTopoFloat);
begin
  FRowsOfMatrix[i].setValue(j, V);
end;


function TMatriceCreuse.Initialiser(const NbRows, NbCols: integer; const Name: string): boolean;
var
  i: Integer;
begin
  result := false;
  FMatrixName := Name;
  AfficherMsgErrClass(self, 'Initialiser: %s (%d, %d)', [FMatrixName, NbRows, NbCols]);
  try
    SetLength(FRowsOfMatrix, 1 + NbRows);
    for i := 0 to High(FRowsOfMatrix) do FRowsOfMatrix[i].Redim(1 + NbCols);
    SetLength(FLowIndexes, 0);
    SetLength(FLowIndexes, 1 + NbRows);
    SetLength(FHighIndexes, 0);
    SetLength(FHighIndexes, 1 + NbRows);
    FMaxRow := NbRows;
    FMaxCol := NbCols;
    Result := true;
  except
  end;
end;
procedure TMatriceCreuse.Finaliser();
var
  i: Integer;
begin
  AfficherMsgErrClass(self, 'Finaliser(%s)', [FMatrixName]);
  for i := 0 to High(FRowsOfMatrix) do FRowsOfMatrix[i].Redim(0);
  SetLength(FRowsOfMatrix, 0);
  SetLength(FLowIndexes , 0);
  SetLength(FHighIndexes, 0);
end;

procedure TMatriceCreuse.RecenserLowIndexes();
var
  i, j: Integer;
begin
  for i:=1 to FMaxRow do
  begin
    for j:=1 to FMaxCol do
    begin
      if (Abs(self.GetValeur(i, j)) > 0) then
      begin
        FLowIndexes[i] := j;
        Break;
      end;
    end;
  end;
end;
procedure TMatriceCreuse.RecenserHighIndexes();
var
  i, j: Integer;
begin
  for i:= 1 to FMaxRow do
  begin
    for j:= FMaxCol downto 1 do
    begin
      if (Abs(self.GetValeur(i, j)) > 0) then
      begin
        FHighIndexes[i] := j;
        Break;
      end;
    end;
  end;
end;

procedure TMatriceCreuse.RemoveAllZeroes();
begin
  pass; // sans objet ici - Pour unification avec le LOL et le LOT
end;
procedure TMatriceCreuse.Lister();
var
  i, j, m, n: Integer;
  EWE: String;
  R: Double;
begin
  m := FMaxRow;
  n := FMaxCol;
  //if (m > 100) then Exit;
  AfficherMsgErrClass(self, 'Lister(): Matrice: %s (%dx%d)', [FMatrixName, m, n]);
  for i := 1 to m do
  begin
    EWE := Format('Row %d; ', [i]);
    for j := 1 to n do EWE += Format('%f; ', [GetValeur(i, j)]);
    AfficherMessageErreur(EWE);
  end;
end;

procedure TMatriceCreuse.CreerRepresentationMatriceEnImage(const QFileName: string);
var
  BMP: TBitmap;
  i, j, m, n: Integer;
  EWE: Double;
  LinePtr: PByteArray;
begin
  m := FMaxRow;
  n := FMaxCol;
  AfficherMessageErreur('%s.CreerRepresentationMatriceEnImage(%s) (%dx%d)', [ClassName, QFileName, m, n]);
  BMP := TBitmap.Create;
  try
    BMP.PixelFormat := pf24bit;
    BMP.Width  := 1 + n + 1;
    BMP.Height := 1 + m + 1;

    // remplir en aqua
    BMP.Canvas.Brush.Color := clAqua;
    BMP.Canvas.FillRect(0, 0, BMP.Width, BMP.Height);

    for i := 1 to m do
    begin
      LinePtr := BMP.ScanLine[i]; // ligne Y = i
      for j := 1 to n do
      begin
        EWE := Self.GetValeur(i, j);
        if not IsZero(EWE) then
        begin
          // position du pixel j (x) dans la ligne
          // chaque pixel = 3 octets (BGR)
          if (EWE > 0) then
          begin
            LinePtr^[3 * j + 0] := 0;     // B
            LinePtr^[3 * j + 1] := 0;     // G
            LinePtr^[3 * j + 2] := 255;   // R -> rouge
          end
          else
          begin
            LinePtr^[3 * j + 0] := 255;   // B
            LinePtr^[3 * j + 1] := 0;     // G -> vert
            LinePtr^[3 * j + 2] := 0;     // R
          end;
        end;
      end;
    end;

    BMP.SaveToFile(QFileName);
  finally
    FreeAndNil(BMP);
  end;
end;

function TMatriceCreuse.getNbLignes: integer;
begin
  Result := length(self.FRowsOfMatrix);
end;

function TMatriceCreuse.getNbColonnes: integer;
begin
  Result := self.FRowsOfMatrix[0].getNbElements();
end;

end.