Comment comparer deux enregistrements ?

Version imprimable

Bonjour :D .

J'aurais besoin de comparer deux enregistrements, mais il me suffit de savoir s'ils sont identiques, et donc j'aimerais bien éviter d'avoir à effectuer une comparaison champs à champs. À partir d'un certain nombre, ça devient fastidieux et ça encombre le code, peut-être pour rien.

J'ai donc essayé ceci
Code:

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 unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs; type { TForm1 } TForm1 = class(TForm) private type TmyRecord = record champs_1: integer; champs_2: string; end; var enregistrement_1, enregistrement_2: TMyRecord; procedure Compare; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Compare; begin enregistrement_1.champs_1 := 1; enregistrement_1.champs_2:= 'un'; enregistrement_2.champs_1 := 10; enregistrement_2.champs_2:= 'dix'; if (enregistrement_1 = enregistrement_2) then ShowMessage('Les enregistrement sont identiques!') else ShowMessage('Les enregistrement sont différents!'); end; end.
mais il semble que ce ne soit pas la bonne méthode car on me dit aimablement que

Citation:

unit1.pas(47,24) Error: Operator is not overloaded: "TForm1.TmyRecord" = "TForm1.TmyRecord"

Y a-t'il un opérateur ou une procédure dédié à ce type de comparaisons?

Merci d'avance pour vos réponses,

amicalement,
naute.

31/05/2018, 18h37
Andnotor

C'est à toi de coder les opérateurs.

Sinon, une façon simple est de comparer les données brutes en mémoire :

Code:

if CompareMem(@enregistrement_1, @enregistrement_2, SizeOf(TmyRecord)) then ...
31/05/2018, 19h32
naute

Bonjour Andnotor :D .

Citation:

Envoyé par Andnotor

C'est à toi de coder les opérateurs.

Je connais ce tuto, mais l'implémentation de la surcharge de l'opérateur ( = dans mon cas) revient à tester l'égalité de chaque champs, ce que je voulais justement éviter.

Citation:

Envoyé par Andnotor

Sinon, une façon simple est de comparer les données brutes en mémoire :

Code:

if CompareMem(@enregistrement_1, @enregistrement_2, SizeOf(TmyRecord)) then ...

Ça, par contre, ça me convient parfaitement :plusser: .

:merci: beaucoup,

amicalement,
naute.
31/05/2018, 22h25
tourlourou

Même si un champ est une chaîne ?

hello,
comme l'indique tourlourou il faut se méfier des strings car dans l'enregistrement ceux sont des pointeurs (SizeOf(TmyRecord) vaut toujours 8).

Pour mettre le problème en évidence :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 procedure TForm1.Compare; var value1,value2 : string; begin value1 := 'un'; value2 := 'u' ; value2 := value2 + 'n'; enregistrement_1.champs_1 := 10000; enregistrement_1.champs_2:= value1; enregistrement_2.champs_1 := 10000; enregistrement_2.champs_2:= value2; if CompareMem(@enregistrement_1, @enregistrement_2, SizeOf(TmyRecord)) then ShowMessage('Les enregistrement sont identiques! - taille enregistrement : ' + inttoStr(sizeOf(TmyRecord))) else ShowMessage('Les enregistrement sont différents! - taille enregistrement : ' + inttoStr(sizeOf(TmyRecord))); end;
Les enregistrements sont détectés différents alors qu'ils sont identiques.
Si tu fais :
Code:

1 2 3 4 value1 := 'undeux'; value2 := 'undeux'; là cela va fonctionner car value1 et value2 pointent au même endroit.
par contre si tu fais :
Code:

