Discussion :

[JP CASSOU]

Bjr à vous,

Je vous propose ici un conteneur pour matrices creuses de très grande taille telles qu'on les rencontre en spéléologie (si, si: topographie souterraine) ou en calcul des structures.
Il ne stocke que les valeurs non nulles de la matrice.

Mes connaissances maths sont de niveau BTS industriel, après CAP et Bac techno F4: donc un peu faiblard.
En prog, je suis 100% autodidacte.

Ce conteneur a été conçu pour minimiser l'empreinte mémoire du logiciel GHTopo dans le cadre du calcul du canevas topographique dans une carrière souterraine.
http://ghtopo.blog4ever.com


Il a été testé avec succès sur un réseau de 4800 branches et 3900 noeuds, empreinte RAM: 35 Mo.

Ce conteneur sans prétention aucune (de tels conteneurs existent notamment pour implémenter un tableur, mais c'est un excellent exercice), mais faisant le job demandé, est sous licence libre.

Le conteneur utilise les listes génériques dont voici la déclaration de classe, les méthodes parlant d'elles-mêmes.
Dans GHTopo, elles sont dans une unité UnitListesSimplesWithGeneriques.pas, mais elles peuvent être directement incorporées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
type TElementNonNulOfAnRow = record
  IdxColumn  : Integer;
  Valeur     : double;
end;  
 
type
 TListeSimple<T> = class(TFPList)
  private
  public
    procedure ClearListe();
    function  GetNbElements(): integer; inline;
    procedure AddElement(const E: T);  // et Rros Minet
    function  GetElement(const Idx: integer): T; inline;
    procedure PutElement(const Idx: integer; const E: T); inline;
    function  RemoveElement(const Idx: integer): boolean;
end;  
...
procedure TListeSimple<T>.ClearListe;
var
  i, n: Integer;
begin
  //AfficherMessage(Format('%s.ClearListe()', [classname]));
  n := self.Count;
  if (n > 0) then
  for i:=Count-1 downto 0 Do
  begin
    if (self.Items[i] <> Nil) then Dispose(self.Items[i]); // Libération
    self.Delete(i);                                        // Suppression de l'élément
  end;
end;
 
function TListeSimple<T>.GetNbElements: integer;
begin
  Result := self.Count;
end;
 
procedure TListeSimple<T>.AddElement(const E: T);
var pE: ^T;
begin
  New(pE);
  pE^ := E;
  self.Add(pE);
end;
 
function TListeSimple<T>.GetElement(const Idx: integer): T;
begin
  Result := T(Items[Idx]^);
end;
 
 
 
procedure TListeSimple<T>.PutElement(const Idx: integer; const E: T);
begin
  T(Items[Idx]^) := E;
end;
 
function TListeSimple<T>.RemoveElement(const Idx: integer): boolean;
begin
  Result := False;
  try
    Dispose(self.Items[Idx]);
    self.Delete(Idx);
    Result := True;
  except
  end;
end;

Unité du conteneur:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
 
unit unitMatricesCreuses_LOL;
// Stockage de matrices creuses sous forme de listes de listes (LOL)
{$INCLUDE CompilationParameters.inc}
 
interface
// Tests effectués:
// TArrayList: Fonctionne mais est 2x plus lent que TList
// TVector   : Fonctionne mais légèrement plus lent que TList
// Utilisation de TList.Capacity: Aucun gain de temps
 
 
uses
  Common, // pour AfficherMessage() et AfficherMessageErreur()
  Classes, SysUtils, math,
  Graphics,
  UnitListesSimplesWithGeneriques // inutile si on incorpore le TListeSimple<T> ci-dessus
  ;
 
// Liste des valeurs non-nulles d'une ligne
type
 
{ TListeNonZerosOfRow }
 
 TListeNonZerosOfRow = class(TListeSimple<TElementNonNulOfAnRow>)
  strict private // indique que ce qui suit n'est pas visible à l'extérieur de la classe
    FMinIdxNonZero: integer;
    FMaxIdxNonZero: integer;
  public
    property  MinIdxNonZero: integer read FMinIdxNonZero write FMinIdxNonZero; // Index de colonne du premier élément non nul
    property  MaxIdxNonZero: integer read FMaxIdxNonZero write FMaxIdxNonZero; // Index de colonne du deuxième élément non nul
    procedure SortValuesByColumns();                                           // Tri des veleurs par index de colonnes
    function  FindValueByIndexCol(const Idx: integer;
                                  out   BP: TElementNonNulOfAnRow;
                                  out   InternalIdx: integer): boolean;
end;
 
 
type
{ TMatriceCreuse }
 
 TMatriceCreuse = class
   private
     FMatrixName: string;
     FNbAppelsAddValue: Int64;
     FMaxRow: integer;
     FMaxCol: integer;
     FListeLignes: array of TListeNonZerosOfRow;  // tableau 1D de listes, avec un item par ligne
     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;
 
     function  SetValeur(const I, J: integer; const V: double): boolean;
     function  GetValeur(const I, J: integer): double;
     property  NbAppelsAddValue: Int64 read  FNbAppelsAddValue;
     // affichage de la matrice sous forme de texte
     procedure Lister();
     // affichage de la matrice sous forme d'image
     procedure CreerRepresentationMatriceEnImage(const QFileName: string);
 
     procedure RecenserLowIndexes();
     procedure RecenserHighIndexes();
     procedure TrierLesIdxColonnes();
end;
 
implementation
function SortRowValuesByIdxCol(Item1, Item2: Pointer): integer;
var
  E1, E2: ^TElementNonNulOfAnRow;
begin
  E1 :=Item1;
  E2 :=Item2;
  if (E1^.IdxColumn < E2^.IdxColumn) then
    Result := -1
  else if (E1^.IdxColumn = E2^.IdxColumn) then
    Result := 0
  else
    Result := 1;
end;
 
 
function TListeNonZerosOfRow.FindValueByIndexCol(const Idx: integer;
                                                 out   BP: TElementNonNulOfAnRow;
                                                 out   InternalIdx: integer): boolean;
var
  i, QN, n: Integer;
  // recherche par méthode récursive dichotomique (effectivement le plus rapide)
  function FindDepth(const I1, I2: integer; const QIDX: integer):  integer;
  var
    PVT: integer;
    C1: TElementNonNulOfAnRow;
  begin
    // coupure en deux => calcul index médian
    PVT := (I2+I1) div 2;
    // début > fin >> sortie directe avec erreur
    if (I1 > I2) then Exit(-1);  // penser à utiliser Exit comme le return() du C
    C1 := self.GetElement(PVT);
    // comparaison. Si vrai -> sortie avec numéro d'index
    if (C1.IdxColumn = QIDX) then Exit(PVT);
    // sinon, recherche en profondeur avec un niveau supplémentaire
    if (QIDX < C1.IdxColumn) then Exit(FindDepth(I1, PVT-1, QIDX));
    Result := FindDepth(PVT+1, I2, QIDX);
  end;
begin
  Result      := false;
  QN := self.GetNbElements();
  if (QN = 0) then Exit;
  InternalIdx := -1;
  i := FindDepth(0, QN - 1, Idx);
  if (i >= 0) then
  begin
    InternalIdx := i;
    BP     := GetElement(i);
    Exit(True);
  end;
end;
 
 
 
 
 
 
procedure TListeNonZerosOfRow.SortValuesByColumns;
var
  EWE: TElementNonNulOfAnRow;
  n: Integer;
begin
  self.FMinIdxNonZero  := -1;
  self.FMaxIdxNonZero  := -1;
  n := self.GetNbElements();
  if (n = 0) then Exit;
  //self.PurgerLesZeros();
  self.Pack;
  self.Sort(SortRowValuesByIdxCol);
  EWE := self.GetElement(0);
  self.FMinIdxNonZero := EWE.IdxColumn;
  EWE := self.GetElement(n - 1);
  self.FMaxIdxNonZero := EWE.IdxColumn;
end;
//******************************************************************************
{ TMatriceCreuse }
 
 
 
procedure TMatriceCreuse.CreerRepresentationMatriceEnImage(const QFileName: string);
var
  BMP: TBitmap;
  i, j: Integer;
begin
  AfficherMessage(Format('%s.CreerRepresentationMatriceEnImage(%s) (%dx%d)', [ClassName, QFileName, FMaxRow, FMaxCol]));
  Exit;
  BMP := TBitmap.Create;
  try
    BMP.Width  := 1 + FMaxCol;
    BMP.Height := 1 + FMaxRow;
    BMP.Canvas.Brush.Color := clAqua;
    BMP.Canvas.Pen.Color   := clRed;
    BMP.Canvas.FillRect(0, 0, BMP.Width, BMP.Height);
    for i := 1 to FMaxRow do
      for j := 1 to FMaxCol do
        if (not IsZero(GetValeur(i, j))) then BMP.Canvas.Pixels[j, i] := clRed;
    BMP.SaveToFile(QFileName);
  finally
    BMP.Free;
  end;
end;
 
 
 
function TMatriceCreuse.GetValeur(const I, J: integer): double;
var
  MyRow: TListeNonZerosOfRow;
  BP: TElementNonNulOfAnRow;
  QInternalIdx: integer;
begin
  Result := 0.00;
  MyRow := FListeLignes[i];
  if (MyRow.FindValueByIndexCol(j, BP, QInternalIdx)) then Result := BP.Valeur;
end;
function TMatriceCreuse.SetValeur(const I, J: integer; const V: double): boolean;
var
  MyRow: TListeNonZerosOfRow;
  BP   : TElementNonNulOfAnRow;
  QInternalIdx: integer;
begin
  Result := false;
  QInternalIdx := -1;
  if (abs(V) > 0.00) then
  begin
    MyRow := FListeLignes[i];
    // S'il y a déjà une valeur en M[i,j], on la remplace
    if (MyRow.FindValueByIndexCol(J, BP, QInternalIdx)) then
    begin
      BP.Valeur    := V;
      MyRow.PutElement(QInternalIdx, BP);
    end
    else // sinon on ajoute
    begin
      Inc(FNbAppelsAddValue);
      BP.IdxColumn := j;
      BP.Valeur    := V;
      MyRow.AddElement(BP);
      // Index min de non-zero changé ? On retrie
      if (j < MyRow.MinIdxNonZero) then MyRow.SortValuesByColumns();
    end;
    //*)
    Result := true;
  end;
end;
 
 
function TMatriceCreuse.Initialiser(const NbRows, NbCols: integer; const Name: string): boolean;
var
  WU : TElementNonNulOfAnRow;
  i: Integer;
begin
  result := false;
  FNbAppelsAddValue := 0;
  FMatrixName := Name;
  AfficherMessageErreur(Format('%s.Initialiser: %s (%d, %d)', [ClassName, FMatrixName, NbRows, NbCols]));
  try
    SetLength(FListeLignes, 0);
    SetLength(FListeLignes, 1 + NbRows);
    SetLength(FLowIndexes, 0);
    SetLength(FLowIndexes, 1 + NbRows);
    FMaxRow := NbRows;
    FMaxCol := NbCols;
    WU.IdxColumn := 0;
    WU.Valeur    := 0;
    FListeLignes[0] := TListeNonZerosOfRow.Create;
    FListeLignes[0].ClearListe();
    FListeLignes[0].AddElement(WU);
    for i := 1 to High(FListeLignes) do
    begin
      FListeLignes[i] := TListeNonZerosOfRow.Create;
      FListeLignes[i].ClearListe();
      //FListeLignes[i].Capacity := 4000;
    end;
    Result := true;
  except
  end;
end;
procedure TMatriceCreuse.Finaliser;
var
  i: Integer;
begin
  AfficherMessageErreur(Format('%s.Finaliser(%s)', [ClassName, FMatrixName]));
  for i := 0 to High(FListeLignes) do
  begin
    try
      FListeLignes[i].ClearListe();
    finally
      FListeLignes[i].Free;
    end;
  end;
  SetLength(FListeLignes, 0);
  SetLength(FLowIndexes, 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(j, i)) > 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(j, i)) > 0) then
      begin
        FHighIndexes[i] := j;
        Break;
      end;
    end;
  end;
