Multithreading lastet nur 1 Kern aus

[Pussyranger]

Hallo,

ich arbeite an einem Programm, welches Unterschiede zwischen verschiedenen Bildern zeigen soll.
Da das Vergleichen der Bilder recht rechenaufwendig ist, habe ich das ganze in eine Threadklasse geschrieben, welche die Arbeit auf 4 Threads (so viele Kerne hat meine CPU) aufteilen und die CPU somit voll auslastet soll - so weit der Plan.
Nach etlichem rumprogrammieren (oder eher rumprobieren :-D ) funktioniert das Programm jetzt zumindest.
Ich habe festgestellt, dass ich die zu vergleichenden Bilder nicht als TBitmap übergeben kann, da dieser Typ nicht threadsafe ist. Deshalb habe ich einen Typ

Delphi-Quellcode:

Colorarray = array of array of TColor

deklariert, in dem die Farbinfos geschrieben werden.
Das Problem ist nun, dass die Threads scheinbar nur im Hauptthread ausgeführt werden, da die CPU-Belastung nie über 25% steigt.
Liegt das daran, dass ich mit dynamischen Arrays arbeite?
LG,

Pussyranger

[Namenloser]

Wie startest du die Threads? Meine Vermutung ist, dass du entweder

Delphi-Quellcode:

Execute

direkt aufrufst oder an den falschen Stellen

Delphi-Quellcode:

Synchronize

verwendest.

[generic]

Evtl. Probleme mit dem Speichermanager!

Empfehlung: Nutze die Omnithread Lib. und fastMM4

[Sir Rufo]

Ich weiß ja nicht wo du die Probleme mit den Bitmaps und dem ThreadSafe hast, es sei denn, du willst jeden Thread auf die gleichen Bitmap-Instanzen zugreifen lassen.

Nehmen wir an die Klasse TBitmap wäre threadsafe und jeder Thread greift auf die beiden TBitmap-Instanzen zu, so können sich diese "gleichzeitigen" Zugriffe gegenseitig blockieren, so dass worst case am Ende immer nur ein Thread arbeitet und die anderen warten, bis sie auf die Instanzen zugreifen dürfen.

Um so eine Aufgabe zu lösen teilt man diese Aufgaben in (in sich abgeschlossene) Unteraufgaben auf und verwaltet diese in einer Warteschlange. Die Threads holen sich jetzt jeweils eine Unteraufgabe ab, verarbeiten diese und liefern das Ergebnis zurück.

Bei einem Bitmap-Vergleich könnte man ja die Ursprungs-Bitmaps in kleine Bitmaps unterteilen und diese vergleichen. Dann ist die Frage, ob TBitmap threadsafe ist, obsolet.

[Bernhard Geyer]

Zitat:

Zitat von generic (Beitrag 1149990)

Empfehlung: Nutze die Omnithread Lib. und fastMM4

XE2 - Da ist FastMM4 eingebaut!

[generic]

Zitat:

Zitat von Bernhard Geyer (Beitrag 1149999)

Zitat:

Zitat von generic (Beitrag 1149990)

Empfehlung: Nutze die Omnithread Lib. und fastMM4

XE2 - Da ist FastMM4 eingebaut!

Na ja, in den alten war der auch schon drin, allerdings in einer Sparfassung.

In der FastMM-Config gibt es auch einige Parameter zu Multithreading.

[Medium]

Ich vermute hier doch eher oberflächlichere Gründe als den MM. Aber so lange wir hier keinen Code sehen, unterstelle ich dem TE einfach mal, dass er an einer Lösung so interessiert dann doch nicht ist ;)

[Pussyranger]

Zitat:

Zitat von Sir Rufo (Beitrag 1149994)

Ich weiß ja nicht wo du die Probleme mit den Bitmaps und dem ThreadSafe hast, es sei denn, du willst jeden Thread auf die gleichen Bitmap-Instanzen zugreifen lassen.

Ich weiß nicht mehr, wieso es mit Bitmaps nicht funktioniert hat. Aber als ich es mit Colorarrays probiert habe und das sogar schneller war als mit Bitmaps, war mir das auch egal.

Hier der Quellocode:

Unit1 (Threadaufruf):

Delphi-Quellcode:

var
  Thread: array of TDifference_Finder;
  ThreadsRunning,ges,Durchzaehler: integer;

{...}

function BitmapToArrayofColor(Bitmap: TBitmap):Colorarray;
VAR i,j: integer;
begin
  SetLength(result, Bitmap.Width, Bitmap.Height);
  for i := 0 to Bitmap.Width-1 do
    for j := 0 to Bitmap.Height-1 do
      result[i,j]:=Bitmap.Canvas.Pixels[i,j];
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
VAR i,j: integer;
begin
  result:=TBitmap.Create;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC)-1 do
    for j := 0 to Length(AoC[0])-1 do
      result.Canvas.Pixels[i,j]:=AoC[i,j];
end;

procedure TForm1.ThreadDoneD(Sender: TObject);
begin
  Dec(ThreadsRunning);
end;

function Unterschiede_markieren(Bild1, Bild2: TBitmap; Blend: Real; Toleranz: Byte):TBitmap;
VAR i,j,Breite,Hoehe,Itert: integer;
begin
  ThreadCount:=4;
  SetLength(Thread, ThreadCount);

  result:=TBitmap.Create;
  SetLength(fertig_bild,Min(Bild1.Width,Bild2.Width),Min(Bild1.Height,Bild2.Height));
  ThreadsRunning:=ThreadCount;

  for i := 0 to ThreadCount-1 do
  begin         
    Thread[i]:=TDifference_Finder.Create(BitmapToArrayofColor(Bild1), BitmapToArrayofColor(Bild2), Round(i*(Min(Bild1.Width,Bild2.Width))/ThreadCount), Round((i+1)*(Min(Bild1.Width,Bild2.Width)-1)/ThreadCount), Blend, Toleranz, true);
    Thread[i].OnTerminate:=Form1.ThreadDoneD;
    Thread[i].FreeOnTerminate:=true;
    Thread[i].Resume;
  end;
  while ThreadsRunning > 0 do Application.ProcessMessages;
  result:=ArrayofcolorToBitmap(fertig_Bild);
end;

TDifference_Finder:

Delphi-Quellcode:

unit Difference_Finder;

interface

uses
  Windows,Classes, SysUtils, Graphics, Math, JPEG, Unit3;
type
  TDifference_Finder = class(TThread)
  private
    Bild1t, Bild2t, Finish: Colorarray;
    StartXt, EndXt: integer;
    Blendt: Real;
    Toleranzt: Byte;
  protected
    procedure Execute; override;
    procedure fertig;
    procedure Diff;
    function Toleranz_pruefen(C1, C2: TColor; Toleranz: Byte):boolean;
    function ColorBetween(C1, C2: TColor; blend: Real):TColor;
    procedure TColor2RGB(Color: TColor; VAR R, G, B: Byte);
    function RGB2TColor(R, G, B: Byte): Integer;
    function Differenz_finden(C1, C2: TColor; Blend: real; Toleranz: Byte):TColor;
  public
    constructor Create(Bild1, Bild2: Colorarray; StartX, EndX: integer; Blend: Real; Toleranz: Byte; CreateSuspended: Boolean);
  end;

implementation

constructor TDifference_Finder.Create(Bild1, Bild2: Colorarray; StartX, EndX: integer; Blend: Real; Toleranz: Byte; CreateSuspended: Boolean);
begin
  Bild1t:=Bild1;
  Bild2t:=Bild2;
  StartXt:=StartX;
  EndXt:=EndX;
  Blendt:=Blend;
  Toleranzt:=Toleranz;
  inherited Create(True);
end;

function TDifference_Finder.ColorBetween(C1, C2: TColor; blend: Real):TColor;
VAR R, G, B, y1, y2: Byte;
begin
   C1:=ColorToRGB(C1);
   C2:=ColorToRGB(C2);
   y1:=GetRValue(C1);
   y2:=GetRValue(C2);
   R:=Round(y1 + (y2-y1)*blend);
   y1:=GetGValue(C1);
   y2:=GetGValue(C2);
   G:=Round(y1 + (y2-y1)*blend);
   y1:=GetBValue(C1);
   y2:=GetBValue(C2);
   B := Round(y1 + (y2-y1)*blend);
   result:=RGB(r, g, b);
end;

procedure TDifference_Finder.TColor2RGB(Color: TColor; VAR R, G, B: Byte);
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  R:=Color;
  G:=(Color SHR 8);
  B:=(Color SHR 16);
end;

function TDifference_Finder.RGB2TColor(R, G, B: Byte): Integer;
begin
  result:=R OR (G SHL 8) OR (B SHL 16);
end;

function TDifference_Finder.Differenz_finden(C1, C2: TColor; Blend: real; Toleranz: Byte):TColor;
VAR R1,G1,B1,R2,G2,B2: Byte; Proz: extended;
begin
  TColor2RGB(C1,R1,G1,B1);
  TColor2RGB(C2,R2,G2,B2);
  Proz:=0;
  Proz:=Proz+33.33*(((Abs(R1-R2)))/255);
  Proz:=Proz+33.33*(((Abs(G1-G2)))/255);
  Proz:=Proz+33.33*(((Abs(B1-B2)))/255);

  Proz:=Proz-Toleranz;
  if Proz < 0 then Proz:=0;

  if Proz < 50 then result:=RGB2TColor(Round(Proz/100*255),255,0)
  else if Proz > 50 then result:=RGB2TColor(255,255-Round(Proz/100*255),0);
  result:=ColorBetween(result, C2, 1-Blend);
end;

function TDifference_Finder.Toleranz_pruefen(C1, C2: TColor; Toleranz: Byte):boolean;
VAR R1,G1,B1,R2,G2,B2: Byte; Proz: extended;
begin
  TColor2RGB(C1,R1,G1,B1);
  TColor2RGB(C2,R2,G2,B2);
  Proz:=0;
  Proz:=Proz+33.33*(((Abs(R1-R2)))/255);
  Proz:=Proz+33.33*(((Abs(G1-G2)))/255);
  Proz:=Proz+33.33*(((Abs(B1-B2)))/255);

  if Proz <=Toleranz then result:=true else result:=false;
end;

procedure  TDifference_Finder.fertig;
VAR i,j:integer;
begin
  for i := StartXt to EndXt do
    for j := 0 to Length(fertig_Bild[0]) do
      fertig_Bild[i,j]:=Finish[i-StartXt,j];
end;

procedure TDifference_Finder.Diff; //<---------------- hier findet der Vergleich statt
VAR i,j: integer;
begin
  SetLength(Finish, EndXt-StartXt+1, Min(Length(Bild1t[0]),Length(Bild2t[0])));

  for i := StartXt to EndXt do
    for j := 0 to Length(Bild2t[0]) do
      if Toleranz_pruefen(Bild1t[i,j], Bild2t[i,j], Toleranzt) then Finish[i-StartXt,j]:=Bild2t[i,j]
      else Finish[i-StartXt,j]:=Differenz_finden(Bild1t[i,j],Bild2t[i,j], Blendt, Toleranzt);
end;

procedure TDifference_Finder.Execute;
begin
  Diff;
  Synchronize(fertig);
end;

end.

Unit3 (Unit1 und TDifference_Finder haben darauf zugriff):

Delphi-Quellcode:

unit Unit3;

interface

uses Vcl.Graphics;

type Colorarray = array of array of TColor;

VAR fertig_Bild: Colorarray; ThreadCount: integer;

implementation

end.

[Namenloser]

Hast du mal gemessen, welcher Teil des Codes welchen Anteil an der Gesamtlaufzeit hat? Vielleicht sind die Threads so schnell fertig, dass du davon gar nichts bemerkst, aber der Rest, der im Main-Thread läuft, braucht die meiste Zeit. Kann sein, dass du hier die völlig falsche Stelle optimiert hast! Ein Tipp, um in Zukunft gleich den Flaschenhals zu finden: Sampling Profiler. (Bei Benutzung in den Compiler-Optionen unbedingt die Mapfile-Generierung aktivieren, sonst hast du sehr wenig davon).

Delphi-Quellcode:

function BitmapToArrayofColor(Bitmap: TBitmap):Colorarray;
VAR i,j: integer;
begin
  SetLength(result, Bitmap.Width, Bitmap.Height);
  for i := 0 to Bitmap.Width-1 do
    for j := 0 to Bitmap.Height-1 do
      result[i,j]:=Bitmap.Canvas.Pixels[i,j];
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
VAR i,j: integer;
begin
  result:=TBitmap.Create;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC)-1 do
    for j := 0 to Length(AoC[0])-1 do
      result.Canvas.Pixels[i,j]:=AoC[i,j];
end;

Das wären so Kandidaten. Der Zugriff über

Delphi-Quellcode:

TCanvas.Pixels

ist nämlich unheimlich lahm. Schau dir mal

Delphi-Quellcode:

TBitmap.Scanline

an. Damit kannst du dir wahrscheinlich auch dein ColorArray sparen. Allerdings musst du das Bitmap dann zeilenweise bearbeiten – aktuell scheinst du ja spaltenweise vorzugehen (was übrigens auch aus Caching-Gründen ineffizient ist, da das Bitmap zeilenweise im Speicher liegt. Sprich: eine Bildzeile kann einfach „in einem Rutsch“ eingelesen werden, während bei Pixeln aus verschiedenen Zeilen immer hin und her gesprungen werden muss. Das dürfte hier zwar kaum ins Gewicht fallen, weil andere Stellen viel stärker bremsen, aber dennoch kann man es mal erwähnen).

[Pussyranger]

Danke! Ich hatte überhaupt nicht damit gerechnet, dass es an der Umwandlung liegt :O
Der Geschwindigkeitsunterschied ist gigantisch :) Leider sind die Threads jetzt absolut überflüssig ^^

Habe den Code jetzt angespasst, aber bei der Rückumwandlung vom Colorarray zum Bitmap gibts jedoch noch einen kleinen Fehler, da das Bild einen gelbstich hat:

Delphi-Quellcode:

procedure TColor2RGB(Color: TColor; VAR R, G, B: Byte);
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  R := Color;
  G := (Color shr 8);
  B := (Color shr 16);
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
type
  PixArray = Array [1..3] of Byte;
VAR i,j:integer; p: ^PixArray; R,G,B: Byte;
begin
  result:=TBitmap.Create;
  result.PixelFormat := pf24Bit;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC[0])-1 do
  begin
    p:= result.ScanLine[i];
    for j := 0 to Length(AoC)-1 do
    begin
      TColor2RGB(Aoc[j,i], R, G, B);
      p^[1]:=B; //<-------- die Kanäle sind schon vertauscht
      p^[2]:=G;
      p^[3]:=R;
      Inc(p);
    end;
  end;
end;

Woran liegt das?