1 2 3 4 5 type TmyRecord = record champs_1: integer; champs_2: string[20]; end;
cela va fonctionner car champs_2 n'est plus un pointeur.
J'espère que je n'ai pas raconté trop de bêtise (avec le débogueur de Lazarus j'ai du mal à explorer les records) :oops:

Ami calmant, J.P

Une autre solution, inspirée des SGBD, consiste à assigner une clé primaire unique à chaque enregistrement. Il faut utiliser des enregistrements étendus et un pseudo constructeur pour en arriver là de manière automatique. Ensuite, on compare uniquement les clés primaires.

J'ai fait quelque chose de ressemblant avec une classe au lieu d'un enregistrement.

Code:

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
unit ClePrimaireAutoIncrementee;
 
{$mode objfpc}{$H+}{$R+} {$interfaces CORBA}
{$DEFINE TestOnly}
interface
 
uses Classes, SysUtils;
 
CONST SIClasseAvecClePrimaireIncrementee = '{6E501604-D859-430A-A8E0-408F788E41AE}';
TYPE
 
  ELInstancenEstPasDeLaClasseTDelegueClasseAvecClePrimaireIncrementee = class (Exception);
//******************************************************************************
 
//Un interface qui permetra l'ajout d'un générateur de clés primaires
//autoincrémentées à la classe qui l'implémentera.
 
  IClasseAvecClePrimaireIncrementee = interface [SIClasseAvecClePrimaireIncrementee]
     Function ObtenirUneClePrimaire: Cardinal;
  End;
//******************************************************************************
 
//Une classe qui agira en tant que délégué pour l'implematation de l'interface
//ci-devant.
 
  TDelegueClasseAvecClePrimaireIncrementee = class(IClasseAvecClePrimaireIncrementee)
 
    Strict Private
      LaClePrimaireDeCetteInstance_A: Cardinal;
      CLASS VAR ProchaineClePrimaire: integer;//Initilisé automatiquement à 0 par les règles du langage
      Function GetLaClePrimaireDeCetteInstance:Cardinal; Inline;
      Function ObtenirUneClePrimaire: Cardinal; virtual;
 
{$IFDEF TestOnly}
      Public
      CLASS Procedure ResetCle; //Remise à zéro du générateur de clés primaires
{$ENDIF}
    Public
      Constructor Create; virtual;
      Function Equals(Obj: TObject):BOOLEAN; override;
 
      PROPERTY ClePrimaireDeCetteInstance: Cardinal read GetLaClePrimaireDeCetteInstance;//LaClePrimaireDeCetteInstance_A;
  End;
  //PDelegueClasseAvecClePrimaireIncrementee = IClasseAvecClePrimaireIncrementee;
 
implementation
 
Constructor TDelegueClasseAvecClePrimaireIncrementee.Create;
BEGIN
   ObtenirUneClePrimaire;
end;
 
Function TDelegueClasseAvecClePrimaireIncrementee.ObtenirUneClePrimaire: Cardinal;
BEGIN
   Result:=ProchaineClePrimaire;
   LaClePrimaireDeCetteInstance_A:=ProchaineClePrimaire;
   INC(ProchaineClePrimaire);
End;
Function TDelegueClasseAvecClePrimaireIncrementee.GetLaClePrimaireDeCetteInstance:Cardinal;
BEGIN
   Result:=LaClePrimaireDeCetteInstance_A;
end;
 
Function TDelegueClasseAvecClePrimaireIncrementee.Equals(Obj: TObject):BOOLEAN;
BEGIN
   IF Obj is TDelegueClasseAvecClePrimaireIncrementee THEN
   BEGIN
         //Calling through the interface
         Result:= ClePrimaireDeCetteInstance = (Obj as TDelegueClasseAvecClePrimaireIncrementee).ClePrimaireDeCetteInstance;
   End
   ELSE
      RAISE ELInstancenEstPasDeLaClasseTDelegueClasseAvecClePrimaireIncrementee.Create('Impossible de comparer une instance de la classe TDelegueClasseAvecClePrimaireIncrementee avec une instance d''une autre classe.');
END;
{$IFDEF TestOnly}
CLASS Procedure TDelegueClasseAvecClePrimaireIncrementee.ResetCle;
BEGIN
   ProchaineClePrimaire:= 0;
end;
{$ENDIF}
end.

Comme je ne désirait pas donner une clé primaire uniquement aux sous-classes de ma classe, ce qui serait très limitatif car, par exemple, on ne pourrait pas ajouter une clé primaire à une sous-classe de TPersistent par ce que l'héritage multiple n'est pas supporté par Free Pascal. J'ai donc créé cette interface et pour contourner le fait qu'une interface ne peut pas contenir de données, j'ai utilisé une délégation d'interface.

Voici les tests de cette interface.

Code:

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
unit TestsClePrimaire;
 
{$mode objfpc}{$H+}{$R+}{$S+}
 
interface
 
uses
  Classes, SysUtils, fpcunit, testutils, testregistry, Dialogs,
  ClePrimaireAutoIncrementee;
 
type
 
  TClasseDeTest = class(IClasseAvecClePrimaireIncrementee)
      Constructor Create;
      Destructor Destroy; override;
    Strict Private
      Hook_A: TDelegueClasseAvecClePrimaireIncrementee;
 
    public
      PROPERTY Hook: TDelegueClasseAvecClePrimaireIncrementee read Hook_A implements IClasseAvecClePrimaireIncrementee;
  end;
 
  TTestClePrimaire= class(TTestCase)
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure Test1;
    procedure Test2;
  end;
 
implementation
 
Constructor TClasseDeTest.Create;
BEGIN
  Hook_A:=TDelegueClasseAvecClePrimaireIncrementee.Create;
  //Hook.ObtenirUneClePrimaire;
  //ShowMessage(Hook.ClePrimaireDeCetteInstance.ToString);
End;
Destructor TClasseDeTest.Destroy;
BEGIN
  FreeAndNil(Hook_A);
  inherited;
End;
 
procedure TTestClePrimaire.Test1;
VAR
  C1: TClasseDeTest=nil;
  C2: TClasseDeTest=nil;
 
begin
   C1:= TClasseDeTest.Create;
   C2:= TClasseDeTest.Create;
   TRY
      IF C1.Hook.ClePrimaireDeCetteInstance <> 0 THEN
         FAIL('Doit être zéro');
 
      IF C2.Hook.ClePrimaireDeCetteInstance <> 1 THEN
         FAIL('Doit être un.');
   finally
     C1.Free;
     C2.Free
   end;
end;
 
procedure TTestClePrimaire.Test2;
CONST
  Limite=200000;
VAR
  C1: TClasseDeTest=nil;
  C2: TClasseDeTest=nil;
  i: Cardinal;
begin
 
   TRY
      FOR i:=0 TO Limite DO
      BEGIN
         C1:= TClasseDeTest.Create;
         IF C1.Hook.ClePrimaireDeCetteInstance <> i THEN
            FAIL('Doit être '+i.ToString);
 
         C2:=C1;
         IF NOT C1.Hook.Equals(C2.Hook) THEN  //vérifie l'égalité des clés primaires
            FAIL('Doit obligatoirement être égal.');
 
         FreeAndNil(C1);
      END;
 
   finally
     C1.Free;
   end;
 
end;
 
procedure TTestClePrimaire.SetUp;
begin
   TDelegueClasseAvecClePrimaireIncrementee.ResetCle;
end;
 
procedure TTestClePrimaire.TearDown;
begin
 
end;
 
initialization
 
  RegisterTest(TTestClePrimaire);
end.

Après avoir accompli ce travail, j'ai constaté que deux instances ne seront jamais égales sauf si on a affaire à deux références qui réfèrent au même objet ou si la classe est une sous-classe de TPersitent qui a été copiée avec la fonction Assign. Dans ce cas, on ne peut pas passer à côté de la copie attribut par attribut qui est toute aussi fastidieuse à implémenter que la comparaison attribut par attribut. Cependant, si on a réellement besoin d'Assign pour une classe, la fonction de comparaison des clés primaires prend tous son sens.

Évidemment, je reconnais que cela peut aussi se faire sans interface, en ajoutant une référence à un générateur externe de clés primaires. De plus, je suis convaincu que ce code n'est pas Thread Safe et que la situation serait chaotique si deux threads créaient un délégué simultanément par ce qu'il n'y a qu'une seule et unique class var.

1 pièce(s) jointe(s)

Bonjour tourlourou, jurassic pork et Pierre Le Grand :D .

Citation:

Envoyé par tourlourou

Même si un champ est une chaîne ?

Je n'en ai pas la moindre idée.
Citation:
Envoyé par jurassic pork
Si tu fais :
Code:

1 2 value1 := 'undeux'; value2 := 'undeux';
là cela va fonctionner car value1 et value2 pointent au même endroit.
Sauf erreur d’interprétation, c'est précisément ce que je fais dans l'exemple qui suit
Code:

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 unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private type TmyRecord = record champs_1: integer; champs_2: string; end; var enregistrement_1, enregistrement_2: TMyRecord; procedure Compare; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject); begin Compare; end; procedure TForm1.Compare; begin enregistrement_1.champs_1 := 1; enregistrement_1.champs_2:= 'un'; enregistrement_2.champs_1 := 1; enregistrement_2.champs_2:= 'un'; if CompareMem(@enregistrement_1, @enregistrement_2, SizeOf(TmyRecord)) then ShowMessage('Les enregistrement sont identiques!') else ShowMessage('Les enregistrement sont différents!'); end; end.
et ça a l'air de fonctionner.
Pièce jointe 385146
Toutefois, je ne l'ai pas encore testé dans mon appli.

