Zahlen in Bild erkennen mit Pixelsearch - Genauigkeitsprob.

[mschaefer]

Vor Jahren gab es da mal einen Jugend forscht Beitrag und da hatte der Kandidat an den erkannten Objekten die Ecken Schnittpunkte und Rundungen gezählt. Das geht aber nur wenn sich die Zeichen nicht überlappen.

[MaToBe]

Heyho,

ich muss mich doch noch mal hier melden.

Ich habe mit eurer Hilfe folgenden Code zusammengeschrieben, um ein Bild eines Sudokus in ein SringGrind einzulesen.

Delphi-Quellcode:

//Sudoku einlesen
procedure TfrmScreen.SudokuEinlesen;
var m, n, x, y, h1, h2: integer;
begin
   h1 := 1;
   h2 := 1;
   x := xS;
   y := yS;

   for m := 0 to 8 do
   begin
     for n := 0 to 8 do
     begin
       if h1 <> 3 then
       begin
          sgSudoku.Cells[n,m] := PixelsearchBW(x,y);
          x := x + 29;
          inc(h1);
       end
       else
       begin
          sgSudoku.Cells[n,m] := PixelsearchBW(x,y);
          x := x + 32;
          h1 := 1;
       end;
     end;
     h1 := 1;

     if h2 <> 3 then
     begin
        y := y + 29;
        x := xS;
        inc(h2);
     end
     else
     begin
        y := y + 32;
        x := xS;
        h2 := 1;
     end;
   end;
end;


// Pixelsearch - Sucht im imgSudokuBW (Schwarz-Weiß Bild) die einzelnen Ziffern
function TfrmScreen.PixelSearchBW(x:integer; y:integer):string;
var m, n : integer;
    Abweichung_1, Abweichung_2, Abweichung_3, Abweichung_4,
    Abweichung_5, Abweichung_6, Abweichung_7, Abweichung_8,
    Abweichung_9 : real;
    kleinste : array[1..9] of real;
    kleinsteP : integer;
    i : integer;
    AnzahlSchwarz : integer;
begin
  Abweichung_1 := 0;
  Abweichung_2 := 0;
  Abweichung_3 := 0;
  Abweichung_4 := 0;
  Abweichung_5 := 0;
  Abweichung_6 := 0;
  Abweichung_7 := 0;
  Abweichung_8 := 0;
  Abweichung_9 := 0;
  AnzahlSchwarz := 0;

  for m := x to x+25 do
  begin
     for n := y to y+25 do
     begin
         Abweichung_1 := Abweichung_1 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img1.Canvas.Pixels[m-x,n-y]));
         Abweichung_2 := Abweichung_2 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img2.Canvas.Pixels[m-x,n-y]));
         Abweichung_3 := Abweichung_3 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img3.Canvas.Pixels[m-x,n-y]));
         Abweichung_4 := Abweichung_4 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img4.Canvas.Pixels[m-x,n-y]));
         Abweichung_5 := Abweichung_5 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img5.Canvas.Pixels[m-x,n-y]));
         Abweichung_6 := Abweichung_6 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img6.Canvas.Pixels[m-x,n-y]));
         Abweichung_7 := Abweichung_7 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img7.Canvas.Pixels[m-x,n-y]));
         Abweichung_8 := Abweichung_8 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img8.Canvas.Pixels[m-x,n-y]));
         Abweichung_9 := Abweichung_9 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img9.Canvas.Pixels[m-x,n-y]));

         if imgSudokuBW.Canvas.Pixels[m,n] = clBlack then
            inc(AnzahlSchwarz);

         //imgSudokuBW.Canvas.Pixels[m,n] := clRed;
     end;
  end;

  kleinste[1] := Abweichung_1 / (255*26*26);
  kleinste[2] := Abweichung_2 / (255*26*26);
  kleinste[3] := Abweichung_3 / (255*26*26);
  kleinste[4] := Abweichung_4 / (255*26*26);
  kleinste[5] := Abweichung_5 / (255*26*26);
  kleinste[6] := Abweichung_6 / (255*26*26);
  kleinste[7] := Abweichung_7 / (255*26*26);
  kleinste[8] := Abweichung_8 / (255*26*26);
  kleinste[9] := Abweichung_9 / (255*26*26);

  if AnzahlSchwarz <> 0 then
  begin
    kleinsteP := 1;
    for I := 2 to 9 do
    begin
       if kleinste[i] < kleinste[kleinsteP] then
          kleinsteP := i;
    end;
    Result := inttostr(kleinsteP);
  end
  else
    Result := '0';

