Discussion :

[BeanzMaster]

Bonsoir, je vous expose le problème. Je tente en ce moment de charger un fichier XPM dans mon bitmap.
Jusque là pas de problèmes avec des images contenant un petit nombre de couleurs. Au delà d'un seuil (je pense au dessus de 32000 items mais pas vraiment certain ) et la paf.
Note : Le fichier que je tente de charger à 83071 couleurs

Pour le stockage de la palette de couleurs j'utilise un stringlist maison ou je génère un "hash" :
Lisez les commentaires dans le code

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
function ComputeSensitiveStringHash(const aString: string): integer;
var
 i:integer;
 s:string;
begin
 // trouvé sur le forum anglais de lazarus, si je me souviens
 // Fonctionne jusqu'à un nombre X de valeurs dans le tableau. Après il y a des "Duplicata"
 result:=0;
 for i:=1 to length(aString) do
  result:=result*$20844 xor ord(aString[i]);  
 
(* Cette méthode fonctionne très bien le seul soucis sa rapidité une vrai tortue 
 s:='';
 for i:=1 to length(aString) do
 begin
   s:=s+inttostr(ord(aString[i]));
 
 end;
 result:=strtoint(s); *)
end;

J'ai essayé avec un vieux code pour calculer avec un algo CRC32 mais idem, ainsi que d'autre formules mais ça foire si le nombre d'item à stocker est trop important.

Auriez vous une idée pour générer un code unique à chaque coup et performant en terme de rapidité ?
La difficulté c'est qu'a la fin je trie ma liste dans l'ordre croissant en utilisant le Hash comme paramètre

Code :

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

1
2
3
4
function CompareStringListItemHashText(item1, item2: TObject): Integer;
begin
  result:=TGLZStringListItem(item1).getHashText-TGLZStringListItem(item2).getHashText; // le nom est mal choisi, mais le type est bien Integer
end;

Pour mieux que vous compreniez pourquoi voici ma fonction de recherche :

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
function TCustomHashStringList.Find(Const S:String; var index: integer): boolean;
var
   HashKey, Pivot, First, Last: Integer;
   found:Boolean;
begin
 if Count = 0 then exit;
 if not(FIsSorted) then Sort;
 Index:=Count;
 Found  := False;
 result:=false;
 First:=0;
 Last:=Count-1;
 
 // On génère le hash de S pour la comparaison
 if FCaseSensitive then HashKey:=ComputeSensitiveStringHash(S)
 else HashKey:=ComputeInSensitiveStringHash(S);
 
 // Quelques vérifications basiques
 // On vérifie avec le 1er item
 if HashKey = FDirectList^[0].getHashText then   //if S=GetItem(0).Text then
 begin
   index := 0;
   Result := True;
   Exit;
 end;
 // On vérifie avec le dernier item
 if HashKey = FDirectList^[Last].getHashText then     //if S=GetItem(Count-1).Text then
 begin
   index := Count-1;
   Result := true;
   Exit;
 end;
 // On borne par rapport à l'item du milieu de la liste
 // On choisi donc quelle partie  chercher dans la liste
 // On réduit ainsi déja par 2 le nombre d'items à parcourir lors de la recherche
 Pivot :=(Count div 2);
 if HashKey = FDirectList^[Pivot].getHashText then  //if S=GetItem(Pivot).Text then
 begin
   Index:=Pivot;
   Result:=true;
   Exit;
 end
 else if HashKey > FDirectList^[Pivot].getHashText then
 begin
   First:=Pivot;
 end
 else
 begin
   Last:=Pivot;
 end;
 Index:=Last;
 repeat
    // On borne par rapport au milieu de la tranche actuelle
    Pivot := ((First + Last) div 2);
    // On a trouvé on s'en va
    if HashKey =FDirectList^[Pivot].getHashText then
    begin
      Index:=Pivot;
      Result:=true;
      Exit;
    end
    else  // On marque les nouvelles bornes de recherche
    if HashKey > FDirectList^[Pivot].getHashText then
    begin
      First:=Pivot;
      Dec(Index);
    end
    else
    begin
      Last:=Pivot-1;
      Index:=Last; // On laisse comme ca pour pouvoir sortir de la boucle Index < 0. On a n'a pas trouvé l'élément
      if Last<0 then Last:=0; // si négatif provoque une erreur
 
    end;
    // On vérifie si notre position est valide
    if (Index>=First) and (Index<=Last) then Found:=(FDirectList^[Index].getHashText=HashKey);
 until (Index<First) or (Index<0) or found;
 if found then result:=true;
