Maximale Stack Größe reicht nicht

[kub]

Hallo,

ich arbeite an einer Bildverarbeitungsapplikation, bei der ich ein Bild rekursiv untersuche. Bei Megapixel-bildern habe ich das Problem, dass es zu einer Zugriffsverletzung kommt, wenn sehr große Bereiche untersucht werden. Der Grund dafür ist die "Maximale Stackgröße". In den Projektoptionen kann mann höchstens $1000000 einstellen, was aber bei meiner Anwendung nicht reicht.
Mit {$MAXSTACKSIZE 90000000} im code, funktioniert es, wenn ich die so erstellte EXE direkt starte. Starte ich aber aus delphi heraus, bekomme ich wieder eine access violation. Kennt jemand eine Möglichkeit, das irgendwie zu umgehen?

Ich benutze übgrigens Delphi6.

Danke schon mal im Voraus.

Gruß
Thomas

[uligerhardt]

Bevor du an Stackgröße o.ä. drehst, würde ich mir erstmal überlegen, ob ich meinen Algorithmus oder seine Implementierung verbessern kann - lokale Variablen einsparen, Iteration statt Rekursion etc.
Ein Standardproblem bei Stacküberlauf sind vergessene const bei "großen" Übergabeparametern.

[Blup]

Die Bilddaten nicht auf dem Stack schieben, sondern nur eine Referenz auf diese im Speicher.
z.B.:

Delphi-Quellcode:

type
  PRiesigeDaten = ^TRiesigeDaten;
  TRiesigeDaten = record
    Werte: Array[1..unendlich]: Byte;
    NochMehrWerte: Integer;
  end;

procedure RekursiveRiesigeDaten(Daten: PRiesigeDaten);
var
  lDaten: PRiesigeDaten;
begin
  if not Abbruchbedingung then
  begin
    New(lDaten);
    try
      lDaten^ := Daten^;
      RekursiveRiesigeDaten(lDaten);
    finally
      Dispose(lDaten);
    end;
  end;
end;

[kub]

Ich sehe leider keine Möglichkeit die Funktion zu optimieren. Als Parameter übergebe ich nur x und y Koordinate als const integer und habe auch keine lokalen Variablen. Das Bild und die Ergebnisdaten sind Member der Suchklasse und werden nicht übergeben.
Die Funktion sucht zusammenhängende dunkle Bereiche. Das Bild wird dabei Zeile für Zeile nach einem Pixel gesucht, dessen Grauwert unterhalb eines Schwellwerts liegt. Wenn eines gefunden wurde, wird geprüft, ob eines der anliegenden Pixel auch der Bedingung entspricht. Wenn ja, muss ich wieder alle Pixel um dieses kontrollieren. Ich sehe nicht, wie das anders als rekursiv gelöst werden kann.

Delphi-Quellcode:

Procedure blob(const X: integer; const Y: integer);
begin
  if Bild[x][y].Grauwert < Schwellwert then
  begin    
    //gefundenes Pixel bzgl. Extrema und Schwerpunkt der Fläche verarbeiten 
    //..
    //damit Pixel nicht doppelt gezählt wird, Grauwert auf Maxwert (>Schwellwert) setzen
    Bild[x][y].Grauwert:= 255;
    //Umgebung nach weiteren zugehörigen Pixeln untersuchen 
    if (x < Bild.MaxX) then blob(x+1,y);
    if (x > 0) then blob(x-1,y);
    if (y < Bild.MaxY) then blob(x,y+1);
    if (x > 0) then blob(x,y-1);
  end;
end;

Falls jemand noch eine Idee zur Optimierung hat, wäre ich dankbar.

Wenn ich das Programm aus Delphi heraus starte, bekomme ich bis jetzt eine Meldung einer Zugriffsverletzung und dann hängt sich Delphi so auf (100% CPU Auslastung), dass ich es mit dem Task Manager beenden muss. Momentan achte ich darauf, beim Testen keine zu großen Flächen zu untersuchen, finde das aber ziemlich unbefriedigend.

[xZise]