end;

Vom Prinzip her tut der Code genau was er soll, aber es dauert mir zu lange. Für ein normales Sudoku braucht er etwa 2-3 Sekunden.

Deshalb möchte ich ihn nun optimieren und schneller bekommen.

Ich habe gehört/gelesen, dass Scanline bedeutend schneller arbeitet, doch leider habe ich keine Ahnung wie Scanline funtioniert. Pixelsearch war so schön einfach und anschaulich...

[MaToBe]

Ergänzung:

Ich habe folgende beide Algorithmen gefunden, aber als ich sie testweise implementieren wollte gab es bei beiden einen Fehler

"Bereichsüberschreitung bei Zeilenindex"

Klick 1
Klick 2

Ehrlichgesagt verstehe ich das nicht ganz weil beide Algoithmen ja schon vor längerer Zeit gepostet wurden und von diversen Personen getestet wurde. Andererseits habe ich es meiner Meinung nach richtig implementiert.

Sagt der Fehler, dass eine Schleife weiter läuft als sie eigentlich dürfte?

[Blup]

Eigentlich schon, aber ohne deinen Quellcode zu sehen ...

[MaToBe]

Delphi-Quellcode:

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..31] of TRGBTriple;
...
//Mein Code
// Pixelsearch - Sucht im imgSudokuBW (Schwarz-Weiß Bild) die einzelnen Ziffern
function TfrmScreen.PixelSearchBW(x:integer; y:integer):string;
var m, n : integer;
    kleinste : array[1..9] of real;
    kleinsteP : integer;
    i : integer;
    AnzahlSchwarz : integer;
begin

  AnzahlSchwarz := 0;
//
  for m := x to x+25 do
  begin
     for n := y to y+25 do
     begin
         if imgSudokuBW.Canvas.Pixels[m,n] = clBlack then
            inc(AnzahlSchwarz);

         //imgSudokuBW.Canvas.Pixels[m,n] := clRed;
     end;
  end;

  kleinste[1] := zncc(imgSudokuBW.Picture.Bitmap, img1.Picture.Bitmap);
  kleinste[2] := zncc(imgSudokuBW.Picture.Bitmap, img2.Picture.Bitmap);
  kleinste[3] := zncc(imgSudokuBW.Picture.Bitmap, img3.Picture.Bitmap);
  kleinste[4] := zncc(imgSudokuBW.Picture.Bitmap, img4.Picture.Bitmap);
  kleinste[5] := zncc(imgSudokuBW.Picture.Bitmap, img5.Picture.Bitmap);
  kleinste[6] := zncc(imgSudokuBW.Picture.Bitmap, img6.Picture.Bitmap);
  kleinste[7] := zncc(imgSudokuBW.Picture.Bitmap, img7.Picture.Bitmap);
  kleinste[8] := zncc(imgSudokuBW.Picture.Bitmap, img8.Picture.Bitmap);
  kleinste[9] := zncc(imgSudokuBW.Picture.Bitmap, img9.Picture.Bitmap);

  if AnzahlSchwarz <> 0 then
  begin
    kleinsteP := 1;
    for I := 2 to 9 do
    begin
       if kleinste[i] > kleinste[kleinsteP] then
          kleinsteP := i;
    end;
    Result := inttostr(kleinsteP);
  end
  else
    Result := '0';