Citation:

Envoyé par Pierre Le Grand

Une autre solution, inspirée des SGBD, consiste à assigner une clé primaire unique à chaque enregistrement. Il faut utiliser des enregistrements étendus et un pseudo constructeur pour en arriver là de manière automatique. Ensuite, on compare uniquement les clés primaires.

Je te fais entièrement confiance, mais malheureusement, là, je suis un peu dépassé :oops: . De plus, en admettant que j'arrive à comprendre le mécanisme que tu me proposes, ce qui est indispensable pour l'utiliser, ça ne me semble pas plus simple à coder que la comparaison champs par champs :? .

Je vais dans un premier temps expérimenter la solution de AndNotOr dans mon appli et, en fonction des résultats, je verrai s'il faut envisager une autre solution.

Merci pour vos interventions. Elles me font progresser dans ma compréhension des éléments évoqués.

Amicalement,
naute.

01/06/2018, 22h45
BeanzMaster

Bonjour à tous

Citation:

Envoyé par Pierre le Grand

Une autre solution, inspirée des SGBD, consiste à assigner une clé primaire unique à chaque enregistrement. Il faut utiliser des enregistrements étendus et un pseudo constructeur pour en arriver là de manière automatique. Ensuite, on compare uniquement les clés primaires.

J'ai fait quelque chose de ressemblant avec une classe au lieu d'un enregistrement.
....
Comme je ne désirait pas donner une clé primaire uniquement aux sous-classes de ma classe, ce qui serait très limitatif car, par exemple, on ne pourrait pas ajouter une clé primaire à une sous-classe de TPersistent par ce que l'héritage multiple n'est pas supporté par Free Pascal. J'ai donc créé cette interface et pour contourner le fait qu'une interface ne peut pas contenir de données, j'ai utilisé une délégation d'interface.