end;

Ca fait des semaines que je suis dessus et je patoge dans la semoule aucune méthodes rapide ne fonctionne

Merci

[Jipété]

Salut,

je passais par là avant d'aller au pieu (moi aussi j'en ai archi-marre du TBitmap sous Lazarus...)

Juste deux-trois petites choses :

Au delà d'un seuil (je pense au dessus de 32000 items mais pas vraiment certain ) et la paf.

Code :

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

1
2
3
begin
 // trouvé sur le forum anglais de lazarus, si je me souviens
 // Fonctionne jusqu'à un nombre X de valeurs dans le tableau. Après il y a des "Duplicata"

J'ai essayé avec un vieux code pour calculer avec un algo CRC32 mais idem, ainsi que d'autre formules mais ça foire si le nombre d'item à stocker est trop important.

Essaye d'être plus précis.
Ce qui m'a mis la puce à l'oreille c'est ta première ligne, au dessus de 32000 items parce que la limite du SmallInt c'est 32767, alors si jamais il y en a un de planqué dans un bout de code profond profond, t'es mal...

Pour le reste je passe, je ne sais pas de quoi tu parles...

[BeanzMaster]

...Essaye d'être plus précis.,Pour le reste je passe, je ne sais pas de quoi tu parles...

Nombre X, Items c'est tout pareil je parle de couleur en fait

La couleurs est stockées ainsi au cas ou:

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
TStringListItem = class(TPersistent)
    private
      FOwner : TCustomHashStringList;
      FHashText: Integer;
      FText : String;
      FObjectRef : TObject;
      FTag : Integer; //Pointer;
    protected
     procedure SetText(aValue:String);
 
    public
      constructor Create; override;
      constructor Create(aOwner: TGLZCustomHashStringList);overload;
 
      function getHashText : Integer;
 
      property Owner : TCustomHashStringList read FOwner Write FOwner;
      property Text : String read FText write SetText;
      property ObjectRef : TObject read FObjectRef Write FObjectRef;
 
      property Tag : Integer read FTag Write FTag;
    end;

donc que je charge une couleur depuis le fichier XPM. Elle est codée sous la forme de caractères (2 et plus) (ex : Xp? ou encore N./ ect....) donc pour chaque "code" je souhaite générer un nombre unique.
Au dela d'un seuil X (j'ai dit 32000 mais c'est vraiment au pifomètre juste fait une moyenne vite fait par rapport à mes tests.) avec mes fonctions (sauf celle que je veux pas) arrivé à ce" X" il y des "Hash" qui ont la même valeur. Du coup lorsque je recherche une couleur, il arrive que ce ne soit pas la bonne que je trouve.

Ensuite je trie ma liste en fonction du "Hash" et je l'utilise pour optimiser la recherche d'une couleur. Il faut donc que ce hash soit unique et numerique pour pouvoir effectuer mes comparaisons dans la fonction de recherche "Find" et trouver l'index de la bonne couleur dans ma liste.

EDIT : Mon bitmap c'est aussi du fait maison

[Jipété]

Salut, désolé d'insister, mais quand tu écris

Au-delà d'un seuil X (j'ai dit 32000 mais c'est vraiment au pifomètre juste fait une moyenne vite fait par rapport à mes tests.)

moi je traduis par 30000 ça passe 35000 ça coince
32000 ça passe 33000 ça coince,
et donc

la limite du SmallInt c'est 32767, alors si jamais il y en a un de planqué dans un bout de code profond profond, t'es mal...

C'est pour ça que je te demande d'être plus précis sur ce nombre.

[Andnotor]

Il est normal d'avoir des duplicatas dans un calcul de hash, c'est ce qu'on appelle des collisions.

Mais je ne comprends pas ta façon de procéder.
Une table de hash est un tableau à deux dimensions. La première est le hash et la deuxième les indices dans la liste d'origine ("les" puisqu'il peut y avoir collision).

Le remplissage serait ainsi :

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
const
  Hash1 = 130469;
  Hash2 = 4096;
 
var
  HashArray : array[0..Hash2 -1] of array of integer;
 
function  GetHash(aText :string) :integer;
var
  i :integer;
begin
  Result := 0;
  for i := 1 to Length(aText) do
    Result := (Result *Hash1 +Ord(aText[i])) mod Hash2;
end;
 
procedure FillHashTable(aList :TStrings);
var
  i         :integer;
  Hash      :integer;
  Collision :integer;
 
begin
  for i := 0 to aList.Count -1 do
  begin
    Hash := GetHash(aList[i]);
 
    Collision := Length(HashArray[Hash]);
    SetLength(HashArray[Hash], Collision +1);
 
    HashArray[Hash,Collision] := i;
  end;
end;

Pour récupérer l'index dans la liste d'origine :

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
function GetTextIndex(aText :string; aList :TStrings) :integer;
var
  i         :integer;
  Hash      :integer;
  Collision :integer;
 
begin
  Hash := GetHash(aText);
 
  //Si pas de collision (rapide)
  if Length(HashArray[Hash]) = 1 then
    Result := HashArray[Hash,0]
 
  //Si collision (lent)
  else
  begin
    for i := 0 to High(HashArray[Hash]) do
    begin
      Result := HashArray[Hash,i];
 
      if SameText(aText, aList[Result]) then
        Exit;
    end;
 
    Result := -1;
  end;
end;

Il y a ici un contrôle des textes en cas de collision mais on pourrait aussi ajouter une troisième dimension pour calculer un deuxième hash sur des valeurs de hachage différentes.

Enfin, on peut jouer sur Hash1 et Hash2 pour optimiser les performances (limiter les collisions).

[BeanzMaster]

Il est normal d'avoir des duplicatas dans un calcul de hash, c'est ce qu'on appelle des collisions.

Oui c'est ça tu as bien compris, je savais pas comment l'expliquer correctement, hier.

Mais je ne comprends pas ta façon de procéder.
Une table de hash est un tableau à deux dimensions. La première est le hash et la deuxième les indices dans la liste d'origine ("les" puisqu'il peut y avoir collision).

En fait je n'ai qu'une liste le "Text" et le "Hash" sont stocké dans un seul objet (TStringListItem) J'ai procédé ainsi à cause de ma procedure find (cf code dans mon 1er post)
Pour optimiser cette procedure la liste est trié dans l'ordre croissant par "Hash". La procedure Find calcul en fait les "distances" de chaque élément grâce au "Hash" et je réduis par 2 le nombre d'élément à parcourir à chaque itération au lieu de tester toute la liste. Ce qui normalement devrait être beaucoup plus rapide que la fonction IndexOf du TStringList de la LCL. (je sais pas si j'explique bien la, mais pour décrire len l'algo en 3 mots je dirais Technique Point du Milieu)

Le remplissage serait ainsi :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
const
  Hash1 = 130469;
  Hash2 = 4096;
 
 
function  GetHash(aText :string) :integer;
var
  i :integer;
begin
  Result := 0;
  for i := 1 to Length(aText) do
    Result := (Result *Hash1 +Ord(aText[i])) mod Hash2;
end;

J'ai testé juste ça et nickel ça fonctionne juste le fait de rajouter mod Hash2 ça passe

Faudrait que je teste les limites maintenant

Il y a ici un contrôle des textes en cas de collision mais on pourrait aussi ajouter une troisième dimension pour calculer un deuxième hash sur des valeurs de hachage différentes.

Il faudrait reparcourir la liste pour savoir si il existe déja un "Hash" de cette valeur ? Je vois le principe, mais pas comment l'appliquer. Je m'y pencherai plus tard

Enfin, on peut jouer sur Hash1 et Hash2 pour optimiser les performances (limiter les collisions).

Comment ?

Merci
Je marque résolu. Merci AndNotOr tu me sauves de la crise de nerf



EDIT : Juste pour ne pas réouvrir un post

Voila mon code final (le meilleur en terme de performance)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
function ComputeSensitiveStringHash(const aString: string): integer;
var
 i,j:integer;
begin
  I:= length(aString);
  J:= Ord(aString[I]);
  repeat
    dec(I);
    J := (J *cHash1 +  Ord(aString[I]));
  until I=1;
  result:=J mod cHash2;
end;

Merci encore

[Andnotor]

En fait je n'ai qu'une liste le "Text" et le "Hash" sont stocké dans un seul objet (TStringListItem) J'ai procédé ainsi à cause de ma procedure find (cf code dans mon 1er post)
Pour optimiser cette procedure la liste est trié dans l'ordre croissant par "Hash". La procedure Find calcul en fait les "distances" de chaque élément grâce au "Hash" et je réduis par 2 le nombre d'élément à parcourir à chaque itération au lieu de tester toute la liste. Ce qui normalement devrait être beaucoup plus rapide que la fonction IndexOf du TStringList de la LCL.

Calculer un hash pour ensuite devoir reparcourir une liste pour retrouver un index est juste refaire une deuxième fois ce qui est déjà fait, le hash étant déjà un index sur la 1ère dimension du tableau !

Tu pourrais même imaginer cela :

Code :

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

1
2
3
4
5
6
7
type
  TColorInfo = record
    Index :integer; //Index dans la liste originale
    Color :TColor;
  end;
var
  HashArray : array[0..Hash2 -1] of array of TColorInfo;

Ainsi la liste originale ne serait plus qu'utilisée en cas de collision.

Il faudrait reparcourir la liste pour savoir si il existe déja un "Hash" de cette valeur ?

Non, non ! Ce serait vraiment calculer un deuxième hash sur des valeurs différentes et avoir une déclaration HashArray : array[0..Hash2 -1] of array[0..Hash3 -1] of array of integer; (ça ne garantit pas qu'il n'y aurait jamais de collision mais les limiterait au maximum)

Comment ?

Si tu augmentes Hash2, tu réduis le nombre de collisions (mais augmente les besoins en mémoire).

[BeanzMaster]

Calculer un hash pour ensuite devoir reparcourir une liste pour retrouver un index est juste refaire une deuxième fois ce qui est déjà fait, le hash étant déjà un index sur la 1ère dimension du tableau !

Tu pourrais même imaginer cela :

Code :

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

1
2
3
4
5
6
7
type
  TColorInfo = record
    Index :integer; //Index dans la liste originale
    Color :TColor;
  end;
var
  HashArray : array[0..Hash2 -1] of array of TColorInfo;

Ainsi la liste originale ne serait plus qu'utilisée en cas de collision.

Que je suis C.., c'est tellement plus simple et évident comme optimisation, que je n'y ai pas pensé. Et je me suis embarqué dans un truc de comparaison. C'est ça, il est là mon problème d'origine "La perte de performance" par rapport à ce code tiré de fpreadxpm.pp:

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
type
  TFPReaderXPM = class (TFPCustomImageReader)
private     
      palette : TStringList;
...
  procedure AddPalette (const code:string;const Acolor:TFPColor);
  var r : integer;
  begin
    r := Palette.Add(code);
    img.palette.Color[r] := Acolor;
  end;
...
 for color := 0 to Palette.Count-1 do
        { Can't use indexof, as compare must be case sensitive }
        if code = Palette[color] then begin
          img.pixels[r-1,imgindex] := color;
          Break;
        end;

Je mettre ça en place de ce pas !

Non, non ! Ce serait vraiment calculer un deuxième hash sur des valeurs différentes et avoir une déclaration HashArray : array[0..Hash2 -1] of array[0..Hash3 -1] of array of integer; (ça ne garantit pas qu'il n'y aurait jamais de collision mais les limiterait au maximum)

Ok on rajoute une couche comme un oignon.

Si tu augmentes Hash2, tu réduis le nombre de collisions (mais augmente les besoins en mémoire).

C'est drôle je l'ai fais inconsciemment en mettant la même taille que ma "DirectList" MaxInt shr 4

Merci AndNotOr

[BeanzMaster]

C'est fait j'ai fais les changements et les performances sont très proche de celle de Lazarus

Juste un truc dans le calcul du hash j'ai modifié result:=abs(J mod cHash2); car sinon on peut-être confronter à des nombres négatifs.
De même que la fonction maintenant indexof se reduit à Result := FHashArray[Hash];

J'ai enlevé le test de collision car tant que le nombre d'éléments à insérer ne dépasse cHash2 ça fonctionne pas d'accidents

un petit screen de l'image de 33 mo chargée

[Andnotor]

les performances sont très proche de celle de Lazarus

Tu y gagnerais sans doute encore à déclarer la fonction de hachage inline.

Juste un truc dans le calcul du hash j'ai modifié result:=abs(J mod cHash2); car sinon on peut-être confronter à des nombres négatifs.

Normal, en multipliant constamment par Hash1, tu finis par activer le bit de poids fort (signe négatif) avant d'avoir un débordement d'entier (la variable fait le tour).
Active le test de débordement {$Q+} pour voir

Ca n'arrive pas si tu limites toujours le hash aux bornes définies (0..Hash2 -1) par Result := (Result *Hash1 +Ord(aText[i])) mod Hash2;.

J'ai enlevé le test de collision car tant que le nombre d'éléments à insérer ne dépasse cHash2 ça fonctionne pas d'accidents.

Hasardeux !

[BeanzMaster]

Tu y gagnerais sans doute encore à déclarer la fonction de hachage inline.

Je l'ai fait, pas de différence sur mon PC. Mais le mieux c'est de le déclarer dans l'interface ou l'implementation ou c'est kifkif ?

Normal, en multipliant constamment par Hash1, tu finis par activer le bit de poids fort (signe négatif) avant d'avoir un débordement d'entier (la variable fait le tour).
Active le test de débordement {$Q+} pour voir
Ca n'arrive pas si tu limites toujours le hash aux bornes définies (0..Hash2 -1) par Result := (Result *Hash1 +Ord(aText[i])) mod Hash2;.
...
Hasardeux !

Hazardeux oui mais vu que les "textes" font en moyenne 2 ou 3 caractères max. avec 3 (ABC) il y'a max 6 cas de collisions possible (ABC, ACB, BCA, BAC, CBA , CAB) si je ne me trompe pas.

Bizarrement avec Result := (Result *Hash1 +Ord(aText[i])) mod Hash2;. pas de débordement mais il y a des collisions.

Tandis qu'avec

Code :

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

1
2
3
4
5
6
  J:= Ord(aString[I]);
  repeat
    dec(I);
    J := (J *cHash1 +  Ord(aString[I]));
  until I=1;
  result:=abs(J mod cHash2);

pas débordement et pas de collisions. L'écart entres les "hash" est plus grand (1 seul mod ) c'est logique, ou pas ?