end;

//Der Code aus dem Algorithmus-Thread
// ZeroMeanNormalizedCross-Correlation (ZNCC) (wird MAXIMAL bei guter Übereinstimmung)

function TfrmScreen.ZNCC(Bild1, Bild2: TBitmap):Single;
var
  x, y:integer;
  P1,P2:array[0..31] of PRGBTripleArray;

  a, b, zaehler, nenner1, nenner2, nenner, summe1, summe2, mean1, mean2:single;

  ZNCCvalue:Extended;
begin
  // ZeroMeanNormalizedCross-Correlation (ZNCC) (wird MAXIMAL bei guter Übereinstimmung)
  zaehler:=0.0;
  nenner1:=0.0;
  nenner2:=0.0;
  summe1:=0.0;
  summe2:=0.0;

  // Bildformat auf 24bit setzen (also ohne Alpha-Kanal)
  Bild1.PixelFormat := pf24bit;
  Bild2.PixelFormat := pf24bit;

  // Summen bilden
  for y:=0 to Bild1.Height-1 do
  begin
    P1[y]:=Bild1.ScanLine[y];
    P2[y]:=Bild2.ScanLine[y];

    for x:=0 to Bild1.Width-1 do
    begin
      summe1:=summe1+RGB2TColor(P1[y][x].rgbtRed, P1[y][x].rgbtGreen, P1[y][x].rgbtBlue);
      summe2:=summe2+RGB2TColor(P2[y][x].rgbtRed, P2[y][x].rgbtGreen, P2[y][x].rgbtBlue);
    end;
  end;

  mean1:=(1/power((Bild1.Width-1)+(Bild1.Height-1)+1,2))*summe1;
  mean2:=(1/power((Bild1.Width-1)+(Bild1.Height-1)+1,2))*summe2;
  for x:=0 to Bild1.Width-1 do
  begin
    for y:=0 to Bild1.Height-1 do
    begin
      a:=RGB2TColor(P1[y][x].rgbtRed, P1[y][x].rgbtGreen, P1[y][x].rgbtBlue)-mean1;
      b:=RGB2TColor(P2[y][x].rgbtRed, P2[y][x].rgbtGreen, P2[y][x].rgbtBlue)-mean2;
      zaehler:=zaehler+(a*b);
      nenner1:=nenner1+power(a, 2);
      nenner2:=nenner2+power(b, 2);
    end;
  end;
  nenner:=sqrt(nenner1*nenner2);

  if nenner>0 then
    ZNCCvalue:=zaehler/nenner
  else
    ZNCCvalue:=0.0;

  result:=ZNCCvalue*100;
end;

procedure TfrmScreen.TColor2RGB(const Color: TColor; var  R, G, B: Byte);
begin
  // convert hexa-decimal values to RGB
  R := Color and $FF;
  G := (Color shr 8) and $FF;
  B := (Color shr 16) and $FF;
end;

function TfrmScreen.RGB2TColor(const R, G, B: Byte): Integer;
begin
  // convert hexa-decimal values to RGB
  Result := R + G shl 8 + B shl 16;
end;

[Blup]

Der Code vergleicht zwei Bilder gleicher Größer von maximal 32*32 Pixeln.
Die erste Hälfte des Code soll dazu dienen, unterschiedliche Helligkeit der beiden Bilder auszugleichen. Allerdings werden einfach TColor-Werte addiert, das funktioniert nur mit Bildern in Graustufen.

[MaToBe]

das kann doch irgendwie aber nicht hinhaun was du da sagst.

Die Beschreibung zu dem Code von Christian Noeding lautet:

Zitat:

Auf der Suche nach einer Möglichkeit, mehrere Bilder miteinander zu vergleichen bin ich auf die Kreuz-Korrelation gestoßen. Mit dem folgenden Algorithmus kann man zwei Canvas beliebiger Größe miteinander vergleichen und bekommt das Ergebnis als Prozentwert der Übereinstimmung zurück. 100% bedeutet demnach perfekte Übereinstimmung.