Voici les tests de cette interface.
....

Après avoir accompli ce travail, j'ai constaté que deux instances ne seront jamais égales sauf si on a affaire à deux références qui réfèrent au même objet ou si la classe est une sous-classe de TPersitent qui a été copiée avec la fonction Assign. Dans ce cas, on ne peut pas passer à côté de la copie attribut par attribut qui est toute aussi fastidieuse à implémenter que la comparaison attribut par attribut. Cependant, si on a réellement besoin d'Assign pour une classe, la fonction de comparaison des clés primaires prend tous son sens.

Évidemment, je reconnais que cela peut aussi se faire sans interface, en ajoutant une référence à un générateur externe de clés primaires. De plus, je suis convaincu que ce code n'est pas Thread Safe et que la situation serait chaotique si deux threads créaient un délégué simultanément par ce qu'il n'y a qu'une seule et unique class var.

Excellent code Pierre, l'usage des interfaces est très percutant. J'avoue moi même ne pas assez les utiliser. En lisant ton exemple, cela m'a procurer une solution pour améliorer mes objets dans mon projet. Solution à laquelle je n'avait pas penser avant :ccool::plusser:
02/06/2018, 22h46
Andnotor

Bien sûr qu'il faut tenir compte de ce que contient l'enregistrement pour une comparaison brute et que des pointeurs seront traités comme tels sans se soucier de la donnée pointée.
Ce n'est effectivement pas la panacée dans le cas présent et définir l'opérateur (même si ça demande quelques lignes de code) est certainement la meilleure chose à faire (ce n'est codé qu'une fois mais utilisable à volonté).

@Pierre le Grand :
Je n'ai pas trop compris l'histoire d'une clé primaire qui par définition devrait être unique même pour des données identiques. Ça ne fonctionnerait que dans le cas d'une copie d'enregistrement où CompareMem serait tout aussi efficace.
il faudrait aussi simplifier tes dénominations. ELInstancenEstPasDeLaClasseTDelegueClasseAvecClePrimaireIncrementee : combien de secondes juste pour lire cette déclaration ?

(je ne suis pas un adepte des déclarations localisées)
07/06/2018, 05h35
Pierre le Grand

Citation:

Envoyé par Andnotor

@Pierre le Grand :
Je n'ai pas trop compris l'histoire d'une clé primaire qui par définition devrait être unique même pour des données identiques. Ça ne fonctionnerait que dans le cas d'une copie d'enregistrement où CompareMem serait tout aussi efficace.
il faudrait aussi simplifier tes dénominations. ELInstancenEstPasDeLaClasseTDelegueClasseAvecClePrimaireIncrementee : combien de secondes juste pour lire cette déclaration ?

CompareMem n'est pas O(1). Si on lui demandait de comparer deux instances de classes contenant beaucoup de données et qui par malheur étaient égales, le processus serait long. Comparer deux entiers nécessite un temps qui est indépendant de la taille de la classe.

J'aime bien les noms qui indiquent clairement ce qui arrive, spécialement pour les exceptions.

J'ai tout de même de la peine à saisir ton concept.

Dans ton exemple C2 := C1, la comparaison est simplement if C2 <> C1 then (comparaison de pointeurs) pas besoin de test supplémentaire.

Dans le cas d'Assign, soit la clé n'est pas copiée et la comparaison échoue même pour des données identiques, soit elle l'est et la comparaison sera fausse si une instance est ensuite modifiée.
Si cette clé était un hash calculé à chaque modification, là oui, tu pourrais ne comparer qu'un entier. Sinon, à moins que les instances soient immuables, ça ne peut pas fonctionner.

D'un point de vue programmation, as-tu pensé au Class Helper ?
Code:

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 type TObjectHelper = class Helper for TObject strict private class var LastKey :integer; public class procedure InitPrimaryKey(var aPrimaryKey :integer); end; TNewObject = class strict private FPrimaryKey :integer; public property PrimaryKey :integer read FPrimaryKey; constructor Create; end; { TObjectHelper } class procedure TObjectHelper.InitPrimaryKey(var aPrimaryKey :integer); begin //InterlockedIncrement est un Inc thread-safe (Windows) aPrimaryKey := InterlockedIncrement(LastKey); end; { TNewObject } constructor TNewObject.Create; begin InitPrimaryKey(FPrimaryKey); end;

09/06/2018, 01h53
Pierre le Grand

Utile les class helper, une caractéristique du langage qui n'existait pas lorsque j'ai été formé.

Effectivement, j'ai déjà demandé une question à propos des classes immuables et c'est pour ce type de classe que je voulais une clé primaire. Avec une classe immuable, toutes les copies d'une instance sont nécessairement identiques.
09/06/2018, 21h45
Andnotor

Citation:

Envoyé par Pierre le Grand

Avec une classe immuable, toutes les copies d'une instance sont nécessairement identiques.

Ce qui rend d'autant plus cette clé primaire inutile puisqu'il n'y a que copie de pointeurs et que leurs comparaisons suffit ;)

Ça peut se discuter sur des records mais pas sur des instances de classe.