AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Speed von gleichen Threads unterschiedlich

Ein Thema von RaSoWa1 · begonnen am 11. Jan 2009 · letzter Beitrag vom 28. Jan 2009
Antwort Antwort
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#1

Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 11:25
Hallo,
ich da mal eine Frage.

In einem Projekt, in dem ich einige tausend Bilder verwalte, habe ich eine Prozedur mit der ich ähnliche oder gleiche Bilder suchen kann. Um diese Prozedur zu beschleunigen, teile ich die Liste der zu überprüfenden Bilder durch die Anzahl der Prozessorkerne und lagere die Überprüfung in die entsprechenden Anzahl von Threads aus.

Wenn zur Suche die Funktion "VergleicheHorizontal" (Code sieh unten) verwendet wird, geht es mit 4 Threads fast 3 x so schnell.

Wenn ich aber zur Suche die Funktion "VergleicheVertikal" verwende, dauert es mit den 4 Thread 4 x länger als in der ursprünglichen Prozedur. Wenn ich für diese Funktion nur 1 Thread starte, geht zwar etwas schneller. Aber je mehr Threads ich verwende, desto länger dauert es mit dieser Funktion.
Ich vermute, die Threads bremsen sich gegenseitig aus. Nur wo?
Wieso steigt bei der Funktion "VergleicheHorizontal" die Geschwindigkeit mit der Anzahl der Threads und bei "VergleicheVertikal" nicht? Dort ist es genau umgekehrt.
Der Code unterscheidet sich im wesentlichen doch nur in der unterschiedlichen Anzahl der Verwendung von Scanline.

Über ein paaar Tips würde ich mich sehr freuen.
Viele Grüße
Klaus


Hier der Code der beiden Funktionen:
Delphi-Quellcode:
function VergleicheBmp(bmp0, bmp1: TBitmap; VerglMode: TBmpVerglMode; toleranz: integer; SollProz: double = 0): double;
  function VergleicheHorizontal(bmp0, bmp1: TBitmap; toleranz: Integer): double;
  var x, y,
       r0, g0, b0,
       r1, g1, b1,
       size0,
       diff : LongInt;
       p0, p1 : pRGBValue;
  begin
    diff := 0;
    size0 := bmp0.Height;
    for y := 0 to bmp0.Height-1 do begin
      p0 := bmp0.Scanline[y];
      p1 := bmp1.Scanline[y];
      r0 := 0; g0 := 0; b0 := 0;
      r1 := 0; g1 := 0; b1 := 0;
      for x := 0 to bmp0.Width-1 do begin
        inc(r0, p0.Red);
        inc(g0, p0.Green);
        inc(b0, p0.Blue);
        inc(r1, p1.Red);
        inc(g1, p1.Green);
        inc(b1, p1.Blue);
        Inc(p1);
        Inc(p0);
        end;
      r0 := r0 div bmp0.Width;
      g0 := g0 div bmp0.Width;
      b0 := b0 div bmp0.Width;
      r1 := r1 div bmp1.Width;
      g1 := g1 div bmp1.Width;
      b1 := b1 div bmp1.Width;
      if abs(r1-r0) > toleranz
      then inc(diff)
      else
        if abs(g1-g0) > toleranz
        then inc(diff)
        else
          if abs(b1-b0) > toleranz
          then inc(diff);
      end;
    result := diff*100/size0;
  end;
  function VergleicheVertikal(bmp0, bmp1: TBitmap; toleranz: Integer): double;
  var x, y,
       r0, g0, b0,
       r1, g1, b1,
       size0,
       diff : LongInt;
       p0, p1 : pRGBValue;
  begin
    diff := 0;
    size0 := bmp0.Width;
    for x := 0 to bmp0.Width-1 do begin
      r0 := 0; g0 := 0; b0 := 0;
      r1 := 0; g1 := 0; b1 := 0;
      for y := 0 to bmp0.Height-1 do begin
        p0 := bmp0.Scanline[y];
        p1 := bmp1.Scanline[y];
        inc(p0, x);
        inc(p1, x);
        inc(r0, p0.Red);
        inc(g0, p0.Green);
        inc(b0, p0.Blue);
        inc(r1, p1.Red);
        inc(g1, p1.Green);
        inc(b1, p1.Blue);
        end;
      r0 := r0 div bmp0.Height;
      g0 := g0 div bmp0.Height;
      b0 := b0 div bmp0.Height;
      r1 := r1 div bmp1.Height;
      g1 := g1 div bmp1.Height;
      b1 := b1 div bmp1.Height;
      if abs(r1-r0) > toleranz
      then inc(diff)
      else
        if abs(g1-g0) > toleranz
        then inc(diff)
        else
          if abs(b1-b0) > toleranz
          then inc(diff);
      end;
    result := diff*100/size0;
  end;