end;
(*
function TMatriceCreuse.GetLowIndex(const ARow: integer): integer;
begin
  Result := FLowIndexes[ARow];
end;
//*)
procedure TMatriceCreuse.Lister;
var
  R: TListeNonZerosOfRow;
  i, n, j: Integer;
  V: TElementNonNulOfAnRow;
  EWE: String;
begin
  AfficherMessageErreur(Format('%s.Lister(): Matrice: %s (%dx%d)', [ClassName, FMatrixName, FMaxRow, FMaxCol]));
  if (FMaxRow = 0) then Exit;
  for i := 0 to FMaxRow do
  begin
    R := FListeLignes[i];
    EWE := Format('Row %d: %d values: ', [i, R.GetNbElements()]);
    n := R.GetNbElements();
    if (n > 0) then
    begin
      for j := 0 to n-1 do
      begin
        V := R.GetElement(j);
        EWE += Format('M[%d, %d] = %f; ', [i, V.IdxColumn, V.Valeur]);
      end;
    end;
    AfficherMessageErreur(EWE);
  end;
end;
 
procedure TMatriceCreuse.TrierLesIdxColonnes();
var
  i: Integer;
begin
  for i := 1 to MaxRow do FListeLignes[i].SortValuesByColumns();
end;
 
end.

Exemple d'Utilisation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
 
var
  A: TMatriceCreuse;      
  toto: double;       
begin
  m := 1000; n := 1000;
  A := TMatriceCreuse.Create; 
  try
    A.Initialiser(m, n, 'Matrice A');
    ...
    A.SetValeur(5,10, 666.66); // écrire une valeur
    toto := A.GetValeur(40, 48); // lire une valeur
    ...
   A.Finaliser();
  finally           
    A.Free;
  end;
end;

Pour remarques et suggestions.

[anapurna]

salut

pourquoi ne pas avoir tout simplement utiliser un arbre plutôt

je pense qu'avec un arbre binaire tu aurais pu t'en sortir sans problème

[JP CASSOU]

salut

pourquoi ne pas avoir tout simplement utiliser un arbre plutôt

je pense qu'avec un arbre binaire tu aurais pu t'en sortir sans problème

J'ai testé (avec succès point de vue 'résultats corrects') avec les BTree (un arbre par ligne) et les TAvgLvlTree (un TAvgLvlTree par ligne, les arbres étant stockés dans un tableau). Ces méthodes fonctionnent très bien mais s'avèrent plus lentes dans cette application.

[anapurna]

salut

un arbre par ligne ?
il faut simplement un arbre et tu insère tes feuilles au fur et à mesure
il faut peut être repenser un peu les insertion et les suppression des feuilles dans l'arbre et tu devrais atteindre des vitesse
plus qu'honorable normalement

on peut Définir que le fils gauche est la position en colonne et que le fils droit est la position ligne
a chaque insertion on retries les éléments pour les placer au plus prés de leur position original

une autre solution est de passer par une liste
et une matrice d'entier (celle ci servant d'index de recherche)

