Maximale Stack Größe reicht nicht

[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 von jfheins:

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 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 .

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 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.