[Blup]

Der Algorithmus ist im Prinzip für beliebige Größe geeignet, der Quellcode ist es nicht.

[MaToBe]

mmh tschuldigung das ich hier dauernd hin und her springe. Ich habe meinen Code jetzt mal versucht, von Pixel[x,y] auf Scanline umzustellen.

Alter Code - lief wunderbar nur zu langsam:

Delphi-Quellcode:

// Pixelsearch - Sucht im imgSudokuBW (Schwarz-Weiß Bild) die einzelnen Ziffern
function TfrmScreen.PixelSearchBW(x:integer; y:integer):string;
var m, n : integer;
    Abweichung_1, Abweichung_2, Abweichung_3, Abweichung_4,
    Abweichung_5, Abweichung_6, Abweichung_7, Abweichung_8,
    Abweichung_9 : real;
    kleinste : array[1..9] of real;
    kleinsteP : integer;
    i : integer;
    AnzahlSchwarz : integer;
begin
  Abweichung_1 := 0;
  Abweichung_2 := 0;
  Abweichung_3 := 0;
  Abweichung_4 := 0;
  Abweichung_5 := 0;
  Abweichung_6 := 0;
  Abweichung_7 := 0;
  Abweichung_8 := 0;
  Abweichung_9 := 0;
  AnzahlSchwarz := 0;

  for m := x to x+25 do
  begin
     for n := y to y+25 do
     begin
         Abweichung_1 := Abweichung_1 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img1.Canvas.Pixels[m-x,n-y]));
         Abweichung_2 := Abweichung_2 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img2.Canvas.Pixels[m-x,n-y]));
         Abweichung_3 := Abweichung_3 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img3.Canvas.Pixels[m-x,n-y]));
         Abweichung_4 := Abweichung_4 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img4.Canvas.Pixels[m-x,n-y]));
         Abweichung_5 := Abweichung_5 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img5.Canvas.Pixels[m-x,n-y]));
         Abweichung_6 := Abweichung_6 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img6.Canvas.Pixels[m-x,n-y]));
         Abweichung_7 := Abweichung_7 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img7.Canvas.Pixels[m-x,n-y]));
         Abweichung_8 := Abweichung_8 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img8.Canvas.Pixels[m-x,n-y]));
         Abweichung_9 := Abweichung_9 + Abs(GetRValue(imgSudokuBW.Canvas.Pixels[m,n]) - GetRValue(img9.Canvas.Pixels[m-x,n-y]));

         if imgSudokuBW.Canvas.Pixels[m,n] = clBlack then
            inc(AnzahlSchwarz);

         //imgSudokuBW.Canvas.Pixels[m,n] := clRed;
     end;
  end;

  kleinste[1] := Abweichung_1 / (255*26*26);
  kleinste[2] := Abweichung_2 / (255*26*26);
  kleinste[3] := Abweichung_3 / (255*26*26);
  kleinste[4] := Abweichung_4 / (255*26*26);
  kleinste[5] := Abweichung_5 / (255*26*26);
  kleinste[6] := Abweichung_6 / (255*26*26);
  kleinste[7] := Abweichung_7 / (255*26*26);
  kleinste[8] := Abweichung_8 / (255*26*26);
  kleinste[9] := Abweichung_9 / (255*26*26);

  if AnzahlSchwarz <> 0 then
  begin
    kleinsteP := 1;
    for I := 2 to 9 do
    begin
       if kleinste[i] < kleinste[kleinsteP] then
          kleinsteP := i;
    end;
    Result := inttostr(kleinsteP);
  end
  else
    Result := '0';

end;

Neuer Code - leider kaum schneller und liefert Falsche Zahlenwerte als Result zurück!

Delphi-Quellcode:

// Pixelsearch - Sucht im imgSudokuBW (Schwarz-Weiß Bild) die einzelnen Ziffern
function TfrmScreen.PixelSearchBW(x:integer; y:integer):string;
var m, n : integer;
    Abweichung_1, Abweichung_2, Abweichung_3, Abweichung_4,
    Abweichung_5, Abweichung_6, Abweichung_7, Abweichung_8,
    Abweichung_9 : real;
    kleinste : array[1..9] of real;
    kleinsteP : integer;
    i : integer;
    AnzahlSchwarz : integer;
    P, P1, P2, P3, P4,
    P5, P6, P7, P8, P9 : PByteArray;
begin
  Abweichung_1 := 0;
  Abweichung_2 := 0;
  Abweichung_3 := 0;
  Abweichung_4 := 0;
  Abweichung_5 := 0;
  Abweichung_6 := 0;
  Abweichung_7 := 0;
  Abweichung_8 := 0;
  Abweichung_9 := 0;
  AnzahlSchwarz := 0;

  imgSudokuBW.Picture.Bitmap.PixelFormat:= pf24Bit;

  for m := x to x+25 do
  begin
     P :=  imgSudokuBW.Picture.Bitmap.ScanLine[m];
     P1 := img1.Picture.Bitmap.ScanLine[m-x];
     P2 := img2.Picture.Bitmap.ScanLine[m-x];
     P3 := img3.Picture.Bitmap.ScanLine[m-x];
     P4 := img4.Picture.Bitmap.ScanLine[m-x];
     P5 := img5.Picture.Bitmap.ScanLine[m-x];
     P6 := img6.Picture.Bitmap.ScanLine[m-x];
     P7 := img7.Picture.Bitmap.ScanLine[m-x];
     P8 := img8.Picture.Bitmap.ScanLine[m-x];
     P9 := img9.Picture.Bitmap.ScanLine[m-x];
     for n := y to y+25 do
     begin
         Abweichung_1 := Abweichung_1 + Abs(GetRValue(P[n]) - GetRValue(P1[n-y]));
         Abweichung_2 := Abweichung_2 + Abs(GetRValue(P[n]) - GetRValue(P2[n-y]));
         Abweichung_3 := Abweichung_3 + Abs(GetRValue(P[n]) - GetRValue(P3[n-y]));
         Abweichung_4 := Abweichung_4 + Abs(GetRValue(P[n]) - GetRValue(P4[n-y]));
         Abweichung_5 := Abweichung_5 + Abs(GetRValue(P[n]) - GetRValue(P5[n-y]));
         Abweichung_6 := Abweichung_6 + Abs(GetRValue(P[n]) - GetRValue(P6[n-y]));
         Abweichung_7 := Abweichung_7 + Abs(GetRValue(P[n]) - GetRValue(P7[n-y]));
         Abweichung_8 := Abweichung_8 + Abs(GetRValue(P[n]) - GetRValue(P8[n-y]));
         Abweichung_9 := Abweichung_9 + Abs(GetRValue(P[n]) - GetRValue(P9[n-y]));

         if P[n] = clBlack then
            inc(AnzahlSchwarz);

         //imgSudokuBW.Canvas.Pixels[m,n] := clRed;
     end;
  end;

  kleinste[1] := Abweichung_1 / (255*26*26);
  kleinste[2] := Abweichung_2 / (255*26*26);
  kleinste[3] := Abweichung_3 / (255*26*26);
  kleinste[4] := Abweichung_4 / (255*26*26);
  kleinste[5] := Abweichung_5 / (255*26*26);
  kleinste[6] := Abweichung_6 / (255*26*26);
  kleinste[7] := Abweichung_7 / (255*26*26);
  kleinste[8] := Abweichung_8 / (255*26*26);
  kleinste[9] := Abweichung_9 / (255*26*26);

  if AnzahlSchwarz <> 0 then
  begin
    kleinsteP := 1;
    for I := 2 to 9 do
    begin
       if kleinste[i] < kleinste[kleinsteP] then
          kleinsteP := i;
    end;
    Result := inttostr(kleinsteP);
  end
  else
    Result := '0';

end;

Die Images 1 bis 9 werden auch auf pf24Bit gesetzt.

Warum funktioniert nach der Umstellung (habe wirklich nur diese eine Funktion geändert) mein Code nicht mehr?

Einen großen Performancegewinn habe ich auch nicht...

[Blup]

Du wirfst da einiges durcheinander, verwechselst Zeilen und Spalten, berücksichtigst nicht das 3 Byte zusammen die Farbe eines Pixel bestimmen, vergleichst Byte mit TColor...

Natürlich nicht getestet:

Delphi-Quellcode:

type
  TBGR = packed record
    B, G, R: Byte;
  end;

// Pixelsearch - Sucht im imgSudokuBW (Schwarz-Weiß Bild) die einzelnen Ziffern
function PixelSearchBW(x:integer; y:integer):string;
const
  XCOUNT = 26;
  YCOUNT = 26;
var
  m, n, i, kleinste: integer;
  AnzahlSchwarz : integer;
  Pixel : ^TBGR;
  RedValue: Integer;
  Ziffer: array[1..9] of record
    Bitmap: TBitmap;
    Pixel: ^TBGR;
    Abweichung: Real;
  end;
begin
  imgSudokuBW.Picture.Bitmap.PixelFormat:= pf24Bit;
  AnzahlSchwarz := 0;
  for i := Min(Ziffer) to Max(Ziffer) do
  begin
    with Ziffer[i] do
    begin
      case i of
        1: Bitmap := img1.Picture.Bitmap;
        2: Bitmap := img2.Picture.Bitmap;
        3: Bitmap := img3.Picture.Bitmap;
        4: Bitmap := img4.Picture.Bitmap;
        5: Bitmap := img5.Picture.Bitmap;
        6: Bitmap := img6.Picture.Bitmap;
        7: Bitmap := img7.Picture.Bitmap;
        8: Bitmap := img8.Picture.Bitmap;
        9: Bitmap := img9.Picture.Bitmap;
      else
        Abort;
      end;
      Bitmap.PixelFormat:= pf24Bit;
      Abweichung := 0;
    end;
  end;

  for n := 0 to YCOUNT - 1 do
  begin
    {Pixel verweist auf erste Zeile und erste Spalte}
    for i := Min(Ziffer) to Max(Ziffer) do
      Ziffer[i].Pixel := Ziffer[i].ScanLine[n];
    {Pixel verweist auf erste Zeile und erste Spalte im untersuchten Bereich}
    Pixel := imgSudokuBW.Picture.Bitmap.ScanLine[n + y];
    Inc(Pixel, x);
    for m := 0 to XCOUNT - 1 do
    begin
      {nur den Rotanteil vergleichen (Warum nicht die Gesamthelligkeit?)}
      RedValue := Pixel^.R;
      for i := Min(Ziffer) to Max(Ziffer) do
      begin
        with Ziffer[i] do
        begin
          Abweichung := Abweichung + Abs(Pixel^.R - RedValue);
          {Zeiger auf die nächste Spalte setzen}
          Inc(Pixel);
        end;
      end;

      if (Pixel^.B = 0) and (Pixel^.G = 0) and (Pixel^.R = 0) then
        Inc(AnzahlSchwarz);
      {Zeiger auf die nächste Spalte setzen}
      Inc(Pixel);
    end;
  end;

  if AnzahlSchwarz = 0 then
    Result := '0'
  else
  begin
    kleinste := Min(Ziffer);
    for i := kleinste + 1 to Max(Ziffer) do
    begin
       if Ziffer[i].Abweichung < Ziffer[kleinste].Abweichung then
         kleinste := i;
    end;
    Result := IntToStr(kleinste);
  end;
end;