begin
  // bmp auf gleiche Größe bringen:
  if bmp0.Height*bmp0.Width <> bmp1.Height*bmp1.Width
  then NewSizeToBitmap(bmp1, bmp0.Height, bmp0.Width);
  // Pixelformat egalisieren:
  if bmp0.PixelFormat <> pf24bit
  then bmp0.PixelFormat := pf24bit;
  if bmp1.PixelFormat <> pf24bit
  then bmp1.PixelFormat := pf24bit;

// Bereichsüberprüfung des Compilers ggf. abschalten:
{$IFOPT R+}
{$R-}
{$DEFINE RangCheck}
{$ENDIF}

// bmp vergleichen:
  case VerglMode of
    cvLineH : result := VergleicheHorizontal(bmp0, bmp1, toleranz);
    cvLineV : result := VergleicheVertikal(bmp0, bmp1, toleranz);
    cvLineHV : begin
               result := VergleicheHorizontal(bmp0, bmp1, toleranz);
               if result > Sollproz
               then result := (result+VergleicheVertikal(bmp0, bmp1, toleranz))/2;
               end;
    else
      result := -1;
    end;

// Bereichsüberprüfung des Compilers ggf. wieder einschalten:
{$IFDEF RangCheck}
{$R+}
{$UNDEF RangCheck}
{$ENDIF}
end;
Der Code des Threads:
Delphi-Quellcode:
unit ThreadSuchImage;

interface

uses
  Classes, Graphics, Forms, FilterGrid, ExtCtrls,
  ClassAlbum;

const
  cThreadMsgMode_Find = 1;
  cThreadMsgMode_Msg = 2;
  cThreadMsgMode_Ende = 512;
  cModFaktor = 10;
type
  ThreadMsgDat = packed record
                    Mode,
                    idx,
                    RefNr,
                    ImgNr,
                    Anz : Integer;
                    sv : Boolean;
                    end;
  pThreadMsgDat = ^ThreadMsgDat;

  TThreadSuchImg = class(TThread)
  private { Private declarations }
    FAlb : TAlbum;
    FDat : ThreadMsgDat;
    Fbmp0 : TBitmap;
    ImNr : Integer;
    proz : double;
    FMsgLst : TList;
    procedure AddToGrd;
    procedure SetMsg;
    procedure SetEndeMsg;

  public
    constructor Create(aAlb: TAlbum; tmd: ThreadMsgDat; RefBmp: TBitmap; MsgLst: TList);
    function VerglImg: Boolean;
  protected
    procedure Execute; override;
  end;

implementation

uses SysUtils,
     ClassImage, DlgVergImg, AlbenText, Alben, AlbenConst, ClassEinst,
     ToolGrafik;

constructor TThreadSuchImg.Create(aAlb: TAlbum; tmd: ThreadMsgDat; RefBmp: TBitmap; MsgLst: TList);
begin
  inherited Create(True);
  FAlb := aAlb;
  FDat := tmd;
  Fbmp0 := RefBmp;
  FMsgLst := MsgLst;
  Priority := tpHighest;
  FreeOnTerminate := True;
end;

procedure TThreadSuchImg.AddToGrd;
var ptmd : pThreadMsgDat;
begin
  new(ptmd);
  ptmd^.Mode := cThreadMsgMode_Find;
  ptmd^.idx := FDat.idx;
  ptmd^.RefNr := FDat.RefNr;
  ptmd^.ImgNr := ImNr;
  ptmd^.Anz := round(Proz*100);
  FMsgLst.Add(ptmd);
end;

procedure TThreadSuchImg.SetMsg;
var ptmd : pThreadMsgDat;
begin
  new(ptmd);
  ptmd^.Mode := cThreadMsgMode_Msg;
  ptmd^.idx := FDat.idx;
  ptmd^.ImgNr := ImNr;
  FMsgLst.Add(ptmd);
end;

procedure TThreadSuchImg.SetEndeMsg;
var pTmd : pThreadMsgDat;
begin
  new(pTmd);
  pTmd^.Mode := cThreadMsgMode_Ende;
  pTmd^.idx := FDat.idx;
  FMsgLst.Add(pTmd);
