Bildbearbeitung - Finden von Rechtecken oder linearen Funktionen

  • VB.NET

Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von SKeks.

    Bildbearbeitung - Finden von Rechtecken oder linearen Funktionen

    Hallo zusammen,

    ich habe mir folgendes Ziel in den Kopf gesetzt:

    Ich möchte in einem Bild, welches in der Art wie das unten zu sehende Original aussieht, aber bei dem die Freiformen unterschiedlich angeordnet sein können und auch die Anzahl unterschiedlich sein kann, lineare Funktionen detektieren.
    Bisher habe ich mittels einer Sobel Faltung das Bild (siehe Code) in ein Bytearray überführt um die Kanten zu finden, siehe Bild Sobel.

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Image
    2. Private _image As New Image()
    3. Public ReadOnly Property Image As ImageSource
    4. Get
    5. Return _image.Source
    6. End Get
    7. End Property
    8. Public Sub New(img As BitmapImage)
    9. Dim grayBmp = ConvertToGrayscale(img)
    10. Dim threshold As Integer = 400
    11. Dim stride = CInt(grayBmp.PixelWidth * grayBmp.Format.BitsPerPixel / 2)
    12. stride += (stride Mod 4) * 4
    13. Dim pixelLength As Integer = CInt(stride * grayBmp.PixelHeight * grayBmp.Format.BitsPerPixel / 2 - 1)
    14. Dim picture As Byte() = New Byte(pixelLength) {}
    15. Dim filterPicture As Byte() = New Byte(pixelLength) {}
    16. grayBmp.CopyPixels(picture, stride, 0)
    17. Dim height As Integer = grayBmp.PixelHeight - 1
    18. Dim width As Integer = Convert.ToInt32((grayBmp.Width - 1) * grayBmp.Format.BitsPerPixel)
    19. filterPicture = SobelConvolution(picture, pixelLength, height, width, stride, threshold)
    20. _image.Source = BitmapSource.Create(grayBmp.PixelWidth, grayBmp.PixelHeight, grayBmp.DpiX, grayBmp.DpiY, PixelFormats.Gray8, Nothing, filterPicture, stride)
    21. End Sub
    22. Private Function ConvertToGrayscale(original As BitmapImage) As FormatConvertedBitmap
    23. Dim grayBitmap As FormatConvertedBitmap = New FormatConvertedBitmap()
    24. grayBitmap.BeginInit()
    25. grayBitmap.Source = original
    26. grayBitmap.DestinationFormat = PixelFormats.Gray8
    27. grayBitmap.EndInit()
    28. Return grayBitmap
    29. End Function
    30. Private Function SobelConvolution(pictureArray As Byte(), length As Integer, height As Integer, width As Integer, stride As Integer, threshold As Integer) As Byte()
    31. Dim byteArray As Byte() = New Byte(length) {}
    32. Dim sx, sy, s As Double
    33. ' Sobel-Feldmann convolution operators:
    34. ' sobel_x = [1,0,-1] sobel_y =[ 1, 2, 1]
    35. ' [2,0,-2] [ 0, 0, 0]
    36. ' [1,0,-1] [-1,-2,-1]
    37. For x = 1 To height - 1
    38. For y = 1 To width - 1
    39. sx = 1 * GetPixelFromArray(y - 1, x, pictureArray, stride) +
    40. 2 * GetPixelFromArray(y, x + 1, pictureArray, stride) +
    41. 1 * GetPixelFromArray(y + 1, x + 1, pictureArray, stride) +
    42. -1 * GetPixelFromArray(y - 1, x - 1, pictureArray, stride) +
    43. -2 * GetPixelFromArray(y, x - 1, pictureArray, stride) +
    44. -1 * GetPixelFromArray(y + 1, x - 1, pictureArray, stride)
    45. sy = +1 * GetPixelFromArray(y + 1, x + 1, pictureArray, stride) +
    46. -1 * GetPixelFromArray(y - 1, x + 1, pictureArray, stride) +
    47. +2 * GetPixelFromArray(y + 1, x, pictureArray, stride) +
    48. -2 * GetPixelFromArray(y - 1, x, pictureArray, stride) +
    49. +1 * GetPixelFromArray(y + 1, x - 1, pictureArray, stride) +
    50. -1 * GetPixelFromArray(y - 1, x - 1, pictureArray, stride)
    51. s = Math.Abs(sy) + Math.Abs(sx)
    52. If s <= threshold Then
    53. s = 255
    54. Else
    55. s = 0
    56. End If
    57. byteArray(y + x * stride) = CByte(s)
    58. Next
    59. Next
    60. Return byteArray
    61. End Function
    62. Private Function GetPixelFromArray(x As Integer, y As Integer, pictureArray As Byte(), stride As Integer) As Byte
    63. Dim byteToGet As Byte = pictureArray(y * stride + x)
    64. Return byteToGet
    65. End Function
    66. End Class


    Das Zielbild sollte in etwa so aussehen wie in rot dargestellt, aber so dass mir die linearen Funktion vorliegen. Die linearen Funktionen befinden sich ungefähr im der Mittelachse der Freiformen. Ungefähr deshalb, weil die Berandungen der Freiformen nicht unbedingt parallel und gerade sind, das heißt ich müsste sowieso über irgendeine Art von Ausgleichsgerade nachdenken

    Mir fehlt jetzt allerdings jetzt die zündende Idee, wie ich aus dem Bytearray, im Code pictureArray genannt irgendetwas in der Art rauslesen kann, geschweige denn mir dir Funktionsvorschrift bekomme.
    Hat jemand Googlevorschläge oder einen ganz anderen Lösungsansatz für mich?
    Überlegt habe ich mir auch, dass ich auf das Original Rechtecke so gut es geht, Rechtecke matche, und dann über den Mittelpunkt der kurzen Achse meine zwei Punkte für die Funktion habe, aber auch hier ist das nur eine Idee ohne konkreten Ansatz für einen Algorithmus.

    Viele Grüße
    Bilder
    • original.png

      11,52 kB, 220×184, 349 mal angesehen
    • sobel.png

      13,6 kB, 223×188, 391 mal angesehen
    • Ziel.png

      19,39 kB, 226×187, 377 mal angesehen
    • MöglichkeitB.png

      22,25 kB, 247×208, 314 mal angesehen
    Es mal mit Thinning versucht?


    Nach der Thinning-Operation dann eben prüfen wo jeweils die Linien sich schneiden, und von den Schnittpunkten aus eine Funktion erstellen.



    Liebe Grüße.

    _
    Und Gott alleine weiß alles am allerbesten und besser.
    Hallo,

    Dankeschön für diesen Ansatz. Ich habe inzwischen zwei Algorithmen implementiert und getestet.

    Der erste ist ein Thinning-Algorithmus mit Hilfe von structuring Elements von fourier.eng.hmc.edu/e161/lectures/morphology/node4.html und der zweite ist der Zhang-Suen-Algorithmus von mir aus C# nach VB portiert stackoverflow.com/questions/20…c-sharp/26120310#26120310. Hier der Link zur Theorie dahinter rosettacode.org/wiki/Zhang-Suen_thinning_algorithm

    Ich denke, ich werde weiter mit dem Zhang-Suen arbeiten, da bei dem ersten Algorithmus viele kleine Überbleibsel an den Kanten gebildet werden ("spurs"), so dass nach dem Thinning sehr viele Kreuzungspunkte bestehen, ähnlich wie in dem von dir verlinkten Youtoube-Video das Thumbnail von dem "A".
    Zunächst der Code:
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Image
    2. Private _image As New Image()
    3. Public ReadOnly Property Image As ImageSource
    4. Get
    5. Return _image.Source
    6. End Get
    7. End Property
    8. Public Sub New(img As BitmapImage)
    9. _height = img.Height
    10. _width = img.Width
    11. Dim pixelFormat = PixelFormats.Gray8
    12. Dim convBmp = ConvertImageToPixelFormat(img, pixelFormat)
    13. Dim bytesperpixel = CInt((pixelFormat.BitsPerPixel + 7) / 8)
    14. Dim stride = convBmp.PixelWidth * bytesperpixel
    15. Dim pixelLength = convBmp.PixelHeight * stride
    16. Dim picture As Byte() = New Byte(pixelLength) {}
    17. Dim filterPicture As Byte() = New Byte(pixelLength) {}
    18. convBmp.CopyPixels(picture, stride, 0)
    19. Dim height = convBmp.PixelHeight - 1
    20. Dim width = convBmp.PixelWidth - 1
    21. Dim boolArray1 = Bytes2Bool(picture, height, width, stride)
    22. Dim boolArray2 = ZhangSuenThinning(boolArray1)
    23. filterPicture = Bool2Bytes(boolArray2, pixelLength, stride)
    24. _image.Source = BitmapSource.Create(convBmp.PixelWidth, convBmp.PixelHeight, convBmp.DpiX, convBmp.DpiY, pixelFormat, Nothing, filterPicture, stride)
    25. End Sub
    26. Private Function ConvertImageToPixelFormat(original As BitmapImage, pf As PixelFormat) As FormatConvertedBitmap
    27. Dim grayBitmap As FormatConvertedBitmap = New FormatConvertedBitmap()
    28. grayBitmap.BeginInit()
    29. grayBitmap.Source = original
    30. grayBitmap.DestinationFormat = pf
    31. grayBitmap.EndInit()
    32. Return grayBitmap
    33. End Function
    34. Private Function ZhangSuenThinning(boolArray As Boolean()()) As Boolean()()
    35. Dim temp As Boolean()() = ArrayClone(boolArray)
    36. Dim count As Integer = 0
    37. Do
    38. count = NextStep(False, temp, boolArray)
    39. temp = ArrayClone(boolArray)
    40. count += NextStep(True, temp, boolArray)
    41. temp = ArrayClone(boolArray)
    42. Loop While count > 0
    43. Return boolArray
    44. End Function
    45. Private Function NextStep(isStep2 As Boolean, temp As Boolean()(), s As Boolean()()) As Integer
    46. Dim count As Integer = 0
    47. For x = 1 To temp.Length - 1 - 1
    48. For y = 1 To temp(0).Length - 1 - 1
    49. If SuenThinningAlg(x, y, temp, isStep2) Then
    50. If Not s(x)(y) Then count += 1
    51. s(x)(y) = True
    52. End If
    53. Next
    54. Next
    55. Return count
    56. End Function
    57. Private Function SuenThinningAlg(x As Integer, y As Integer, s As Boolean()(), even As Boolean) As Boolean
    58. Dim p2 = s(x)(y - 1)
    59. Dim p3 = s(x + 1)(y - 1)
    60. Dim p4 = s(x + 1)(y)
    61. Dim p5 = s(x + 1)(y + 1)
    62. Dim p6 = s(x)(y + 1)
    63. Dim p7 = s(x - 1)(y + 1)
    64. Dim p8 = s(x - 1)(y)
    65. Dim p9 = s(x - 1)(y - 1)
    66. Dim bp1 = NumberOfNonZeroNeighbors(x, y, s)
    67. If bp1 >= 2 AndAlso bp1 <= 6 Then
    68. If NumberOfZeroToOneTransitionFromP9(x, y, s) = 1 Then
    69. If even Then
    70. If Not p4 OrElse Not p6 OrElse (Not p2 AndAlso Not p8) Then
    71. Return True
    72. End If
    73. Else
    74. If Not ((p2 AndAlso p4) AndAlso p6) Then
    75. If Not ((p4 AndAlso p6) AndAlso p8) Then
    76. Return True
    77. End If
    78. End If
    79. End If
    80. End If
    81. End If
    82. Return False
    83. End Function
    84. Private Function NumberOfZeroToOneTransitionFromP9(x As Integer, y As Integer, s As Boolean()()) As Integer
    85. Dim p2 = s(x)(y - 1)
    86. Dim p3 = s(x + 1)(y - 1)
    87. Dim p4 = s(x + 1)(y)
    88. Dim p5 = s(x + 1)(y + 1)
    89. Dim p6 = s(x)(y + 1)
    90. Dim p7 = s(x - 1)(y + 1)
    91. Dim p8 = s(x - 1)(y)
    92. Dim p9 = s(x - 1)(y - 1)
    93. Dim int As Integer = Convert.ToInt32((Not p2 AndAlso p3)) +
    94. Convert.ToInt32((Not p3 AndAlso p4)) +
    95. Convert.ToInt32((Not p4 AndAlso p5)) +
    96. Convert.ToInt32((Not p5 AndAlso p6)) +
    97. Convert.ToInt32((Not p6 AndAlso p7)) +
    98. Convert.ToInt32((Not p7 AndAlso p8)) +
    99. Convert.ToInt32((Not p8 AndAlso p9)) +
    100. Convert.ToInt32((Not p9 AndAlso p2))
    101. Return int
    102. End Function
    103. Private Function NumberOfNonZeroNeighbors(x As Integer, y As Integer, s As Boolean()()) As Integer
    104. Dim count = 0
    105. If s(x - 1)(y) Then count += 1
    106. If s(x - 1)(y + 1) Then count += 1
    107. If s(x - 1)(y - 1) Then count += 1
    108. If s(x)(y + 1) Then count += 1
    109. If s(x)(y - 1) Then count += 1
    110. If s(x + 1)(y) Then count += 1
    111. If s(x + 1)(y + 1) Then count += 1
    112. If s(x + 1)(y - 1) Then count += 1
    113. Return count
    114. End Function
    115. Private Function ArrayClone(Of T)(array As T()()) As T()()
    116. Return array.Select(Function(x) x.ToArray()).ToArray()
    117. End Function
    118. Protected Overrides Sub SetNewBindingValues()
    119. Throw New NotImplementedException()
    120. End Sub
    121. Private Function Bytes2Bool(byteArray As Byte(), height As Integer, width As Integer, stride As Integer) As Boolean()()
    122. Dim bool As Boolean()() = New Boolean(height)() {}
    123. For i1 = 0 To height
    124. bool(i1) = New Boolean(width) {}
    125. For j1 = 0 To width
    126. If GetPixelFromArray(j1, i1, byteArray, stride) > 0 Then
    127. bool(i1)(j1) = True
    128. End If
    129. Next
    130. Next
    131. Return bool
    132. End Function
    133. Private Function Bool2Bytes(boolArray As Boolean()(), length As Integer, stride As Integer) As Byte()
    134. Dim byteArray As Byte() = New Byte(length) {}
    135. For i1 = 0 To boolArray.Length - 1
    136. For j1 = 0 To boolArray(0).Length - 1
    137. If boolArray(i1)(j1) Then
    138. byteArray(j1 + i1 * stride) = 255
    139. End If
    140. Next
    141. Next
    142. Return byteArray
    143. End Function
    144. Function GetPixelFromArray(x As Integer, y As Integer, pictureArray As Byte(), stride As Integer) As Byte
    145. Dim byteToGet = pictureArray(y * stride + x)
    146. Return byteToGet
    147. End Function
    148. End Class


    Es funktioniert und tut was es soll, jedoch sind mir zwei Sachen aufgefallen:
    1. Der Algorithmus dünnt zu weit aus bevor er abbricht. Es sollten zusammenhängende Linien entstehen, die max 1 Pixel dick sind ohne Unterbrechungen. Jedoch bekomme ich mit dem Code oben teilweise Stellen rein, an denen kein Zusammenhang besteht. Ich finde den Denkfehler bzw. Fehler im Code nicht.
    2. Wenn ich mir das Boolarray, welches true/false für schwarze/weiße Pixel in Excel komplett anschaue dann steht aber bei weißen Pixeln true und alle schwarzen sind auf false:

    VB.NET-Quellcode

    1. Private Function Bytes2Bool(byteArray As Byte(), height As Integer, width As Integer, stride As Integer) As Boolean()()
    2. Dim bool As Boolean()() = New Boolean(height)() {}
    3. For i1 = 0 To height
    4. bool(i1) = New Boolean(width) {}
    5. For j1 = 0 To width
    6. If GetPixelFromArray(j1, i1, byteArray, stride) > 0 Then
    7. bool(i1)(j1) = True
    8. End If
    9. Next
    10. Next
    11. Return bool
    12. End Function


    In dieser Funktion steht doch glasklar, dass alle Pixel mit einer Graustufe größer 0 (0 ist weiß) true sein sollen. Ich habe einen Zusammenhang entdeckt mit der Funktion aus VB Dim pixelFormat = PixelFormats.Gray8, aber ich kann ihn nicht deuten. Jedoch sollte doch unabhängig davon mit der Funktion Bytes2Bool mein Gedankengang richtig sein?

    Viele Grüße
    @SKeks Dein Code ist absolut suboptimal.
    Wenn Du öfters alle Pixel eines Bildes abarbeitest, solltest Du Dir zunächst Gedanken über einen grundsätzlichen Ablauf machen.
    • Überlege, ob Du Mono und oder Farbbilder ver- oder bearbeiten willst.
      Separiere dann die Farbkanäle oder wandle das Bild in ein Mono-Bild um.
    • Lese alle Pixel in ein Integer-Array (Mono) bzw. 3 Arrays (Farbe) ein. Indiziere den Index über (Zeile * Breite) + Spalte.
      stride wäre dann in jedem Fall 0.
      Jede Schleife über alle Pixel läuft dann von 0 bis .Length - 1.
    • Mach Dir für jede Funktionalität eine separate Prozedur => "Operator", z.B. Filter-Operationen.
    • Optput jedes solchen Operators ist wiederum ein oder drei Integer-Arrays.
    • Mach Dir einen Operator "Konvertierung eines oder dreier Integer-Arrays zu einer Bitmap" z.B. für die Anzeige nach jedem Operator.
    • ...
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Hallo,

    ich hatte mich mal kurz drangesetzt um meine Idee darzulegen.

    Gegeben sei folgendes Bild,


    Die Applikation findet dazu korrekt 4 Geraden, exemplarisch:


    Problem ist jedoch noch die Ermittlung der Endpunkte der jeweiligen Gerade.
    Zurzeit ist der optimale Punkt derjenige der am nächsten zum Startpunkt ist.

    Auch ergeben sich Probleme mit einigen binären Bildern darunter deines.
    Das liegt am Thinning-Algorithmus.

    Dein Beispiel oben verdünnt sähe so aus,


    Das sind offensichtliche keine Geraden mehr, sondern schon Kurven.

    Das Ergebnis dazu:


    Der Code ist auch nicht wirklich sauber, weil wie gesagt das nur so auf die Schnelle meine Idee demonstrieren sollte.

    Das Projekt ist _ anbei (ohne Binaries): ExtractEquation.zip


    Liebe Grüße.

    _
    Und Gott alleine weiß alles am allerbesten und besser.
    Sorry für die Verspätung. Hatte das Thema aus den Augen verloren und konnte mich auch selbst nicht weiter um mein Thema kümmern.

    @φConst
    Danke für das Projekt. Ich habe es mal durchgearbeitet. So ungefähr stelle ich mir das tatsächlich vor :) Aber eben genau mit der Problemstellung, dass es auch krumme Linien geben kann. Aber ich werde dafür eine Lösung finden.

    @RodFromGermany
    Der Code hier war theoretisch nur zu Veranschaulichung gedacht, so dass mit Kopieren von dem Code direkt ein lauffähiges Projekt entsteht. In meinem projekt hat das ganze eine etwas andere Code-Struktur aber gleiche Funktionalität.
    Aber grundsätzlich hatte ich mir es eigentlich so gedacht: Egal welches PixelFormat eingelesen wird, durch die .Net-Funktionen und die Routine ConvertImageToPixelFormat(original As BitmapImage, pf As PixelFormat) von mir wird das ganze erst mal in ein einheitliches Format überführt und dann in ein binäres Array überführt für Zhang-Sue.

    Die beiden bereits angesprochenen Probleme (irgendwie werden die schwarzen und weißen Pixel invertiert, Löcher in den Linien) bestehen aber auch in dem Projekt von @φConst, obwohl das Projekt genau den von dir vorgeschlagenen Weg nimmt, nämlich Einlesen der Pixel und per ARGB Erstellen eines binäres Arrays. Ich habe aber dafür nichtmal einen Ansatz zum Fehler suchen
    Guten Morgen,

    ich habe es nun schlussendlich hinbekommen und möchte den Code hier hinterlegen und für Verbesserungsvorschläge freigeben :) man lernt ja nie aus. Ich werde den Code langsam Schritt für Schritt einführen und die benutzten Subroutinen erklären.

    Zunächst die Bildklasse. RelayCommands sind Standart. Mit diesen kann auf Buttons gebunden werden.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class BackgroundImage : Inherits DesignerObject
    2. Private _isConverted As Boolean = False
    3. Private _binaryArray As Integer()()
    4. Private _thinnedBinaryArray As Integer()()
    5. Private _thinnedImage As BitmapSource
    6. Private _originalImage As BitmapSource
    7. Private _image As New Image()
    8. Public ReadOnly Property Image As ImageSource
    9. Get
    10. Return _image.Source
    11. End Get
    12. End Property
    13. Private _pointsOfInterest As New Concurrent.ConcurrentBag(Of PointOfInterest)
    14. Public Sub New(img As BitmapSource)
    15. _originalImage = img
    16. _image.Source = img
    17. img.Freeze()
    18. Dim t As Task = Task.Run(Sub()
    19. _binaryArray = Image2Binary(img)
    20. _isConverted = True
    21. End Sub)
    22. End Sub
    23. Public Property ShowOriginalImage() As New RelayCommand(Sub()
    24. _image.Source = _originalImage
    25. RaisePropertyChanged("Image")
    26. End Sub)
    27. Public Property DoStentifordThinning() As New RelayCommand(Sub()
    28. DoThinningStentiford()
    29. End Sub)
    30. Public Property FindPointsOfInterest() As New RelayCommand(Sub()
    31. FindPoI()
    32. End Sub)
    33. Public Property FindConnections() As New RelayCommand(Sub()
    34. FindConnectionss()
    35. End Sub)
    36. Private Function ArrayDeepClone(Of T)(array As T()()) As T()()
    37. Return array.Select(Function(x) x.ToArray()).ToArray()
    38. End Function
    39. End Class


    Für die Weiterverarbeitung sind die Anforderungen an das Bild schwarze Freiformen auf weißem Hintergrund, die nicht an den Rand stoßen dürfen. Dies wird künstlich sichergestellt, indem das BinaryArray jeweils 1 weißes Pixel am Rand größer ist als das Bild. Das Bild wird für die Bearbeitung in ein binäres Array zerlegt und danach wieder in ein Bitmap umgewandelt mit folgenden beiden Routinen:
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Function Image2Binary(oBmp As BitmapSource) As Integer()()
    2. Dim newBmp As BitmapSource = Nothing
    3. If Not oBmp.Format = PixelFormats.Bgra32 Then
    4. newBmp = New FormatConvertedBitmap(oBmp, PixelFormats.Bgra32, Nothing, 0)
    5. Else
    6. newBmp = oBmp
    7. End If
    8. Dim bytesPerPixel = 4
    9. Dim treshold = 250
    10. ' the binary pic is framed by a white border of 1 pixel
    11. Dim int As Integer()() = New Integer(newBmp.PixelHeight + 1)() {}
    12. int(0) = New Integer(newBmp.PixelWidth + 1) {}
    13. int(int.Length - 1) = New Integer(newBmp.PixelWidth + 1) {}
    14. For y = 0 To newBmp.PixelHeight - 1
    15. int(y + 1) = New Integer(newBmp.PixelWidth + 1) {}
    16. For x = 0 To newBmp.PixelWidth - 1
    17. Dim bytes = New Byte(bytesPerPixel - 1) {}
    18. Dim rect = New Int32Rect(x, y, 1, 1)
    19. newBmp.CopyPixels(rect, bytes, bytesPerPixel, 0)
    20. If bytes(0) > treshold AndAlso bytes(1) > treshold AndAlso bytes(2) > treshold Then ' bytes(3) is alpha-channel
    21. int(y + 1)(x + 1) = 0
    22. Else
    23. int(y + 1)(x + 1) = 1
    24. End If
    25. Next
    26. int(y + 1)(0) = 0
    27. int(y + 1)(int(y).Length - 1) = 0
    28. Next
    29. Return int
    30. End Function
    31. Private Function Binary2Image(intArray As Integer()()) As BitmapSource
    32. Dim pf = PixelFormats.Bgra32
    33. Dim hh = intArray.Length - 1
    34. Dim ww = intArray(0).Length - 1
    35. Dim stride = ww * 4
    36. Dim ll = hh * stride
    37. Dim byteArray As Byte() = New Byte(ll) {}
    38. Parallel.For(1, hh, Sub(y)
    39. For x = 1 To ww - 1
    40. Dim index = (y * stride) + (x * 4)
    41. If intArray(y)(x) = 1 Then
    42. byteArray(index) = 0
    43. byteArray(index + 1) = 0
    44. byteArray(index + 2) = 0
    45. byteArray(index + 3) = 255
    46. Else
    47. byteArray(index) = 255
    48. byteArray(index + 1) = 255
    49. byteArray(index + 2) = 255
    50. byteArray(index + 3) = 255
    51. End If
    52. For i1 = 0 To _pointsOfInterest.Count - 1
    53. If _pointsOfInterest(i1).X = x AndAlso _pointsOfInterest(i1).Y = y Then
    54. byteArray(index) = 0
    55. byteArray(index + 1) = 0
    56. byteArray(index + 2) = 255
    57. byteArray(index + 3) = 255
    58. End If
    59. Next
    60. Next
    61. End Sub)
    62. Dim bmp = BitmapSource.Create(ww - 1, hh - 1, 96, 96, pf, Nothing, byteArray, stride)
    63. Return bmp
    64. End Function


    Hat hierbei jemand eine Idee als Ersatz für newBmp.CopyPixels(rect, bytes, bytesPerPixel, 0)? Das dauert bei großen Bilder doch recht lange....
    Als Skelettierungsalgorithmus habe ich mich nun schlussendlich für einen Stentiford-Algorithmus entschieden. Es gibt eventuell performantere (ich habe einige ausprobiert), aber es hat mich die Art des Skeletts überzeugt. Der Algorithmus liefert Linien, die einen Pixel breit sind und arbeitet über Strukturelemente. Vor allem sind Pixellinien nur horizontal oder vertikal verbunden und nicht schräg. Ein schwarzer Pixel wird auf weiß gesetzt, wenn eines der 4 Strukturelemente passt, es kein Endpunkt einer Linie ist und wenn die Connectivity Nummer eins ist. Pro Iterationsschritt wird einmal mit allen vier Elementen über das Bild iteriert. Ich habe einen Zufallsfaktor eingebaut, der innerhalb eines Schritts eine zufällige Reihenfolge der Elemente festlegt, da je nachdem mit welchem Element man anfängt das Skelettieren einen anderen Weg einschlägt und es sollte ja immer reproduzierbar sein. Vor allem sollte auch wenn man das Bild um 90 Grad dreht das gleiche Skelett rauskommen. Was es leider aktuell noch nicht 100% tut, aber da arbeite ich noch dran :)
    Die Strukturelemente sind 3x3 Felder. Schwarze Pixel sind mit (1) dargestellt, weiße Pixel mit einer (0) und Felder bei denen es egal ist haben eine (2). Augenmerk möchte ich auf die ConnectivityNumber legen, diese liefert die Anzahl von benachbarten Objekten zu dem betrachteten Pixel und wird später noch einmal gebraucht.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Sub DoThinningStentiford()
    2. If _thinnedBinaryArray Is Nothing OrElse _thinnedImage Is Nothing Then
    3. _thinnedBinaryArray = StentifordThinning()
    4. _thinnedImage = BinaryToImage(_thinnedBinaryArray)
    5. End If
    6. _image.Source = _thinnedImage
    7. RaisePropertyChanged("Image")
    8. End Sub
    9. Private Function StentifordThinning() As Integer()()
    10. Do ' conversion of the image into binary array is performed by another task and sometimes it needs more time
    11. Loop Until _isConverted
    12. Dim binpic = ArrayDeepClone(_binaryArray)
    13. Dim temp As Integer()() = ArrayDeepClone(binpic)
    14. ' [6,7,8]
    15. ' [5,0,1] ---> [0,1,2,3,4,5,6,7,8]
    16. ' {4,3,2]
    17. Dim strucElem0 As Integer() = New Integer(8) {1, 2, 2, 1, 2, 2, 2, 0, 2}
    18. Dim strucElem90 As Integer() = New Integer(8) {1, 1, 2, 2, 2, 0, 2, 2, 2}
    19. Dim strucElem180 As Integer() = New Integer(8) {1, 2, 2, 0, 2, 2, 2, 1, 2}
    20. Dim strucElem270 As Integer() = New Integer(8) {1, 0, 2, 2, 2, 1, 2, 2, 2}
    21. Dim strucElems As New List(Of Integer())
    22. strucElems.Add(strucElem0)
    23. strucElems.Add(strucElem90)
    24. strucElems.Add(strucElem180)
    25. strucElems.Add(strucElem270)
    26. Dim _rng As New Random
    27. Dim freeIndices As New List(Of Integer)
    28. Dim count As Integer
    29. Do
    30. count = 0
    31. For i1 = 0 To 3
    32. freeIndices.Add(i1)
    33. Next
    34. Do
    35. Dim rnd = _rng.Next(0, freeIndices.Count)
    36. Dim selectedIndex = freeIndices(rnd)
    37. freeIndices.RemoveAt(rnd)
    38. count += NextIteration(temp, binpic, strucElems(selectedIndex))
    39. temp = ArrayDeepClone(binpic)
    40. Loop Until freeIndices.Count = 0
    41. Loop While count > 0
    42. Return binpic
    43. End Function
    44. Private Function NextIteration(temp As Integer()(), binPic As Integer()(), strucElem As Integer()) As Integer
    45. Dim count = 0
    46. For y = 1 To binPic.Length - 1 - 1
    47. For x = 1 To binPic(0).Length - 1 - 1
    48. If StructuralElementMatchs(y, x, temp, strucElem) Then
    49. ' in center of structuring element is always a 1
    50. binPic(y)(x) = 0
    51. count += 1
    52. End If
    53. Next
    54. Next
    55. Return count
    56. End Function
    57. Private Function StructuralElementMatchs(y As Integer, x As Integer, binPic As Integer()(), strucElem As Integer()) As Boolean
    58. ' white=0, black=1, undefinded = 2, only white+black / black+white results in no match
    59. ' [6,7,8]
    60. ' [5,0,1]
    61. ' {4,3,2]
    62. Dim neighborPixel As Integer() = New Integer(8) {}
    63. neighborPixel(0) = binPic(y)(x)
    64. neighborPixel(1) = binPic(y + 1)(x)
    65. neighborPixel(2) = binPic(y + 1)(x + 1)
    66. neighborPixel(3) = binPic(y)(x + 1)
    67. neighborPixel(4) = binPic(y - 1)(x + 1)
    68. neighborPixel(5) = binPic(y - 1)(x)
    69. neighborPixel(6) = binPic(y - 1)(x - 1)
    70. neighborPixel(7) = binPic(y)(x - 1)
    71. neighborPixel(8) = binPic(y + 1)(x - 1)
    72. For i1 = 0 To 8
    73. If neighborPixel(i1) + strucElem(i1) = 1 Then Return False
    74. Next
    75. If Not IsEndPoint(neighborPixel) AndAlso CheckConnectivity(neighborPixel) = 1 Then Return True
    76. Return False
    77. End Function
    78. Private Function IsEndPoint(neighborPixels As Integer()) As Boolean
    79. Dim count = 0
    80. For i1 = 0 To 7
    81. count += neighborPixels(i1)
    82. Next
    83. If count = 2 Then
    84. Return True
    85. End If
    86. Return False
    87. End Function
    88. Private Function CheckConnectivity(neighborPixels As Integer()) As Integer
    89. Dim conn = 0
    90. conn += neighborPixels(1) - (neighborPixels(1) * neighborPixels(2) * neighborPixels(3))
    91. conn += neighborPixels(3) - (neighborPixels(3) * neighborPixels(4) * neighborPixels(5))
    92. conn += neighborPixels(5) - (neighborPixels(5) * neighborPixels(6) * neighborPixels(7))
    93. conn += neighborPixels(7) - (neighborPixels(7) * neighborPixels(8) * neighborPixels(1))
    94. Return conn
    95. End Function


    Nachdem nun das Skelett bestimmt ist möchte ich nun die besonderen Punkte rausfinden, das heißt Schnittpunkte oder Endpunkte einer Linie "Points of interest". Ich iteriere dazu nocheinmal über alle Pixel und schaue entweder, dass der Pixel genau einen schwarzen Nachbar hat (dann ist es ein Endpunkt) oder die ConnectivityNumber >=3 ist, dass heißt es treffen zwei oder mehr Linien an diesem Punkt zusammen. Diese Punkte werden gespeichert.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class PointOfInterest
    2. Public ReadOnly Property X As Integer
    3. Public ReadOnly Property Y As Integer
    4. Public ReadOnly Property ConnectivityNumber As Integer
    5. Public Sub New(x As Integer, y As Integer, connectivityNumber As Integer)
    6. _X = x
    7. _Y = y
    8. _ConnectivityNumber = connectivityNumber
    9. End Sub
    10. End Class


    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Sub FindPoI()
    2. If _thinnedBinaryArray Is Nothing Then _thinnedBinaryArray = StentifordThinning()
    3. If _pointsOfInterest.Count = 0 Then
    4. Parallel.For(1, _thinnedBinaryArray.Length - 1, Sub(y)
    5. For x = 1 To _thinnedBinaryArray(0).Length - 1 - 1
    6. If _thinnedBinaryArray(y)(x) = 1 Then
    7. Dim neighborPixel As Integer() = New Integer(8) {}
    8. ' [6,7,8]
    9. ' [5,0,1]
    10. ' {4,3,2]
    11. neighborPixel(0) = _thinnedBinaryArray(y)(x)
    12. neighborPixel(1) = _thinnedBinaryArray(y)(x + 1)
    13. neighborPixel(2) = _thinnedBinaryArray(y + 1)(x + 1)
    14. neighborPixel(3) = _thinnedBinaryArray(y + 1)(x)
    15. neighborPixel(4) = _thinnedBinaryArray(y + 1)(x - 1)
    16. neighborPixel(5) = _thinnedBinaryArray(y)(x - 1)
    17. neighborPixel(6) = _thinnedBinaryArray(y - 1)(x - 1)
    18. neighborPixel(7) = _thinnedBinaryArray(y - 1)(x)
    19. neighborPixel(8) = _thinnedBinaryArray(y - 1)(x + 1)
    20. Dim connectivity = CheckConnectivity(neighborPixel)
    21. If IsEndPoint(neighborPixel) OrElse connectivity > 2 Then
    22. _pointsOfInterest.Add(New PointOfInterest(x, y, connectivity))
    23. End If
    24. End If
    25. Next
    26. End Sub)
    27. _thinnedImage = BinaryToImage(_thinnedBinaryArray)
    28. End If
    29. _image.Source = _thinnedImage
    30. RaisePropertyChanged("Image")
    31. End Sub


    Zuletzt möchte ich nun wissen welcher Punkt mit welchem verbunden ist. ich habe also mir eine Klasse gebaut, die von jedem Point of Interest Läufer oder Turtles losschickt die die schwarzen Linen entlanglaufen bis sie auf den nächsten Punkt treffen, was ja zwingend passieren muss. Läufer können nach oben, unten und nach vorne schauen aber nicht zurück. Es kann aufgrund des Stentiford-algorithmus keine schrägen Verbindungen im Pixelraster geben (Großer Vorteil!!). Der Algorithmus erkennt jede Linie doppelt. Einmal von Punkt A nach Punkt B und dann wieder von Punkt B nach Punkt A. Das heißt ich filtere die Duplikate und habe dann schlussendlich meine Verbindungen welcher Punkt mit welchem verbunden ist. Aus den Pixelkoordinaten der Punkte kann ich mir dann die Geradengleichungen bestimmen oder weiteres.
    Aktuell passt das Abbruchkriterium mit den Läufern noch nicht ganz. Sie überschreiten manchmal den nächsten Punkt. Aber auch da sitze ich noch dran.

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Turtle
    2. Private _binPic As Integer()()
    3. Private _position As Integer() = New Integer(1) {}
    4. Private _searchSpace As Integer() = New Integer(2) {}
    5. Private _direction As Integer
    6. Private _points As Concurrent.ConcurrentBag(Of PointOfInterest)
    7. Public StartIndex As Integer
    8. Public EndIndex As Integer
    9. Public Sub New(binPic As Integer()(), direction As Integer, x As Integer, y As Integer, points As Concurrent.ConcurrentBag(Of PointOfInterest))
    10. _binPic = binPic
    11. _direction = direction
    12. ' [6,7,8]
    13. ' [5,0,1]
    14. ' {4,3,2]
    15. Select Case direction
    16. Case 1
    17. _position(0) = x + 1
    18. _position(1) = y
    19. Case 3
    20. _position(0) = x
    21. _position(1) = y + 1
    22. Case 5
    23. _position(0) = x - 1
    24. _position(1) = y
    25. Case 7
    26. _position(0) = x
    27. _position(1) = y - 1
    28. End Select
    29. _points = points
    30. End Sub
    31. Public Function SearchPath() As Integer
    32. Dim endPoint As Boolean = False
    33. Do
    34. endPoint = UpdatePosition()
    35. Loop Until endPoint
    36. For i1 = 0 To _points.Count - 1
    37. If Math.Abs(_position(0) - _points(i1).X) < 3 AndAlso Math.Abs(_position(1) - _points(i1).Y) < 3 Then
    38. Return i1
    39. End If
    40. Next
    41. Return -1
    42. End Function
    43. Private Function UpdatePosition() As Boolean
    44. ' [ ,7, ]
    45. ' direction in structural elem: [5, ,1]
    46. ' [ ,3, ]
    47. Select Case _direction
    48. Case 1
    49. ' [ ,0, ]
    50. ' [ , ,1]-
    51. ' [ ,2, ]
    52. _searchSpace(0) = _binPic(_position(1) - 1)(_position(0))
    53. _searchSpace(1) = _binPic(_position(1))(_position(0) + 1)
    54. _searchSpace(2) = _binPic(_position(1) + 1)(_position(0))
    55. Dim index = CheckNextPosition()
    56. If index < 0 Then Return True
    57. Select Case index
    58. Case 0
    59. _position(1) -= 1
    60. _direction = 7
    61. Case 1
    62. _position(0) += 1
    63. Case 2
    64. _position(1) += 1
    65. _direction = 3
    66. End Select
    67. Case 3
    68. ' [ , , ]
    69. ' [2, ,0]
    70. ' [ ,1, ]
    71. ' |
    72. _searchSpace(0) = _binPic(_position(1))(_position(0) + 1)
    73. _searchSpace(1) = _binPic(_position(1) + 1)(_position(0))
    74. _searchSpace(2) = _binPic(_position(1))(_position(0) - 1)
    75. Dim index = CheckNextPosition()
    76. If index < 0 Then Return True
    77. Select Case index
    78. Case 0
    79. _position(0) += 1
    80. _direction = 1
    81. Case 1
    82. _position(1) += 1
    83. Case 2
    84. _position(0) -= 1
    85. _direction = 5
    86. End Select
    87. Case 5
    88. ' [ ,2, ]
    89. ' -[1, , ]
    90. ' [ ,0, ]
    91. _searchSpace(0) = _binPic(_position(1) + 1)(_position(0))
    92. _searchSpace(1) = _binPic(_position(1))(_position(0) - 1)
    93. _searchSpace(2) = _binPic(_position(1) - 1)(_position(0))
    94. Dim index = CheckNextPosition()
    95. If index < 0 Then Return True
    96. Select Case index
    97. Case 0
    98. _position(1) += 1
    99. _direction = 3
    100. Case 1
    101. _position(0) -= 1
    102. Case 2
    103. _position(1) -= 1
    104. _direction = 7
    105. End Select
    106. Case 7
    107. ' |
    108. ' [ ,1, ]
    109. ' [0, ,2]
    110. ' [ , , ]
    111. _searchSpace(0) = _binPic(_position(1))(_position(0) - 1)
    112. _searchSpace(1) = _binPic(_position(1) - 1)(_position(0))
    113. _searchSpace(2) = _binPic(_position(1))(_position(0) + 1)
    114. Dim index = CheckNextPosition()
    115. If index < 0 Then Return True
    116. Select Case index
    117. Case 0
    118. _position(0) -= 1
    119. _direction = 5
    120. Case 1
    121. _position(1) -= 1
    122. Case 2
    123. _position(0) += 1
    124. _direction = 1
    125. End Select
    126. End Select
    127. Return False
    128. End Function
    129. Private Function CheckNextPosition() As Integer
    130. Dim index As Integer
    131. Dim counter = 0
    132. For i1 = 0 To 2
    133. If _searchSpace(i1) = 1 Then
    134. index = i1
    135. counter += 1
    136. End If
    137. Next
    138. If counter > 1 Then Return -1
    139. Return index
    140. End Function
    141. End Class



    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private _connections As New List(Of Tuple(Of Integer, Integer))
    2. Private Sub FindConnectionss()
    3. If _pointsOfInterest.Count = 0 Then FindPoI()
    4. For i1 = 0 To _pointsOfInterest.Count - 1
    5. Dim p = _pointsOfInterest(i1)
    6. Dim neighborPixel As Integer() = New Integer(8) {}
    7. ' [6,7,8]
    8. ' [5,0,1]
    9. ' {4,3,2]
    10. neighborPixel(0) = 0
    11. neighborPixel(1) = _thinnedBinaryArray(p.Y)(p.X + 1)
    12. neighborPixel(2) = 0
    13. neighborPixel(3) = _thinnedBinaryArray(p.Y + 1)(p.X)
    14. neighborPixel(4) = 0
    15. neighborPixel(5) = _thinnedBinaryArray(p.Y)(p.X - 1)
    16. neighborPixel(6) = 0
    17. neighborPixel(7) = _thinnedBinaryArray(p.Y - 1)(p.X)
    18. neighborPixel(8) = 0
    19. For j1 = 1 To 8
    20. If neighborPixel(j1) = 1 Then
    21. Dim turtle As New Turtle(_thinnedBinaryArray, j1, p.X, p.Y, _pointsOfInterest)
    22. Dim endIndex = turtle.SearchPath
    23. Dim add As Boolean = True
    24. For jj = 0 To _connections.Count - 1
    25. If _connections(jj).Item1 = endIndex AndAlso _connections(jj).Item2 = i1 Then add = False
    26. Next
    27. If add Then _connections.Add(New Tuple(Of Integer, Integer)(i1, endIndex))
    28. End If
    29. Next
    30. Next
    31. End Sub



    Fertig :) Gerne können Codeverbesserungen oder Ideen dafür geliefert werden. Ich bin da für alles offen

    Viele Grüße

    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „SKeks“ ()