Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0113: Graham-Scan: Konvexe Hülle eines Polygons berechnen

 von 

Beschreibung

Mit dem Graham-Scan-Algorithmus kann man die konvexe Hülle eines gegebenen Polygons beziehungsweise einer Punktmenge sehr effizient berechnen. Diesr Tipp zeigt eine einfache, nichtrekursive Implementierung des Algorithmus anhand Graham Scan . Weitere Informationen zum Algorithmus finden sich unter den im Projekt angegebenen Links.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Framework-Version(en):

.NET Framework 3.5

.NET-Version(en):

Visual Basic 2008

Download:

Download des Beispielprojektes [13,13 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2008
' Option Strict:    Aus
' Option Explicit:  An
' Option Infer:     An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'  - System.Core
'  - System.Xml.Linq
'  - System.Data.DataSetExtensions
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'  - System.Linq
'  - System.Xml.Linq
'

' ##############################################################################
' ################################ frmMain.vb ##################################
' ##############################################################################
Option Strict On
Option Explicit On

' Graham-Scan Algorithmus - Siehe:
'  http://en.wikipedia.org/wiki/Graham_Scan
'  http://www.iti.fh-flensburg.de/lang/algorithmen/geo/graham.htm
'  http://www.cs.princeton.edu/~ah/alg_anim/version1/GrahamScan.html

Public Class frmMain
    Private m_Backbuffer As Bitmap

    Private m_Points As New List(Of Point)

    Private Sub Form1_Load(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles Me.Load

        m_Backbuffer = New Bitmap(picOut.Width, picOut.Height)
    End Sub

    Private Sub picOut_Paint(ByVal sender As Object, _
        ByVal e As System.Windows.Forms.PaintEventArgs) Handles picOut.Paint

        Call e.Graphics.DrawImage(m_Backbuffer, New Point(0, 0))
    End Sub

    Private Sub DrawPolygon(ByVal Polygon As Point(), _
        ByVal Color As Color, _
        ByVal Clear As Boolean, _
        Optional ByVal Size As Integer = 1)

        Using g = Graphics.FromImage(m_Backbuffer), Pen = New Pen(Color, Size)
            g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
            If Clear Then Call g.Clear(Color.White)
            If Polygon.Length >= 2 Then Call g.DrawPolygon(Pen, Polygon)
        End Using

        Call picOut.Invalidate()
    End Sub

    Private Sub picOut_MouseDown(ByVal sender As System.Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs) Handles picOut.MouseDown

        Call m_Points.Add(e.Location)

        Call DrawPolygon(m_Points.ToArray(), _
            Color.FromArgb(75, Color.Blue), True)
        lblNumPoints.Text = String.Format("Polygon: {0} Punkt(e)", _
            m_Points.Count)
    End Sub

    Private Sub ScanToolStripMenuItem_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles ScanToolStripMenuItem.Click

        Dim Ret = GrahamScan.ConvexHull(m_Points)

        Call DrawPolygon(Ret.ToArray(), Color.Green, False, 2)
        lblNumPoints.Text = String.Format("Hülle: {0} Punkt(e)", Ret.Count)
    End Sub

    Private Sub ClearToolStripMenuItem_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles ClearToolStripMenuItem.Click

        m_Points = New List(Of Point)

        Call DrawPolygon(m_Points.ToArray(), Nothing, True)
        lblNumPoints.Text = String.Format("Polygon: 0 Punkt(e)", m_Points.Count)
    End Sub
End Class

' ##############################################################################
' ############################### GrahamScan.vb ################################
' ##############################################################################
Imports System.Drawing.Point

Module GrahamScan

    ' Liegt Punkt C links, rechts oder auf dem Vektor AB?
    Private Function Orientation(ByVal A As Point, _
        ByVal B As Point, ByVal C As Point) As Integer

        Return (B.X - A.X) * (C.Y - A.Y) - (C.X - A.X) * (B.Y - A.Y)
    End Function

    ' Minimalen Punkt (kleinste y-Koordinate) suchen
    Private Function Less(ByVal A As Point, ByVal B As Point) As Boolean
        Return (A.Y < B.Y) OrElse ((A.Y = B.Y) And (A.X < B.X))
    End Function

    Public Function ConvexHull( _
        ByVal RawPoints As IEnumerable(Of Point)) As IEnumerable(Of Point)

        If RawPoints.Count <= 3 Then Return RawPoints

        Dim Points = New List(Of Point)(RawPoints)

        ' "Kleinsten" Punkt suchen
        Dim MinIndex = Enumerable.Range(0, Points.Count).Aggregate( _
            Function(Min, idx) If(Less(Points(idx), Points(Min)), idx, Min))
        Dim MinPoint = Points(MinIndex)

        ' Minimum an Position 0 bringen
        Call Swap(Points(0), Points(MinIndex))

        ' Restliche Punkte von links nach rechts ihrem Winkel zum minimalen 
        '  Punkt nach sortieren
        Call Points.Sort(1, Points.Count - 1, _
            New FunctionComparer(Of Point)( _
                Function(a, b) Orientation(MinPoint, a, b)))

        ' Stapel für die Elemente
        Dim Stack As New List(Of Point)

        ' Erster und zweiter Punkt bilden die Ausgangssituation
        Call Stack.Add(Points(0))
        Call Stack.Add(Points(1))

        ' Alle weiteren Punkte durchgehen 
        For i = 2 To Points.Count - 1

            ' Vorhergehende Drehungen im Uhrzeigersinn, die nicht zur Hülle 
            '  gehören, löschen
            Do Until (Stack.Count < 2) OrElse _
                (Orientation(Stack(Stack.Count - 1), _
                    Stack(Stack.Count - 2), Points(i)) > 0)

                Call Stack.RemoveAt(Stack.Count - 1)
            Loop

            ' Punkt hinzufügen
            Call Stack.Add(Points(i))
        Next

        ' Stapel ausgeben
        Return Stack
    End Function

End Module
' ##############################################################################
' ################################# Helper.vb ##################################
' ##############################################################################
Option Strict On

' Hilfsfunktionen

' IComparer aus Delegaten/Lambda erstellen - .NET will's so
Class FunctionComparer(Of T) : Implements IComparer(Of T)
    Private ReadOnly m_Func As Comparison(Of T)

    Public Sub New(ByVal Func As Comparison(Of T))
        m_Func = Func
    End Sub

    Public Function Compare(ByVal x As T, _
        ByVal y As T) As Integer _
        Implements System.Collections.Generic.IComparer(Of T).Compare

        Return m_Func(x, y)
    End Function
End Class

Module Helper
    ' Tauschen von zwei Werten
    Public Sub Swap(Of T)(ByRef a As T, ByRef b As T)
        Dim tmp = a
        a = b
        b = tmp
    End Sub
End Module

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.