end;

function TThreadSuchImg.VerglImg: Boolean;
var i,
     toleranz : Integer;
     bmp1 : TBitmap;
     sv1 : boolean;
     SollProz : double;
     VerglDat : TVerglImgDatRec; // ist ein record in dem die Sucheinstellungen gespeichert werden
     lst : TStringList;

  function GetBmpFilename(ai: TAlbImg): string;
  begin
    if FAlb.VerglImg.DiaMode
    then result := FAlb.FileNameDia[ai]
    else result := FAlb.FileNameImg[ai];
  end;
begin
  toleranz := round(255*FAlb.VerglImg.Toleranz/100);
  SollProz := 100-FAlb.VerglImg.Proz;
  VerglDat := FAlb.VerglImg.VerglImgDat;
  lst := TStringlist.Create;
  try
    for i := FDat.ImgNr to FDat.ImgNr+FDat.Anz-1 do
      if i <> FDat.RefNr
      then lst.Add(GetBmpFilename(FAlb.ImgLst[i]));
    for i := 0 to lst.Count-1 do begin
      if Terminated
      then Break;
      bmp1 := TBitmap.Create;
      try
        LoadGrafikToBmp(bmp1, lst[i]);
        sv1 := bmp1.Height > bmp1.Width;
        if not(VerglDat.Sv) or (FDat.sv = sv1)
        then proz := VergleicheBmp(FBmp0, bmp1, VerglDat.VerglMode, toleranz, VerglDat.Proz)
        else proz := SollProz+1;
      finally
        bmp1.Free;
        end;
      ImNr := FDat.ImgNr+i;
      if proz <= SollProz
      then AddToGrd;
      if i mod cModFaktor = 0
      then SetMsg;
      end;
  finally
    lst.Free;
    end;
end;

procedure TThreadSuchImg.Execute;
begin
  try
    VerglImg;
  finally
    SetEndeMsg;
    end;
end;

end.
Klaus
  Mit Zitat antworten Zitat
Benutzerbild von Dunkel
Dunkel

Registriert seit: 26. Mär 2007
Ort: Klingenstadt
541 Beiträge
 
Delphi 2007 Enterprise
 
#2

Re: Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 12:39
Hallo!

Zitat von RaSoWa1:
Der Code unterscheidet sich im wesentlichen doch nur in der unterschiedlichen Anzahl der Verwendung von Scanline.
Daran wird es wohl liegen. Dreh doch beide Bilder um 90 Grad und benutze die Horizontale Vergleichsprozedur.
Es ist zu wahr um schön zu sein...
  Mit Zitat antworten Zitat
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#3

Re: Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 13:16
Danke für die schnelle Antwort.

Zitat:
Daran wird es wohl liegen. Dreh doch beide Bilder um 90 Grad und benutze die Horizontale Vergleichsprozedur.
Ob der Zeitverlust durch das Drehen der beiden Bilder kleiner ist als der durch die größere Anzahl der ScanLine-Aufrufe? Ich kann es ja mal probieren.
Das Erklärt mir aber noch nicht, warum 1 Thread mit 1000 Bilder viel viel schneller ist als 4 parallel laufende Threads mit jeweils 250 Bilder die Windows Vista auf jeweils einen Prozessorkern verteilt hat.

Viele Grüße
Klaus
Klaus
  Mit Zitat antworten Zitat
Benutzerbild von Dunkel
Dunkel

Registriert seit: 26. Mär 2007
Ort: Klingenstadt
541 Beiträge
 
Delphi 2007 Enterprise
 
#4

Re: Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 13:29
Zitat von RaSoWa1:
Ob der Zeitverlust durch das Drehen der beiden Bilder kleiner ist als der durch die größere Anzahl der ScanLine-Aufrufe? Ich kann es ja mal probieren.
Garantiert! Probier es mal damit:
Delphi-Quellcode:
procedure RotateBitmap(const Bitmap: TBitmap);
var
  tmpBitmap: TBitmap;
  Points: array[0..2] of TPoint;
begin
  tmpBitmap:= TBitmap.Create;
  try
    tmpBitmap.Assign(Bitmap);
    Bitmap.Width := tmpBitmap.Height;
    Bitmap.Height := tmpBitmap.Width;
    Points[0] := Point(tmpBitmap.Height, 0);
    Points[1] := Point(tmpBitmap.Height, tmpBitmap.Width);
    Points[2] := Point(0, 0);
    PlgBlt(Bitmap.Canvas.Handle, Points, tmpBitmap.Canvas.Handle,
           0, 0, tmpBitmap.Width, tmpBitmap.Height, 0, 0, 0);
  finally
    tmpBitmap.Free();
  end;
