trier des paires (lettre & entier) par ordre croissant des entiers associés (Delphi10)

Version imprimable

Voir 40 message(s) de cette discussion en une page

17/03/2023, 21h13
MatMagik

trier des paires (lettre & entier) par ordre croissant des entiers associés (Delphi10)
Bonjour à vous :)

je cherche à stocker des poids (un nombre entier) associés à des lettres (char)
et de pouvoir les trier par ordre croissant de poids.

Voici la description de mon besoin : c'est pour créer des exercices de dactylo :-)
j'ai une liste de lettres : a z e r t y u i o p
je pioche des séries de 5 lettres au hasard pour créer des "mots" à taper

Mais je cherche à consommer chacune des lettres selon la même quantité.
Ainsi à chaque fois que je pioche une lettre, j'augmente son poids (0 -> 1 puis -> 2).
Au tirage suivant, je voudrais commencer par piocher parmi les poids les plus bas pour maintenir (globalement) l'équilibre sur une leçon entière.

C'est pourquoi je voudrai trier par ordre croissant de poids mes lettres.

J'ai cherché avec les Dictionnaires TDictionary<string, integer> mais on ne peut classer que si le premier champs est un entier a priori

Me conseilleriez vous d'utiliser un tableau de record ?
Code:

1 2 3 4 5 type Tlettre = record lettre : char; poids : integer; end;
mais pourrais-je le classer ?

Code:

TArray.Sort<Integer>(LArray);

merci !!! :-)
Mat

Je passerais par une base de donnée locale en appliquant une requête du type : SELECT lettre FROM table ORDER BY poids, RANDOM() LIMIT 5.

TFDConnection en SQLite, TFDMemTable pour le tableau, TFDLocalSQL pour la connexion à la DB locale (FDMemTable1) et TFDQuery pour la requête proprement dite.

Pour cette démo, tout est créé par code mais tu peux bien sûr passer par l'inspecteur d'objet.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 procedure TForm1.FormCreate(Sender: TObject); begin FDConnection1.DriverName := 'SQLite'; FDConnection1.Connected := TRUE; FDMemTable1.FieldDefs.Add('lettre', ftString, 1, TRUE); FDMemTable1.FieldDefs.Add('poids', ftInteger, 0, TRUE); FDMemTable1.CreateDataSet; for var c := 'A' to 'Z' do FDMemTable1.AppendRecord([c, 0]); FDLocalSQL1.Connection := FDConnection1; FDLocalSQL1.DataSets.Add(FDMemTable1); FDLocalSQL1.Active := TRUE; FDQuery1.Connection := FDConnection1; end;
Pour le tirage et mise à jour de la DB :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 procedure TForm1.Button1Click(Sender: TObject); begin FDQuery1.Open('SELECT lettre FROM FDMemTable1 ORDER BY poids, RANDOM() LIMIT 5'); while not FDQuery1.Eof do begin FDMemTable1.Locate('lettre', FDQuery1.FieldByName('lettre').AsString); FDMemTable1.Edit; FDMemTable1.FieldByName('poids').AsInteger := FDMemTable1.FieldByName('poids').AsInteger +1; FDMemTable1.Post; FDQuery1.Next; end; end;
Et pour temporairement visualiser la table et le résultat de la requête, deux TDataSource et deux TDBGrid.

18/03/2023, 11h12
Charly910

Bonjour,

sinon, pour trier, tu peux peut être utiliser un TValueListEditor qui est facile à trier sur la colonne Value ?

A+
Charly

J'ai testé, ça marche bien :

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
{ ========================================================================= }
procedure TF_Princ.Btn_InitialiserClick(Sender: TObject);
begin
   ValueListEditor1.InsertRow('A', '4',True) ;
   ValueListEditor1.InsertRow('B', '1',True) ;
   ValueListEditor1.InsertRow('C', '0',True) ;
   ValueListEditor1.InsertRow('D', '3',True) ;
   ValueListEditor1.InsertRow('E', '1',True) ;
   ValueListEditor1.InsertRow('F', '0',True) ;
   ValueListEditor1.InsertRow('G', '2',True) ;
end;
{ ========================================================================= }
procedure TF_Princ.Btn_EffacerClick(Sender: TObject);
begin
  While ValueListEditor1.Strings.Count > 0 Do
    ValueListEditor1.Strings.Delete(0) ;
end;
{ ========================================================================= }
procedure TF_Princ.Btn_AfficherClick(Sender: TObject);
Var
  Nom, Valeur : String ;
  i : Integer ;
begin
  i := ValueListEditor1.Row -1 ;
  Nom := ValueListEditor1.Strings.Names[i]  ;
  Valeur := ValueListEditor1.Strings.ValueFromIndex[i]  ;
  ShowMessage(Nom+' - '+Valeur) ;
end;
{ ========================================================================= }
procedure TF_Princ.Btn_TrierClick(Sender: TObject);
var
  i, j: integer;
begin
  with ValueListEditor1.Strings do
    for i := 0 to Count - 1 do
      for j := i + 1 to Count - 1 do
        if Values[Names[i]] > Values[Names[j]] then
          move(j, i);
end;
{ ========================================================================= }

Petit problème si on dépasse 10 : 10 se classe avant 2 . Il faudrait améliorer la méthode de tri

A+
Charly

C'est sûr que ma proposition précédente est un peu tordue pour si peu.
On peut juste le faire avec une chaîne en déplaçant les tirages en fin et en jouant sur le max du random.

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  CharList := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  Range    := CharList.Length;
end;
 
function TForm1.GetChars: string;
begin
  Result := '';
 
  for var nb := 1 to 5 do
  begin
    const i = Random(Range);
    const c = CharList.Chars[i];
 
    Result   := Result +c;
    CharList := CharList +c;
    CharList := CharList.Remove(i, 1);
    Dec(Range);
 
    if Range = 0 then
      Range := CharList.Length -1;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := GetChars;
end;
 
initialization
  Randomize;

Sinon, sans être aussi savant que Andnotor, dans ma solution on peut ajouter des zéros en début des nombres pour trier correctement, puis les retirer avant utilisation :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 { ========================================================================= } Function AddZero(n: Integer) : String ; Begin Result := StringReplace(Format('%3d', [n]), ' ', '0', [rfReplaceAll]) ; End ; { ========================================================================= } Function RemoveZero(n: String) : String ; Begin While ((n[1] = '0') And (Length(n) > 1)) Do Delete(n, 1, 1) ; Result := n ; End ; { ========================================================================= }
avec l'ajout de zéros, les chaines se trient bien (la longueur totale des chaines est à adapter en fonction du nombre maximum de tirages)
A+
Charly

Si je peux me permettre : 2 petites corrections sur i dans GetChars de Andnotor (+ portage en D7)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
{ ========================================================================= }
function TF_Princ.GetChars: string;
Var
  nb : Integer ;
  i : Integer ;
  c : Char ;
begin
  Result := '';
  for nb := 1 to 5 do
  begin
    i := Random(Range);
    c := CharList[i+1];
    Result   := Result +c;
    CharList := CharList +c;
    Delete(CharList, i+1, 1);
    Dec(Range);
    if Range = 0 then
      Range := Length(CharList) - 1  ;
  end;
end;

A confirmer par Andnotor ...

A+
Charly

18/03/2023, 17h59
Andnotor

CharList.Chars[i] <> CharList[i]. Le premier (string helper) est à base 0 alors que le deuxième est à base 1 ;)

Merci Messieurs pour vos propositions ! :-)

- Alors la base de données, je ne vais pas me jeter à l'eau sur ce coup-ci ! :aie:

- Le TValueEditor est sympa mais je suis sur une bête appli console...

- On peut juste le faire avec une chaîne en déplaçant les tirages en fin et en jouant sur le max du random.
C'est une bonne idée et simple mais certains caractères sont nécessairement consommés (ce que l'on appelle des digrammes ou des trigrammes par exemples).
Je dois garder trace du poids de chaque lettre.

Je suis parti finalement sur un TList of Record et sa fonction Sort personnalisée
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 type TRlettre = record lettre: Char; poids: integer; end; TListeStat = TList<TRlettre>; ListeLettresStat.Sort(TComparer<TRlettre>.Construct( function(const Left, Right: TRlettre): integer begin Result := Left.poids - Right.poids; end));
https://stackoverflow.com/questions/...ustom-comparer

18/03/2023, 20h49
foetus

1 idée comme cela :koi:, reprendre l'idée du "bucket sort" ou du "counting sort"
C'est à dire avec juste 1 tableau (sûrement de chaines de caractères), la case 0 aucune occurrence, case 1 1 occurrence, et ainsi de suite.
Tableau de taille, la taille de ta chaîne résultat (même si c'est + 1 taille valant ((taille de la chaîne résultat) / nombre de lettres)).

Au départ, case 0 on a "azertyuiop"
1) on choisit par exemple la lettre t. Le tableau devient 0 : "azeryuiop", 1 : "t"
2) on choisit par exemple la lettre o. Le tableau devient 0 : "azeryuip", 1 : "to"
Et ainsi de suite.

Mais après l'algorithme de "choix d'une lettre" je ne sais pas :ange: 1 pourcentage :koi: créé avec le nombre de lettres et le nombre d'occurrence.
18/03/2023, 21h35
MatMagik

Oh, merci j'aime bien l'approche simple mais qui porte malgré tout toutes les infos : lettre et poids associé !
19/03/2023, 10h27
Charly910
Bonjour,

dans la solution d'Andnotor, tu peux aussi conserver le poids de chaque lettre. Par exemple :
Code:

1 2 3 c := CharList[i+1]; j := Ord(c) - 64 ; Poids[j] := Poids[j] + 1 ;
dans la boucle For

A+
Charly
20/03/2023, 11h50
MatMagik

merci Charly :)

ça me plaît mais j'utilise des caractères accentués "é" pour la leçon de dactylo et la manip avec Ord ne va plus fonctionner car on sort des ASCII, non ? :calim2:
20/03/2023, 16h59
Charly910

Effectivement, pour les lettres accentuées c'est de 128 à 149 environ et c'est un peu plus compliqué

A+
Charly
21/03/2023, 09h34
SergioMaster

M'enfin, je croyais que TDictionnary (c'etait super bien parti je pense) permettait des tris. J'avoue que je ne suis pas assez en forme pour fournir un code mais il me semble que j'ai déjà posé cette question de tri (faire des recherches dans le forum)

merci pour la piste TDictionnary que j'avais exploré mais écarté car sans possibilité de tri.
sur le forum, on ne trouve que 32 sujets sur le TDictionnary mais pas de tri ! :)

Après je ne suis pas assez calé pour savoir si l'on peut créer une fonction Sort personnalisée comme pour le TStringList

Code:

1
2
3
4
5
ListeLettresStat.Sort(TComparer<TRlettre>.Construct(
      function(const Left, Right: TRlettre): integer
      begin
        Result := Left.poids - Right.poids;
      end));

8O

ou comme l'a fait @anapurna sur les lignes d'un TMémo 8-)

https://www.developpez.net/forums/d1...o/#post9310011
tu peux aussi modifier le TMemo et lui ajouter la fonction de tri, genre :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
type
  TStringListSortCompare = function(List: TStrings; Index1, Index2: Integer): Integer;
 
  TMemo = Class(Vcl.StdCtrls.TMemo)
  private
    fSorted : Boolean;
    FOnChange: TNotifyEvent;
    FOnChanging: TNotifyEvent;
    procedure CustomSort(Compare: TStringListSortCompare);
    procedure QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
    Procedure  Exchange(I,J : Integer);
  protected
    procedure Changed; virtual;
    procedure Changing; virtual;
    procedure SetSorted(value : Boolean);
  Public
    Procedure Sort;
    property Sorted: Boolean read FSorted write SetSorted;
    property OnChange   : TNotifyEvent read FOnChange write FOnChange;
    property OnChanging : TNotifyEvent read FOnChanging write FOnChanging;
  end;

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
 
function CompareString(List : TStrings; Index1, Index2 : integer) : integer;
  begin
    result := AnsiCompareText(List[Index1], List[Index2]);
  end;
 
///////////////////////////////////
Procedure  TMemo.Exchange(I,J : Integer);
var
  s : String;
begin
  s := Self.Lines[i];
  Self.Lines[i] := Self.Lines[j];
  Self.Lines[j]:= s;
end;
///////////////////////////////////
Procedure TMemo.Sort;
begin
  CustomSort(CompareString);
end;
///////////////////////////////////
procedure TMemo.Changed;
begin
  if Assigned(OnChange) Then
    OnChange(self);
end;
///////////////////////////
procedure TMemo.Changing;
begin
  if Assigned(OnChanging) Then
    OnChanging(self);
end;
 
procedure TMemo.SetSorted(value : Boolean);
begin
  if Value <> fSorted Then
  begin
     if fSorted = True Then
       Sort;
     fSorted := Value ;
  end;
end;
 
procedure TMemo.QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self.Lines, I, P) < 0 do Inc(I);
      while SCompare(Self.Lines, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        if P = I then
          P := J
        else
        if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;
 
procedure TMemo.CustomSort(Compare: TStringListSortCompare);
begin
  if not Sorted and (self.lines.Count > 1) then
  begin
    self.lines.BeginUpdate;
    Changing;
    QuickSort(0,self.Lines.Count - 1, Compare);
    Changed;
    self.lines.EndUpdate;
  end;
end;

30/03/2023, 15h09
MatMagik

A votre avis, est-ce qu'il est possible de surcharger un TDictionnary de la même manière qu'Anapurna a surchargé le TMémo ? :)

un TDictionary c'est conçu pour faire une table associative
En interne, c'est via de clés de Hash pour accélérer la recherche
Par définition, il n'y a pas d'ordre

Faire un tri à chaque tirage pour pondérer l'aléatoire va être lent

Un truc pourri mais l'idée est de forcer de ne pas choisir certaines valeurs, de façon trivial, cela ignore les valeurs les plus choisies.
Pour être mieux il faudrait maintenir FLetterPonderation et FLetterPonderationAverage pour affiner les seuils.
Je suis nul en math mais mieux que la moyenne, c'est de calculer la valeur médiane (et prendre ce qui est inférieur ou égale)

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
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
unit RandomWords_MainForm;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    SpinEdit1: TSpinEdit;
    ListBox1: TListBox;
    ListBox2: TListBox;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  TWordGenerator = class(TObject)
  public
    type
      TLetter = record
        Value: Char;
        Count: Integer;
      end;
      TLetters = array of TLetter;
 
  private
    FLetters: TLetters;
    FLetterPonderation: Integer;
    FPonderation: Boolean;
  public
    constructor Create(ALetters: string);
 
    function GetWord(ALength: Integer): string;
    function GetStat(): TLetters;
 
    property Ponderation: Boolean read FPonderation write FPonderation;
  public
    class constructor Create();
  end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  Ls: TWordGenerator.TLetters;
  L: TWordGenerator.TLetter;
begin
  with TWordGenerator.Create(Edit1.Text) do
  try
    Ponderation := CheckBox1.Checked;
 
    for I := 0 to SpinEdit1.Value - 1 do
      ListBox1.Items.Add(GetWord(10));
 
    Ls := GetStat();
    for L in Ls do
      ListBox2.Items.Add(Format('%s: %d', [L.Value, L.Count]));
  finally
    Free();
  end;
end;
 
{ TWordGenerator }
 
constructor TWordGenerator.Create(ALetters: string);
var
  I: Integer;
begin
  inherited Create();
 
  SetLength(FLetters, Length(ALetters));
  for I := 1 to Length(ALetters) do
    FLetters[I-1].Value := ALetters[I];
end;
 
class constructor TWordGenerator.Create();
begin
  Randomize;
end;
 
function TWordGenerator.GetStat(): TLetters;
begin
  Result := FLetters;
end;
 
function TWordGenerator.GetWord(ALength: Integer): string;
type
  PLetter = ^TLetter;
var
  I: Integer;
  K: Integer;
  J, C: Integer;
  L: PLetter;
  Ls: array of PLetter;
begin
  SetLength(Result, ALength);
  for I := 1 to ALength do
  begin
    if FPonderation and (FLetterPonderation > 0) then
    begin
      for J := Low(FLetters) to High(FLetters) do
      begin
        L := @FLetters[J];
        if L.Count < FLetterPonderation then
        begin
          C := Length(Ls);
          SetLength(Ls, C+1);
          Ls[C] := L;
        end;
      end;
    end;
 
    if Length(Ls) > 0 then
    begin
      K := Random(Length(Ls));
      L := Ls[K];
    end
    else
    begin
      K := Random(Length(FLetters));
      L := @FLetters[K];
    end;
 
    Result[I] := L.Value;
    Inc(L.Count);
    if L.Count > FLetterPonderation then
      FLetterPonderation := L.Count;
  end;
end;
 
end.

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
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 262
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 8
    Top = 8
    Width = 121
    Height = 21
    TabOrder = 0
    Text = 'azertyuiop'
  end
  object SpinEdit1: TSpinEdit
    Left = 135
    Top = 8
    Width = 121
    Height = 22
    MaxValue = 100
    MinValue = 1
    TabOrder = 2
    Value = 10
  end
  object ListBox1: TListBox
    Left = 8
    Top = 36
    Width = 193
    Height = 255
    ItemHeight = 13
    TabOrder = 3
  end
  object ListBox2: TListBox
    Left = 207
    Top = 36
    Width = 193
    Height = 255
    ItemHeight = 13
    TabOrder = 4
  end
  object CheckBox1: TCheckBox
    Left = 343
    Top = 13
    Width = 97
    Height = 17
    Caption = 'CheckBox1'
    TabOrder = 5
  end
end

31/03/2023, 10h09
_alx_

Citation:

Envoyé par ShaiLeTroll

Faire un tri à chaque tirage pour pondérer l'aléatoire va être lent
mieux que la moyenne, c'est de calculer la valeur médiane (et prendre ce qui est inférieur ou égale)

Pas sûr, parce que le calcul de la médiane commence par un tri des valeurs, au moins partiel (algorithme optimal), en général complet (algorithme usuel).
Alx.
31/03/2023, 11h23
ShaiLeTroll

2 pièce(s) jointe(s)

C'est pour cela que je pensais que commencer avec la moyenne ça pourrait être un début, surtout pour les petits tirages genre 10 mots de 10 lettres
Entre la moyenne et la valeur la plus haute, on doit pouvoir changer le seuil de sélection.

Et pour commencer, j'ai fourni juste un algo qui élimine les lettres qui ont le compteur le plus élevé, on voit déjà un résultat
CheckBox1 not checked soit Ponderation à False versus CheckBox1 checked soit Ponderation à True
Pièce jointe 636613

Et comme c'est aléatoire, le résultat avec peu de tirage aura tendance à dévier plus fortement.
Plus l'on monte en quantité, moins ça dévie et c'est encore plus facile à corriger avec déjà le pauvre algo que j'ai fourni.
Pièce jointe 636615

Mais on voit des défauts, à un moment, cela va favoriser une lettre peu tirée et qui sera consécutivement choisie pour compenser son compteur.
Faudrait peut-être ajouter un peu d'aléatoire dans le calcul du seuil pour éviter ce phénomène de rattrapage.

Voir 40 message(s) de cette discussion en une page