on sais qu'en pascal on peu linéariser une matrice MATRICE[0..N,0..M] = LIGNE[0..N*M]
donc quand tu installe une valeur dans ta liste tu enregistre son index de liste dans ta matrice d'entier
de cette manière tu as un accès plus rapide que si tu devait faire une recherche dans toutes ta liste
tu peut le faire aussi avec un tableau dynamique (ton conteneur de valeur) et une matrice d'entier
même principe cela permet d'indexer le tableau dynamique si la case a -1 c'est que la valeur n'existe pas donc pas besoin
de faire une recherche

je verrai bien un truc un peu dans ce genre là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
TMatriceCreuse = Class
   FMatrixName: string;
   Datas : Array of TElement;
   Index : 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; 
 
    function  SetValeur(const I, J: integer; const V: TElement): boolean;
    function  GetValeur(const I, J: integer): TElement;
end;
 
 
function TMatriceCreuse.Initialiser(const NbRows, NbCols: integer; const Name: string): boolean;
begin
  Setlength(Index,NbRows*NbCols);
  FillChar(Index[0],Length(Index) * SizeOf(Index[0]),-1);
  FMatrixName := Name;
  FMaxRow :=  NbRows;
  FMaxCol := NbCols; 
end;
 
 
function TMatriceCreuse.SetValeur(const I, J: integer; const V: TElement): boolean;	
begin
  Setlength(Datas,Length(Datas)+1);
  Datas[High(Datas)]:=V
  Index[(i-1)*FMaxRow+j] := High(Datas)
end;
 
function  TMatriceCreuse.GetValeur(const I, J: integer): TElement;
begin
  Result := Datas[Index[(i-1)*FMaxRow+j]]
end;
/*
la formule 
 ((Ligne-1)*NbRow)+Col
 
*/
....

voila mes deux cents

PS ... je n'ai pas teste le code mais ce principe fonctionne
PS2 ... Il est possible qu'il faille adapter la formule selon que tes indice commence a zero ou a 1

[JP CASSOU]

salut

un arbre par ligne ?

En effet.
Dans mon application, le nombre de lignes est connu à l'avance (la matrice doit être impérativement inversible). Donc, il y a effectivement une structure (arbre ou liste) par ligne pour stocker les 'non-zeros' et leurs positions.

Dans ta propale de cote (merci d'ailleurs), il y a un tableau 2D d'entiers qui fait déjà le quart (entiers 16bits) ou la moitié (entiers 32) du tableau 2D de double correspondant.