end;
Der Code rotiert das übergeben TBitmap um 90 Grad im Uhrzeigersinn.

Zitat von RaSoWa1:
Das Erklärt mir aber noch nicht, warum 1 Thread mit 1000 Bilder viel viel schneller ist als 4 parallel laufende Threads mit jeweils 250 Bilder die Windows Vista auf jeweils einen Prozessorkern verteilt hat.
Threads benötigen Verwaltungsaufwand. Gut, bei Dir ist das jetzt ein sehr extremes Beispiel dafür.
Aber es wird garantiert daran liegen, dass Du beim vertikalen vergleichen Scanline Width*Height-Mal aufrufst und dann jeweils nur ein Pixel vergelichst, anstatt pro Zeile nur einmal Scanline aufzurufen und die komplette Zeile abzuarbeiten.
Es ist zu wahr um schön zu sein...
  Mit Zitat antworten Zitat
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#5

Re: Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 14:43
Danke nochmals.

Ich werde das heute Abend mal testen.
Jetzt muß ich mich erst einmal um die liebe Verwandtschaft kümmern. Ich habe ich die Bude voll Besuch.


Viele Grüße
Klaus
Klaus
  Mit Zitat antworten Zitat
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#6

Re: Speed von gleichen Threads unterschiedlich

  Alt 18. Jan 2009, 12:06
Hallo,

Ich habe an dem Problem jetzt etliche Stunden getestet und probiert, bin aber nicht viel weiter gekommen.

Ich hatte den Vorschlag von Dunkel in der Methode VergVertikalNew (Code siehe unten) umgesetzt. Lief Anfangs so wie gewollt. Als ich die Datenmenge erhöhte, wurden immer weniger Bilder gefunden. Als ich das Häckchen in der Debuggeroption "Stop on Delphi Exceptions" gesetzt hatte, kam ich der Ursache auf die Spur. Die Threads wurden nach 2 bis ca 50 Schleifendurchläufen mit der Fehlermeldung "Project Fotoalbum3.exe raised exception class EOutOfResources with message 'Das Handle ist ungültig.'" in der Prozedur GDIError (Unit Graphics) abgebrochen. Was wird da nicht richtig freigegenen?

Statt RotateBitmap habe ich nun meine bisherige Prozedur (Code siehe auch unten) zum Drehen verwendet. Es geht zwar langsamer als mit RotateBitmap, aber es funktioniert. Auch sind 4 Threads schneller als nur 1 Thread.

Es kann also nicht an Scanline liegen. Diese Methode wird ja jetzt wesentlich mehr verwendet als vorher.
Aber was kann nun die Ursache sein das die alte Methode VergleicheVertikal nicht funktioniert?

Delphi-Quellcode:
  function VerglVertikalNew(bmp0, bmp1: TBitmap; toleranz, SollProz: Integer): double;
  var TempBmp : TBitmap;
  begin
    TempBmp := TBitmap.Create;
    try
      TempBmp.Assign(bmp0);

// RotateBitmap(TempBmp);
// RotateBitmap(bmp1);

      DreheBmpNachRechts(TempBmp,1);
      DreheBmpNachRechts(bmp1, 1);

      result := VergleicheHorizontal(TempBmp, bmp1, toleranz, SollProz);
    finally
      TempBmp.Free;
      end;
  end;
Delphi-Quellcode:
procedure DreheBmpNachRechts(bmp: TBitmap; Anz: integer);
type TMyHelp = array[0..0] of TRGBQuad;
var RowOut : ^TMyHelp;
     P : pRGBQuad; //^THelpRGB;
     x, y, b, h : integer;
     help : TBitmap;
     OldPixForm : TPixelFormat;
     i : integer;
begin
  OldPixForm := bmp.PixelFormat;
  bmp.PixelFormat := pf32bit;
  help := TBitmap.Create;