Moin,
wie wäre da eine iterative Lösung?

Du scheinst ja zuerst nach rechts zu gehen, dann wieder zurück etc.? Übrigens bist du dir sicher, dass die letzte if-Bedingung so stimmt? Muss nach nicht y > 0 hin?

MfG
Fabian

[jfheins]

Zitat:

Zitat von kub

Ich sehe nicht, wie das anders als rekursiv gelöst werden kann.

Na ... iterativ?
Du legst dir einen Stack oder eine Queue selber an (also eine liste, der Unterschied ist nur die Art des Zugriffs) und lässt dann eine Schleife laufen - und zwar solange bis die Liste leer ist. Da wo du bis jetzt die Funktion rekursiv aufgerufen hast, schiebst du die Daten einfach in die Liste.

[SirThornberry]

also wenn ich mir den oben geposteten Ausschnitt ansehen werden alle Pixel des Bildes per Rekursion durchlaufen. Ich hab für so etwas bisher immer eine Schleife verwendet (bzw. 2 Schleifen ineinander)
Dadurch würde auch das prüfen das setzen des Grauwert wegfallen was nach meiner Erkenntnis wohl nur gemacht wird um zu verhindern das ein Bildpunkt doppelt behandelt wird.

[kub]

Die letzte Abfrage muss natürlich auf y > 0 prüfen. Ist in meinem eigentlichen Code auch so.

Mit einer einfachen doppelten Schleife kann ich das Problem nicht lösen, da diese Flächen beliebige Formen haben können und es auch mehrere Flächen geben kann, d.h. ich muss wissen welches der Pixel zu welcher Fläche gehört. Bei solchen Formen (2 Blobs) geht es z.B. mit einer Schleife nicht:

XXX
XXX XXX XXX
XXX X XXX
XXXXXXXXX

Wegen dieser Form, muss ich auch immer alle Seiten überprüfen. Klar habe ich hier den Fall, dass ich auch das Pixel prüfe, von dem aus ich die Funktion aufgerufen habe, aber wenn ich das nicht machen möchte, müsste ich übergeben, aus welcher Richtung ich komme und hätte noch einen Parameter mehr, der wieder auf den Stack käme.
Um eine Endlosschleife handelt es sich nicht, da ich ja immer überprüfe, ob der Grauwert unter der schwelle liegt. Wenn er es tut, setzte ich den Wert auf den Maximalgrauwert, d.h. wenn ich wieder auf dieses Pixel zurückkomme wird die Funktion sofort abgebrochen, weil die Bedingung ja jetzt nicht mehr erfüllt ist.

@SirThornberry: Den Schwellwert muss ich immer prüfen, damit ich sehe, ob dieses Pixel zu der Fläche gehört, dessen Schwerpunkt ich ermitteln soll.

[kub]

Das Bild mit den X ging leider voll daneben. Nicht formatiert sah das anders aus. Darum hier ein jpg

[SirThornberry]

Bitte pushe nicht innerhalb von 24 Stunden sondern nutze bitte http://www.delphipraxis.net/template.../icon_edit.gif
2.3.2.4 - In der Ruhe liegt die Kraft: Kein "Pushen" von Beiträgen

[xZise]

Moin,
also ich verstehe gerade dein Problem dabei nicht? Weil Bild ist doch immer rechteckig?

MfG
Fabian

[kub]

Erstmal entschuldigung für das Pushen, was eigentlich von mir gar nicht so gedacht war. Ich wollte einfach das Bild noch einfügen.

@xZise:
Das Bild ist schon rechteckig, aber die gesuchten Bereiche nicht. Wenn ich eine Zeile untersuche, kann ich nicht sagen, zu welchem Bereich die Pixel gehören. Eine Zeile in der Mitte meines Beispielbildes würde z.B. 3 zusammenhängende schwarze Bereiche haben. Die ersten beiden sind weiter unten aber verbunden und gehören deshalb zum selben Bereich, was ich vorher nicht wissen kann. Immer Anfangs- und Endposition der vorherigen Zeile merken und damit in jeder Zeile eventuelle "Vereinigungen" zu ermitteln halte ich für zu aufwendig, da oft auch verrauschte Bilder vorkommen und es so beliebig viele "Löcher" in den Bereichen geben kann, d.h. sehr viele Anfangs- und Endpositionen. Und wie schon gesagt kann ich vorher nicht wissen, wie viele Flächen es gibt und welche Form sie haben.

[himitsu]

Delphi-Quellcode:

Procedure SearchAreas(Threshold: Byte; Image, Map: TBitMap);
  Var LastArea, X, Y, C, C2: Integer;

  Begin
    Map.PixelFormat := pf24bit;
    Map.Width  := Image.Width;
    Map.Height := Image.Height;
    Map.Canvas.Brush.Style := bsSolid;
    Map.Canvas.Brush.Color := 0;
    Map.Canvas.FillRect(Rect(0, 0, Map.Width, Map.Height));
    LastArea := 0;
    For Y := 0 to Image.Height - 1 do
      For X := 0 to Image.Width - 1 do
        If GrayScale(Image.Canvas.Pixels[X, Y]) < Threshold Then Begin
          If Y > 0 Then C := Map.Canvas.Pixels[X, Y - 1] Else C := 0;
          If C <> 0 Then Begin
            Map.Canvas.Pixels[X, Y] := C;
            If X > 0 Then C2 := Map.Canvas.Pixels[X - 1, Y] Else C2 := 0;
            If (C2 <> 0) and (C2 <> C Then Begin
              Map.Canvas.Brush.Color := C;
              Map.Canvas.FloodFill(X - 1, Y, C2, fsSurface);
            End;
            Continue;
          End;

          If X > 0 Then C := Map.Canvas.Pixels[X - 1, Y] Else C := 0;
          If C <> 0 Then Begin
            Map.Canvas.Pixels[X, Y] := C;
            Continue;
          End;

          Inc(LastArea);
          If LastArea = $01000000 Then Raise EOutOfResources.Create('too many areas');
          Map.Canvas.Pixels[X, Y] := LastArea;
        End;
  End;

Jetzt müßte in Map ein Image entstehen, welches alle zusammenhängenden Blöcke enthält

Delphi-Quellcode:

// kein zusammenhängender Bereich in/an diesem Pixel
Map.Canvas.Pixels[X, Y] = 0

// hier ist einer und alle Pixel mit dem selben Farbwert gehören dazu
Map.Canvas.Pixels[X, Y] <> 0

Hier werden zwar auch erstmal die 2 genannten Bereiche getrennt aufgeführt, aber sobald ein Zusammenhang erkannt wird, wird per FloodFill ein Zusammenhang geschaffen.

(FloodFill deswegen, weil es diesen Bereich schneller umfärben kann, als man es manuell via Pixels könnte)

PS: Ich hoffe mal 16777215 verschiedene Indize für die Bereiche reichen aus.

[Uwe Raabe]

@Himitsu: Dein Algorithmus erschließt sich mir leider noch nicht so ganz und bedarf für meinen bescheidenen Geist einer Erklärung. Ich will ja gar nicht abstreiten, daß er funktioniert (hab's nicht probiert), aber wie?

[kub]

Hi,
also die Funktion von Himitsu funktioniert schon. Er kontrolliert bei jedem gültigen Pixel, ob es an eines angrenzt, das schon zu einem Bereich gehört. Wenn ja, färbt er den Bereich mit der aktuellen Farbe ein, d.h. er verbindet diese und sie sind beide unter dem gleichen Index zu finden.

Leider spielt der Zeitbedarf bei meiner Anwendung eine große Rolle. Bei einem Bild mit 1628*1236Pixeln und einer dunklen Fläche mit ca. 1200000Pixeln (der Wert für LastArea aus der Funktion liegt am Ende bei ca. 21500 -> Rauschen) benötigt diese Funktion über 28 Sekunden. Dazu käme dann noch die Zeit für die Auswertung. Meine rekursive Methode benötigt knapp 150Millisekunden für die Erkennung.

Ich habe schon lange über einen anderen Ansatz für die Erkennung nachgedacht, aber keiner brachte annähernd die Leistung wie die rekursive Suche.

Jetzt bin ich wieder bei meinem Problem mit der Stackgröße. Da Arbeitspeicher nicht wirklich das Problem ist, sehe ich eigentlich keinen wirklichen Grund die erlaubte Stackgröße zu ändern. Aber gibt es eine Möglichkeit, dass auch Delphi6 damit fertig wird?

[wicht]

Bin mir jetzt nicht ganz sicher, aber könnte man hier nicht mit ScanLine() arbeiten, um die Performance zu erhöhen, statt immer auf die Pixels-Eigenschaft zuzugreifen?

[jfheins]

Zitat:

Zitat von jfheins

Zitat:

Zitat von kub

Ich sehe nicht, wie das anders als rekursiv gelöst werden kann.

Na ... iterativ?
Du legst dir einen Stack oder eine Queue selber an (also eine liste, der Unterschied ist nur die Art des Zugriffs) und lässt dann eine Schleife laufen - und zwar solange bis die Liste leer ist. Da wo du bis jetzt die Funktion rekursiv aufgerufen hast, schiebst du die Daten einfach in die Liste.

Du kannst jede Rekursion als iteration schrieben und umgekehrt ;)

[himitsu]

Zitat:

Zitat von wicht

Bin mir jetzt nicht ganz sicher

Na da hast'e vollkommen Recht.


hmmmmm, bei M.bmp = dein Bild von Seite 1
und M2.bmp Ergebnis (damit man was besser sieht, wurde an LastArea gedreht)
aber irgendwie hab ich Probleme mit diesem blöden FloddFill und die schrottige OH ist da garkeine Hilfe, da dort absolut nix drinsteht in D2010 :evil: .

Delphi-Quellcode:

Uses Types, SysUtils, Graphics;

Procedure SearchAreas(Threshold: Byte; Image, Map: TBitMap);
  Function GetGray(Const C: TColor): Byte; //Inline;
    Begin
      Result := (C and $FF + (C shr 8) and $FF + (C shr 16) and $FF) div 3;
    End;

  Type TColorArr = packed Array[0..0] of TColor;

  Var LastArea, Xc, X, Y: Integer;
    C, C2: TColor;
    ILine, MLineB, MLine: ^TColorArr;

  Begin
    Image.PixelFormat := pf32bit;
    Map.PixelFormat := pf32bit;
    Map.Width  := Image.Width;
    Map.Height := Image.Height;
    Map.Canvas.Brush.Style := bsSolid;
    Map.Canvas.Brush.Color := 0;
    Map.Canvas.FillRect(Rect(0, 0, Map.Width, Map.Height));
    LastArea := 0;
    MLine := nil;
    Xc := Image.Width - 1;
    For Y := 0 to Image.Height - 1 do Begin
      MLineB := MLine;
      ILine  := Image.ScanLine[Y];
      MLine  := Map.ScanLine[Y];
      For X := 0 to Xc do
        If GetGray(ILine[X]) < Threshold Then Begin
          If Assigned(MLineB) Then C := MLineB[X] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            If X > 0 Then C2 := MLine[X - 1] Else C2 := 0;
            If (C2 <> 0) and (C2 <> C) Then Begin
              Map.Canvas.Brush.Color := C;
              Map.Canvas.FloodFill(X, Y, C2, fsSurface);
            End;
            Continue;
          End;

          If X > 0 Then C := MLine[X - 1] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            Continue;
          End;

          Inc(LastArea, 85);  //Inc(LastArea);
          If LastArea = $01000000 Then Raise EOverflow.Create('too many areas');
          MLine[X] := LastArea;
        End;
    End;
    Map.PixelFormat := pf24bit;
  End;

Var I, M: TBitMap;

Begin
  I := TBitmap.Create;
  M := TBitmap.Create;
  I.LoadFromFile('M.bmp');
  SearchAreas(100, I, M);
  M.SaveToFile('M2.bmp');
  M.Free;
  I.Free;
End.

Vorteil hierbei ist allerdings, daß man nur einmal suchen lassen muß und dann gleich alle Felder gefunden werden.

[Blup]

Im ungünstigsten Fall wird FloodFill mehrmals für die selbe Fläche aufgerufen.
Warum dann nicht gleich ein abgewandeltes FloodFill schreiben, das sein Ergebnis in die Map einträgt.

Anregung dazu: http://www.codeproject.com/KB/GDI/QuickFill.aspx

[himitsu]

Zitat:

Zitat von Blup

Im ungünstigsten Fall wird FloodFill mehrmals für die selbe Fläche aufgerufen.
Warum dann nicht gleich ein abgewandeltes FloodFill schreiben, das sein Ergebnis in die Map einträgt.

Anregung dazu: http://www.codeproject.com/KB/GDI/QuickFill.aspx

Da die Farbe komplett umgefärbt werden sollte, stimmen danach die Farben überein und FloodFill würde nur einmal auf diese Fläche losgelassen.

[kub]

Guten Morgen.

Ich habe die neue Funktion von Himitsu ausprobiert. Hier werden einzelne große Flächen in vertikale Streifen aufgeteilt. Den Fehler habe ich nicht gefunden. Ein Durchlauf dauert hier bei meinem Bild ca. 300 Millisekunden.

Danach habe ich noch einmal die Idee von jfheins aufgegriffen und meine Funktion umgeschrieben und iterativ mit einem Array gearbeitet. Das geht wunderbar und ist sogar noch schneller als der rekursive Ansatz.

Im Moment brauche ich nur die Daten der gefundenen Bereiche und das so schnell wie möglich. Wenn einmal gefordert ist, dass ich die Bereiche im Bild anzeigen muss, werde ich wahrscheinlich noch mal auf Himitsus Ansatz zurückkommen.

Falls jemanden die Funktion interessiert:
Die Funktionen für den Zugriff auf die Pixel sind Teil einer anderen Klasse, die ich hier aber nicht veröffentlichen kann.

Delphi-Quellcode:

var
  Points: Array of TPoint;

procedure init;
begin  
  ImgWidth:= Image.Width;
  ImgHeight:= Image.Height;
  //Array größe = 4*Pixelanzahl, da im worst case auf jedes Pixel von jeder Seite zugegriffen wird.
  SetLength(Points,4*ImgWidth*ImgHeight);
end;

procedure SearchBlob;
var
  x,y: integer;
  MeanX, MeanY: double;
  index: integer;
  ListCount: integer;
  count: integer;
  s: string;
  imgo:pointer;
begin
  For Y := 0 to ImgHeight - 1 do
  begin
    For X := 0 to ImgWidth - 1 do
    begin
      if GetGrayVal(x,y) < Threshold) then
      Begin
        index:=0;
        ListCount:= 0;
        MeanX:= 0;
        MeanY:= 0;
        count:= 0;
        //Startpunkt in Liste aufnehmen
        Points[ListCount].X:= x;
        Points[ListCount].Y:= y;
        //Liste abarbeiten
        Repeat
          //Wenn Pixel dunkel, dann Position aufnehmen und umgebende Punke in die Liste aufnehmen
          if GetGrayVal(Points[index].X,Points[index].Y) <= Threshold) then
          begin
            MeanX:= MeanX + Points[index].X;
            MeanY:= MeanY + Points[index].Y;
            inc(Count);
            GrayVal[Points[index].X][Points[index].Y]:= 255;
            //umgebende Punke zur Liste hinzufügen
            if (Points[index].x < ImgWidth-1) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X + 1;
              Points[ListCount].Y:= Points[index].Y;
            end;
            if (Points[index].x > 0) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X - 1;
              Points[ListCount].Y:= Points[index].Y;
            end;
            if (Points[index].y < ImgHeight-1) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X;
              Points[ListCount].Y:= Points[index].Y + 1;
            end;
            if (Points[index].y > 0) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X;
              Points[ListCount].Y:= Points[index].Y - 1;
            end;
          end;
          inc(index);
        Until index >= ListCount;
        //zu kleine Flächen ignorieren
        if Count > 100 then
        begin
          MeanX:= MeanX/Count;
          MeanY:= MeanY/Count;
          s:= 'Position: X=' + FormatFloat('0.0',MeanX)
                 + ' ; Y=' + FormatFloat('0.0',MeanY)
                 + ' ; S=' + IntToStr(Count);
          ResultList.Add(s);
        end;
      end;
    end;
  end;
end;

Damit ist mein Problem gelöst. Vielen Dank an alle für Eure Hilfe!!

Gruß
Thomas

[himitsu]

Problem gefunden: Die Bytes der Farben liegen im Bitmap andersrum, als wie in TColor.

In welchem Format liegt eigentlich dein Bild vor?
(man sieht ja nicht, was sich hinter GetGrayVal versteckt)

Und das Map-Image hab ich vorwiegend als Ausgabeformat genutzt, weil es einfach nur "einfach" zu handhaben ist ... ein anderes Format wäre auch "leicht" realisierbar.

Delphi-Quellcode:

Uses Types, SysUtils, Graphics;

Procedure SearchAreas(Threshold: Byte; Image, Map: TBitMap);
  Function GetGray(Const C: TColor): Byte; //Inline;
    Begin
      Result := (C and $FF + (C shr 8) and $FF + (C shr 16) and $FF) div 3;
    End;

  Function SwapBytes(C: TColor): TColor; //Inline;
    Begin
      Result := (C and $0000FF) shl 16 or C and $00FF00 or (C and $FF0000) shr 16;
    End;

  Type TColorArr = packed Array[0..0] of TColor;

  Var LastArea, Xc, X, Y: Integer;
    C, C2: TColor;
    ILine, MLineB, MLine: ^TColorArr;

  Begin
    Image.PixelFormat := pf32bit;
    Map.PixelFormat := pf32bit;
    Map.Width  := Image.Width;
    Map.Height := Image.Height;
    Map.Canvas.Brush.Style := bsSolid;
    Map.Canvas.Brush.Color := 0;
    Map.Canvas.FillRect(Rect(0, 0, Map.Width, Map.Height));
    LastArea := 0;
    MLine := nil;
    Xc := Image.Width - 1;
    For Y := 0 to Image.Height - 1 do Begin
      MLineB := MLine;
      ILine  := Image.ScanLine[Y];
      MLine  := Map.ScanLine[Y];
      For X := 0 to Xc do
        If GetGray(ILine[X]) < Threshold Then Begin
          If Assigned(MLineB) Then C := MLineB[X] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            If X > 0 Then C2 := MLine[X - 1] Else C2 := 0;
            If (C2 <> 0) and (C2 <> C) Then Begin
              Map.Canvas.Brush.Color := SwapBytes(C2);
              Map.Canvas.FloodFill(X, Y, SwapBytes(C), fsSurface);
            End;
            Continue;
          End;

          If X > 0 Then C := MLine[X - 1] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            Continue;
          End;

          Inc(LastArea);
          If LastArea = $01000000 Then Raise EOverflow.Create('too many areas');
          MLine[X] := SwapBytes(LastArea);
        End;
    End;
    Map.PixelFormat := pf24bit;
  End;

Var I, M: TBitMap;

Begin
  I := TBitmap.Create;
  M := TBitmap.Create;
  I.LoadFromFile('M.bmp');
  SearchAreas(100, I, M);
  M.SaveToFile('M2.bmp');
  M.Free;
  I.Free;
End.

[edit]
hab mal ein kleines Testprojekt angehängt, welches einen etwas veränderten Code beinhaltet.

[kub]

@Himitsu
Es handelt sich um ein 8Bit Graustufen bmp. Beim Kunden hängt eine Monochromkamera am Rechner, deren Bilder ich auswerte.
Das Ausgabeformat deiner Funktion finde ich gut. Deine neue Version funktioniert. Für meine jetzige Anwendung ist sie aber nicht schnell genug. Bei dem Bild im Anhang dauert die Ausführung bei mir ca. 900ms. Trotzdem danke