Blocage dans un DoParallel

**der§en** · 27/11/2019, 09h20

Bonjour,

Pour un besoin particulier, je cherche à dénombrer le nombre de couleurs et leurs quantités dans une image qui fait 4000 X 200 pixels.

Pour optimiser le traitement, j’ai utilisé la méthode DoParallel, mais hélas arrivé a 120 lignes de traitées, le programme se bloque sans que je comprenne ou et surtout pourquoi !

Je vous soumets mon code dans l'espoir que vous y trouviez l’énormité que j'y aurai mise ou me dire quelle est la meilleure manière de trouver ou cela bloque

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
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBox1: TScrollBox;
    ValueListEditor1: TValueListEditor;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure ControleUneLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
    procedure CompteurDeLignes;
  public
     iCpt: Integer;
     MaCS: TRTLCriticalSection;
  end;
 
/////////////////////////////////////////////////////////////////////////////////////////////////
 
procedure TForm1.Button1Click(Sender: TObject);
var
  SL: TStringList;
begin
  iCpt := 0;
 
  SL := TStringList.create;
  try
    InitCriticalSection(MaCS);
 
    ProcThreadPool.DoParallel(@ControleUneLigne, 0, Image1.Picture.Height - 1, SL); // , ProcThreadPool.MaxThreadCount);
 
    DoneCriticalSection(MaCS);
 
    ValueListEditor1.Strings.CommaText := SL.CommaText;
 
    ListBox1.Items.CommaText := SL.CommaText;
  finally
    SL.Free;
  end;
 
  Label2.Caption := 'Contrôle des couleurs terminés';
end;
 
procedure TForm1.ControleUneLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
var
  X: DWord;
  L: PRGBQUAD;
  S: String;
  I: Integer;
  SL: TStringList;
begin
  SL := TStringList(Data);
 
  L := PRGBQUAD(Image1.Picture.PNG.RawImage.GetLineStart(Index));
 
  For X := 0 to Image1.Picture.Width - 1 do
  begin
    S := ColorToString(RGBToColor(L^.rgbRed, L^.rgbGreen, L^.rgbBlue));
 
    I := SL.IndexOfName(S);
 
    if  I = -1 then
    begin
      SL.Add(S + '=1');
    end
    else
    begin
      EnterCriticalSection(MaCS);
      try
        SL.ValueFromIndex[I] := IntToStr(SL.ValueFromIndex[I].ToInteger + 1);
      finally
        LeaveCriticalSection(MaCS);
      end;
    end;
 
    Inc(L);
  end;
 
  TThread.Synchronize(CurrentThread, @CompteurDeLignes);
end;
 
procedure TForm1.CompteurDeLignes;
begin
  Inc(iCpt);
 
  Label2.Caption := IntToStr(iCpt);
 
  Application.ProcessMessages;
end;

**BeanzMaster** · 27/11/2019, 16h20

Salut

A mon avis c'est cette ligne TThread.Synchronize(CurrentThread, @CompteurDeLignes); qui doit poser problème car en principe tous les Threads sont déja occupés et appeler la classe TThread comme ça, hum pour ma part je ne recommande pas.
La fonction ProcThreadPool.DoParallel va créer plusieurs thread donc à mon avis, il me semble que le couple InitCriticalSection(MaCS);/DoneCriticalSection(MaCS); n'a pas vraiment de sens dans ces circonstances, mais c'est peut-être une fausse idée de ma part.
Pour l'affichage de la progression je passerai plus part un Timer qui se chargerai juste de lire la variable "iCpt"

Sinon, je te met l'unité que je me sert dans mon projet (aucunes dépendances) Et en plus ça fonctionne presque comme l'original, mais en plus simple

: BZParallelThread.pas

Exemple :

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
Uses BZParallelThread;
 
Type
 TMyBuffer = record
    A, B, C : Int64;
  end;
  PMyBuffer = ^TMyBuffer;
 
Type
   TForm1 = class(TForm)
   private
      FMyBitmap : TBitmap;
      FMyBuffer : PMyBuffer;
 
      procedure ProcessLine(y : Integer; var Source : TMyBuffer);
      procedure MyParalelleProc(Sender: TObject; Index: Integer; Data : Pointer);
 
      procedure Run;
   end;
 
implementration
 
procedure TMainForm.ProcessLine(y : Integer; var Source : TMyBuffer);
var
  L: PRGBQUAD;
begin
  L := PRGBQUAD(FMyBitmap.RawImage.GetLineStart(y));
  Source.A := Source.A + 1;
   ....
 
 
  Inc(iCpt);
  // Les 2 appels suivant peuvent être problématique. J'utiliserai plus un timer qui récupère la valeur iCpt toutes les X secondes et qui s'occuperait de l'affichage. Cela serait à mon avis une meilleur solution que de faire appel 
  //a Application.ProcessMessages; directement ici d'appeler le Synchronize d'un autre thread et vue que le travail  se fait sur mini 2 threads en même temps, ce n'est pas une bonne idée
  //Label2.Caption := IntToStr(iCpt); 
 // Application.ProcessMessages;
end;
 
procedure TMainForm.MyParalelleProc(Sender : TObject; Index : Integer; Data : Pointer);
begin
  ProcessLine(Index mod MyBitmap.Height, TMyBuffer(Data^));
end;
 
procedure Run;
var
   ResultA : Int64;
begin
   GetMem(FMyBuffer, Sizeof(TMyBuffer));
   FMyBuffer^.B := 0;
   ParallelFor(0, FMyBitmap.Height, @MyParalelleProc, Pointer(FMyBuffer));
   ResultA := FMyBuffer^.A;
   FreeMem(FMyBuffer);
end;

pour info,si jamais le Thread en cours d'éxécution se trouve dans cette varaibale globale : "BZCurrentParallelThread" pour la synchronisation (cf petit commentaire dans le code

)

Une solution que je viens de m'auto suggérer serait de modifier un peu la classe " TBZParallelThread" en publiant "FCount" et "FTaskCount" pour pouvoi récupérer directement l'avancement ~~via "BZCurrentParallelThread"~~

A+
Jérôme

EDIT : Oups,

dans l'unité j'ai oublié de commenter {$i ..\bzscene_options.inc} tout au début

**der§en** · 27/11/2019, 16h54

Merci, je m'en vais décortiquer ton source, et essayer d'y trouver mon bonheur

**BeanzMaster** · 27/11/2019, 20h11

Re

Je viens de relire deux trois truc sur les threads

Pour la synchro avec mon unité (je n'ai pas testé) en faisant
comme tu l'as fait avec la fonction de classe synchronize (je n'avais pas fait attention à cette petite subtilité) cela devrait fonctionner

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TMainForm.CompteurDeLignes;
begin
  Label2.Caption := IntToStr(iCpt); 
  Application.ProcessMessages;
end;
 
procedure TMainForm.MyParalelleProc(Sender : TObject; Index : Integer; Data : Pointer);
begin
  ProcessLine(Index mod MyBitmap.Height, TMyBuffer(Data^));
  TThread.Synchronize(BZCurrentParallelThread, @CompteurDeLignes);
end;

Sinon essayes

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
Type
  TThreadUpdateGUI = class(TThread)
  protected
     procedure Execute;
  end;
 
Implmentation
 
procedure TThreadUpdateGUI.Execute;
begin
   BZCurrentParallelThread := self;
   Label2.Caption := IntToStr(iCpt);
   Application.ProcessMessages;
end;
 
procedure TMainForm.MyParalelleProc(Sender : TObject; Index : Integer; Data : Pointer);
begin
  ProcessLine(Index mod MyBitmap.Height, TMyBuffer(Data^));
end;

cela devrait être bon, normalement

A+

**der§en** · 28/11/2019, 11h58

Je vais regarder tes suggestions

J'ai essayer de creuser de mon coté et j'ai l'impression de mon blocage, viendrais peux-être de l'usage de la TStringList par les différents threads

**BeanzMaster** · 28/11/2019, 12h56

Places putôt ta string list dans la definition de la form en protected en tant que variable globale plutôt qu'en local dans buttonclick

Blocage dans un DoParallel [Lazarus]

Lazarus Pascal

Vue hybride

Discussions similaires

Partager

Partager