// Bereichsüberprüfung des Compilers für RowOut[x] ggf. abschalten:
{$IFOPT R+}
{$R-}
{$DEFINE RangCheck}
{$ENDIF}
  try
    help.PixelFormat := pf32bit;
    for i := 1 to Anz do begin
      b := bmp.Height;
      h := bmp.Width;
      help.Width := b;
      help.height := h;
      for y := 0 to (h-1) do begin
        RowOut := help.ScanLine[y];
        P := bmp.scanline[bmp.height-1];
        inc(p,y);
        for x := 0 to (b-1) do begin
          RowOut[x] := p^;
          inc(p,h);
          end;
        end;
      bmp.Assign(help);
      end;
    bmp.PixelFormat := OldPixForm;
  finally
    help.Free;
// Bereichsüberprüfung des Compilers ggf. wieder einschalten:
{$IFDEF RangCheck}
{$R+}
{$UNDEF RangCheck}
{$ENDIF}
    end;
end;
Hat jemand eine Idee?
Grüße
Klaus
Klaus
  Mit Zitat antworten Zitat
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#7

Re: Speed von gleichen Threads unterschiedlich

  Alt 28. Jan 2009, 10:36
Hallo und Hurra,

ich weiß nicht wieso, aber es funktioniert jetzt.
Falls jemand ähnliche Probleme hat, hier meinen Lösung:


Die Fehlermeldungen:
Zitat:
Project Fotoalbum3.exe raised exception class EOutOfResources with message 'Das Handle ist ungültig.
habe ich mit Bitmap.HandleType := bmDDB; wegbekommen.

Das Problem, das 1 Thread schneller als 4 Threads ist habe ich auch wegbekommen. Die Ursche war das Referenzbild mit dem die Bilder in der Liste verglichen wurden. Obwohl ich es im Thread lokal geladen habe, hat vermutlich das "System" dieses Bitmap global verwaltet und die Thread haben sich beim lesen gegeseitig behindert.
Ich lade das Refenz-Bitmap nun beim Start des Threads, werte es aus, speichere die Ergebnisse in einer TList und gebe dieses Bild wieder frei. Dann werden die einzelnen Bilder geladen und mit den in TList gespeicherten Daten verglichen.
Das funktioniert jetzt so wie ich es will.

Viele Grüße

Klaus
Klaus
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#8

Re: Speed von gleichen Threads unterschiedlich

  Alt 28. Jan 2009, 12:09
Für rechenintensive Threads (also Thread, die ausschlieslich im RAM arbeiten und keine I/O-Operationen haben) gilt folgende Regel:
Die Anzahl der Thread soll mit der Anzahl der CPU-Kerne übereinstimmen.

Jeder einzelne Thread kann dann jeweils einen Kern auf 100% Auslastung bringen.
Verwendet man z.B. 4 Threads auf einer CPU mit nur einem Kern, dann ist die Gesamtleistung geringer als mit nur einem Thread.
Dafür gibt es zwei Gründe:
1.) der Overhead für die Threadumschaltung bremst
2.) im Level 1 und Level 2 Cache entstehen mehr Cache Misses als wenn nur ein Thread werkeln würde.
Andreas
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu
Online

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.063 Beiträge
 
Delphi 12 Athens
 
#9

Re: Speed von gleichen Threads unterschiedlich

  Alt 28. Jan 2009, 16:04
Zitat von shmia:
Die Anzahl der Thread soll mit der Anzahl der CPU-Kerne übereinstimmen.

Jeder einzelne Thread kann dann jeweils einen Kern auf 100% Auslastung bringen.
wäre es dann nicht netter, wenn es ein Thread weniger, als CPU-Kerne sind? (bei 'ner Mehrkern-CPU)

dann kann jeder Thread wirklich 100% eines Kernes belegen (man muß nur dafür sorgen, daß sonst kein anderer Prozeß auf denjenigen Kernen läuft und für Windows, sowie die anderen Prozesse, bleibt dennoch etwas rechenleistung übrig)
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat
RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#10

Re: Speed von gleichen Threads unterschiedlich

  Alt 28. Jan 2009, 17:42
Hallo,

Zitat:
Die Anzahl der Thread soll mit der Anzahl der CPU-Kerne übereinstimmen.
Genau so mache ich es. Das Programm ermittelt die Anzahl der Kernen. Ich habe 4.
Bei einem Thread wird 1 CPU-Kern zu fast 100% ausgelastet. Macht ca 25% Gesamtauslastung. Die 4 Threads verteilt Windows automatisch auf je einen Kern. Ich komme da auf eine Gesamtauslastung von ca. 65%, was mehr als doppelt so schnell ist.

Grüße
Klaus.
Klaus
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:24 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz