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
| procedure Tri_Casiers_Str(var DonneesTxt: tStringList; ProfMaxTri: integer; SensDeTri: boolean);
// Renvoie DonneesTxt triée dans le sens croissant si SensDeTri = True, sinon décroissant.
// Si ProfMaxTri inférieur à length(chaînes) alors les chaînes ne sont triées que sur les ProfMaxTri premiers caractères
var io, io1, io2: integer;
CC: array of byte; // Table des valeurs de caractères courants
CCcount: integer; // Nombre max d'éléments dans la table CC
TriPremCar: array[0..255] of tStringList; // Table de partitionnement
ProfTri: integer; // Profondeur courante du tri = indice de colonne
procedure TrierSur1erCaract;
// Tri de partitionnement sur premier caractère
var i, codeCar: integer;
begin for i := 0 to 255 do TriPremCar[i] := tStringList.create;
for i := 0 to donneesTxt.count - 1 do
begin if length(donneesTxt[i]) > 0 then // ici les chaînes éventuellement vides sont ignorées
begin codeCar := ord(donneesTxt[i][1]);
TriPremCar[codeCar].Add(donneesTxt[i]);
end;
end;
end;
function ToutesIdem(SL: tStringList): boolean;
// Renvoie True si toutes les strings de la sous-liste SL sont identiques
var i: integer;
begin if SL.count = 1 then begin Result := True; EXIT; end;
i := 0; while (i + 1 <= SL.count - 1) and (SL[i] = SL[i + 1]) do inc(i);
Result := (i = SL.count - 1);
end;
procedure TriKsurCarSuivants(var donnees: tStringList);
// Tri-Casiers pour tris sur caractères dans colonne ProfTri >= 2
type ind = array of integer;
var iini: array of ind; // table des indices initiaux des strings ( iini[IndiceCaractère][nbOcc[IndiceCaractère]]:= indice ligne )
nbOcc: array of integer; // nombre d'occurences d'un même caractère
i, j: integer;
SL: tStringList; // Sous-Liste temporaire de strings commençant par des SubStrings identiques
lgMax: integer; // length-max des chaînes de SL
carMax, carMin: byte; // Valeurs Max et Min des caractères dans la colonne ProfTri
car1, car2: integer; // Bornes de parcours selon SensDeTri (integer à cause de car1:=carMin-1 qui devient négatif si carMin=0)
car, ic: byte;
begin
// Recherche des valeurs Min et Max des caractères dans colonne ProfTri :
carMax := 0; carMin := 255;
for i := 0 to donnees.count - 1 do
begin if (ProfTri <= ProfMaxTri) and (ProfTri <= length(donnees[i]))
then CC[i] := ord(donnees[i][ProfTri]) else CC[i] := 0;
carMax := max(carMax, CC[i]); carMin := min(carMin, CC[i]);
end;
// Tri-casiers :
SetLength(nbOcc, carMax - carMin + 1);
SetLength(iini, carMax - carMin + 1);
for i := 0 to donnees.count - 1 do
begin ic := CC[i] - carMin;
nbOcc[ic] := nbOcc[ic] + 1; // incrémentation du nombre d'occurrences
SetLength(iini[ic], nbOcc[ic] + 1);
iini[ic][nbOcc[ic]] := i; // mémorisation de l'indice initial de la ligne correspondante
end;
if SensDeTri = True then begin car1 := carMin - 1; car2 := carMax; end
else begin car1 := carMax + 1; car2 := carMin; end;
car := car1;
repeat if SensDeTri = True then inc(car) else dec(car);
ic := car - carMin;
if nbOcc[ic] <> 0 then
begin if nbOcc[ic] = 1 // une seule occurrence donc récup illico des simplets :
then donneesTxt.Add(donnees[iini[ic][1]])
else begin // ici plusieurs occurrences :
SL := tStringList.create; lgMax := 0;
for j := 1 to nbOcc[ic] do
begin SL.add(donnees[iini[ic][j]]);
lgMax := max(length(donnees[iini[ic][j]]), lgMax);
end;
if (ProfTri < ProfMaxTri) and (ProfTri < lgMax) then // Tri sur caractères suivants :
begin inc(ProfTri); TriKsurCarSuivants(SL); end // On Récurse
else // Récup résultat du tri :
if (ProfTri = ProfMaxTri) or (ProfTri = lgMax) or (ProfTri = length(SL[0]) + 1)
then donneesTxt.AddStrings(SL); // doublons, triplets, etc ou profondeur de tri atteinte
ProfTri := 2;
SL.free;
end; // if nbOcc[car-carMin]=1
end; // if nbOcc[car-carMin]<>0
until car = car2;
end; //TriKsurCarSuivants
begin
TrierSur1erCaract; // Pré-tri de partitionnement de donneesTxt sur premier caractère
donneesTxt.clear; // donneesTxt : ré-utilisée pour restituer le tri final
// Recherche de CCcount pour dimensionner CC hors boucle de récursivité de TriKsurCarSuivants
CCcount := 0;
for io := 0 to 255 do CCcount := max(CCcount, TriPremCar[io].Count);
SetLength(CC, CCcount);
if SensDeTri = True then begin io1 := -1; io2 := 255; end
else begin io1 := 256; io2 := 0; end;
io := io1;
repeat if SensDeTri = True then inc(io) else dec(io);
if TriPremCar[io].count <> 0 then
begin if ToutesIdem(TriPremCar[io]) or (ProfMaxTri = 1)
then donneesTxt.AddStrings(TriPremCar[io]) // : récup directe d'un lot de doublons, simplets ... ou du tri sur 1er caractère si ProfMaxTri = 1
else begin ProfTri := 2; TriKsurCarSuivants(TriPremCar[io]); end; // : tri sur caractères suivants
end;
until io = io2;
for io := 0 to 255 do TriPremCar[io].free;
end; // Tri_Casiers_Str |
Tri de chaînes de caractères : Optimiser vitesse ?
Répondre avec citation
Envoyé par Gilbert Geyer
Partager