Click here to Skip to main content
Click here to Skip to main content
Add your own
alternative version

Create a Voronoi diagram 2 of 3

, 17 Jul 2012 CPOL
Creation of a Voronoi diagram, description of the binary search tree
WPF_VORONOI_TEST-Part2-noexe.zip
WPF_VORONOI_TEST-Part2
WPF_VORONOI_TEST.suo
WPF_VORONOI_TEST
bin
Debug
WPF_VORONOI_TEST.vshost.exe.manifest
My Project
MyExtensions
Settings.settings
obj
x86
Debug
MainWindow.baml
WPF_VORONOI_TEST.g.resources
WPF_VORONOI_TEST.Resources.resources
WPF_VORONOI_TEST_Part2.vbproj.user
WPF_VORONOI_TEST-Part2.zip
WPF_VORONOI_TEST.suo
WPF_VORONOI_TEST.exe
WPF_VORONOI_TEST.pdb
WPF_VORONOI_TEST.vshost.exe
WPF_VORONOI_TEST.vshost.exe.manifest
Release
Settings.settings
DesignTimeResolveAssemblyReferences.cache
DesignTimeResolveAssemblyReferencesInput.cache
MainWindow.baml
TempPE
My Project.Resources.Designer.vb.dll
WPF_VORONOI_TEST.exe
WPF_VORONOI_TEST.g.resources
WPF_VORONOI_TEST.pdb
WPF_VORONOI_TEST.Resources.resources
WPF_VORONOI_TEST.vbproj.GenerateResource.Cache
WPF_VORONOI_TEST_MarkupCompile.cache
WPF_VORONOI_TEST_MarkupCompile.i.cache
Release
WPF_VORONOI_TEST_Part2.vbproj.user
Class MainWindow

    'Stores all the points that you can use to create a Voronoi diagram
    Private points As New PointCollection

    'Stores the boundary were we are interested in showing the Voronoi diagram
    Private box As New Boundary

    'Stores the points that is visible in the beach line
    Dim BeachLinePoints As New PointCollection

    'Circle events are stored here
    Dim CircleEv As New List(Of Circle)

    '
    Dim AllCreatedLines As New List(Of VoronoiLine)
    Dim AllActiveLines As New List(Of VoronoiLine)

    Private Sub Canvas1_MouseDown(sender As System.Object, e As System.Windows.Input.MouseButtonEventArgs)
        'Get the location of the mouse and store it
        Dim LocationOfNewPoint As New Point
        LocationOfNewPoint = e.GetPosition(Canvas1)

        'Stor the point for future use
        points.Add(LocationOfNewPoint)

        'Creat a reprensentation of the point
        Dim NewPoint As New Ellipse
        NewPoint.Fill = Brushes.Black
        NewPoint.StrokeThickness = 2
        NewPoint.Stroke = Brushes.Black

        ' Set the width and height of the Ellipse.
        NewPoint.Width = 5
        NewPoint.Height = 5

        'Add the ellipse to the canvas
        Canvas1.Children.Add(NewPoint)

        'Set the x and y coordinates to get the ellipse centered around the point
        'If you dont substract Radius/2 (with is 2.5 in this case) your center point would be wrong
        Canvas.SetLeft(NewPoint, LocationOfNewPoint.X - 2.5)
        Canvas.SetTop(NewPoint, LocationOfNewPoint.Y - 2.5)

    End Sub

#Region "Bondary class for Voronoi diagram"
    Public Class Boundary
        'You cant set these variables outside the function
        Private _TopLeft As New Point
        Private _BottomRight As New Point

        'In case you change the increase the values are stored
        Private pSortedByXdirection, pSortedByYdirection As New PointCollection


        Public ReadOnly Property TopLeft() As Point
            Get
                Return _TopLeft
            End Get
        End Property

        Public ReadOnly Property BottomRight() As Point
            Get
                Return _BottomRight
            End Get
        End Property

#Region "Constructors"
        Sub New(ByVal pTopLeft As Point, pBottomRight As Point)
            _TopLeft = pTopLeft
            _BottomRight = pBottomRight
        End Sub

        Sub New(ByVal SortedByX_directioon As PointCollection, ByVal SortedByYdirection As PointCollection)
            CalculateBondariesFromPointCollection(SortedByX_directioon, SortedByYdirection)
            pSortedByXdirection = SortedByX_directioon
            pSortedByYdirection = SortedByYdirection
        End Sub

        Sub New(ByVal OriginalPointcollection As PointCollection)
            pSortedByXdirection = SortPoints(OriginalPointcollection, True)
            pSortedByYdirection = SortPoints(OriginalPointcollection, False)
            CalculateBondariesFromPointCollection(pSortedByXdirection, pSortedByYdirection)
        End Sub

        Sub New()

        End Sub
#End Region

        ''' <summary>
        ''' Returns a sorted pointcollection based on Lexografically sorting
        ''' </summary>
        ''' <param name="samplepoints"></param>
        ''' <param name="SortByXdirection"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function SortPoints(ByVal samplepoints As PointCollection, ByVal SortByXdirection As Boolean) As PointCollection
            'Create another array so we can keep the original array out of order
            Dim copySamplePoints As Point() = New Point(samplepoints.Count - 1) {}
            samplepoints.CopyTo(copySamplePoints, 0)

            If SortByXdirection Then
                Array.Sort(copySamplePoints, New PointSort(PointSort.Mode.X))
            Else
                Array.Sort(copySamplePoints, New PointSort(PointSort.Mode.Y))
            End If

            Dim result As New PointCollection

            For Each p As Point In copySamplePoints
                result.Add(p)
            Next

            Return result
        End Function

        Private Class PointSort
            Implements IComparer
            Public Enum Mode
                X
                Y
            End Enum

            Private currentMode As Mode = Mode.X

            Public Sub New(ByVal mode As Mode)
                currentMode = mode
            End Sub

            'Comparing function
            'Returns one of three values - 0 (equal), 1 (greater than), -1 (less than)
            Private Function IComparer_Compare(ByVal a As Object, ByVal b As Object) As Integer Implements IComparer.Compare
                Dim point1 As Point = CType(a, Point)
                Dim point2 As Point = CType(b, Point)

                If currentMode = Mode.X Then
                    'Compare X values
                    If point1.X > point2.X Then
                        Return 1
                    ElseIf point1.X < point2.X Then
                        Return -1
                    Else
                        If point1.Y > point2.Y Then
                            Return 1
                        ElseIf point1.Y < point2.Y Then
                            Return -1
                        Else 'Identical points
                            Return 0
                        End If
                    End If
                Else
                    If point1.Y > point2.Y Then
                        'Compare Y Values
                        Return 1
                    ElseIf point1.Y < point2.Y Then
                        Return -1
                    Else 'Y1 = Y2
                        If point1.X > point2.X Then
                            'Compare Y Values
                            Return 1
                        ElseIf point1.X < point2.X Then
                            Return -1
                        Else 'Identical points
                            Return 0
                        End If
                    End If
                End If
            End Function
        End Class

        Private Sub CalculateBondariesFromPointCollection(ByVal SortedByX_directioon As PointCollection, ByVal SortedByYdirection As PointCollection)
            Dim p1, p2, p3, p4 As New Point
            p1 = SortedByX_directioon(0)
            p2 = SortedByYdirection(0)

            'Temporary storage of min and max values in the pointcollection
            Dim Xmin, Ymin, Xmax, Ymax As Double

            If p1.X < p2.X Then
                Xmin = p1.X
            Else
                Xmin = p2.X
            End If

            If p1.Y < p2.Y Then
                Ymin = p1.Y
            Else
                Ymin = p2.Y
            End If

            p3 = SortedByX_directioon(SortedByX_directioon.Count - 1)
            p4 = SortedByYdirection(SortedByYdirection.Count - 1)


            If p3.X < p4.X Then
                Xmax = p4.X
            Else
                Xmax = p3.X
            End If

            If p3.Y < p4.Y Then
                Ymax = p4.Y
            Else
                Ymax = p3.Y
            End If

            'We are going to base the increase at the Width and Height of the rectangle
            'so we are going to performe some calculations in order to make these adjustments
            Dim height As Double = Math.Abs(Ymax - Ymin)
            Dim width As Double = Math.Abs(Xmax - Xmin)

            'Scale the with and height in order to add and substract the values to Y and X
            Dim _height As Double = height * (ProcentIncrease) / 100
            Dim _width As Double = width * (ProcentIncrease) / 100

            'Store the final values
            _TopLeft = New Point(Xmin - _width, Ymin - _height)
            _BottomRight = New Point(Xmax + _width, Ymax + _height)

        End Sub

        Public Sub ReturnRectangle(ByVal can As Canvas)
            Dim p As New Rectangle
            p.Fill = Nothing
            p.StrokeThickness = 2
            p.Stroke = Brushes.Blue

            ' Set the width and height of the Rectangle.
            ' The values can be negative therefore the Math.Abs
            p.Width = Math.Abs(_BottomRight.X - _TopLeft.X)
            p.Height = Math.Abs(_BottomRight.Y - _TopLeft.Y)

            can.Children.Add(p)
            Canvas.SetLeft(p, _TopLeft.X)
            Canvas.SetTop(p, _TopLeft.Y)
        End Sub

        Public Function CutLinesToBoundaries() As Object
            Return Nothing
        End Function

        'In reality the value of 50 (width is incresed by the factor 1.5) that would increase the bondaries with 25% on all sides
        ' To use it you simply write in the increase at for instance 40 (percent)
        Private _ProcentIncrease As Double = 50
        Public Property ProcentIncrease() As Double
            Get
                Return _ProcentIncrease
            End Get
            Set(ByVal value As Double)
                _ProcentIncrease = (value)

                'Value is changed we need to update the topmost and bottommost points
                CalculateBondariesFromPointCollection(pSortedByXdirection, pSortedByYdirection)
            End Set
        End Property
    End Class
#End Region

    Private Sub Button1_Click(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles btn_Voronoi.Click
        'We need to sort the points according to the Y direction
        If points.Count = 0 Then
            Exit Sub
        ElseIf points.Count = 1 Then
            'Return the box
        End If

        Dim SortedPointCollection_Y As New PointCollection
        SortedPointCollection_Y = SortPoints(points, False)

        Dim tempbox As New Boundary(New Point(0, 0), New Point(Canvas1.Width, Canvas1.Height))
        box = tempbox

        Dim NoOfCirclesEvents As Integer = 0

        AllCreatedLines.Add(New VoronoiLine)

        For i As Integer = 1 To SortedPointCollection_Y.Count - 1
            If i = 1 Then
                'The first two points cant form a circle event by themselves so we ignore the circle check to save time
                Dim first As New VoronoiLine
                first.ParabolicCut(SortedPointCollection_Y(i - 1), SortedPointCollection_Y(i), SortedPointCollection_Y(i - 1).Y)
                '  Canvas1.Children.Add(first.CutLinesByBoundaries(box))
                first.VoronoiParent = AllCreatedLines(0)
                AllCreatedLines.Add(first)

                'The first two point will be a part of our points that will, through the arcs, 
                'form our beach line. We only need to store its generation points here tough.
                BeachLinePoints.Add(SortedPointCollection_Y(i - 1))
                BeachLinePoints.Add(SortedPointCollection_Y(i))

            Else

                'We only check if the new point forms any circles ABOVE the sweep line
                ' Problem one point can form several valid circles
                Dim TempCircle As New Circle
                TempCircle = CircleEvent(SortedPointCollection_Y(i))
                If Not TempCircle.IsEmpty Then

                    NoOfCirclesEvents += 1
                    TempCircle.AddVoronoiLines(AllCreatedLines)
                    CircleEv.Add(TempCircle)

                    BeachLinePoints.Add(SortedPointCollection_Y(i))


                Else
                    ' No circles found, the question now is were sould our new point be placed?
                    ' It would have to be one of the lines that is a parent of the empty first line for now...

                    Dim index As Integer = Nothing
                    Dim min As Double = Nothing
                    For k As Integer = 0 To BeachLinePoints.Count - 1
                        If Not LinesExist(SortedPointCollection_Y(i), BeachLinePoints(k)) And Not SortedPointCollection_Y(i) = BeachLinePoints(k) Then
                            Dim temp As Double = SortedPointCollection_Y(i).Y - Intersection2(SortedPointCollection_Y(i), BeachLinePoints(k), SortedPointCollection_Y(i).Y)
                            If min = Nothing Then
                                index = k
                                min = temp
                            Else
                                If min > temp Then
                                    index = k
                                    min = temp
                                End If
                            End If
                        End If
                    Next

                    Dim first As New VoronoiLine
                    first.ParabolicCut(SortedPointCollection_Y(i), BeachLinePoints(index), SortedPointCollection_Y(i).Y)
                    first.VoronoiParent = AllCreatedLines(0)
                    AllCreatedLines.Add(first)

                    BeachLinePoints.Add(SortedPointCollection_Y(i))
                End If
            End If
        Next

        For i As Integer = 1 To AllCreatedLines.Count - 1
            AllCreatedLines(i).CutLinesByBoundaries(box)
            Canvas1.Children.Add(AllCreatedLines(i).GetLine)
        Next

        stLines.Content = "Number of lines added: " & AllCreatedLines.Count - 1 & " : Nomber of circles: " & NoOfCirclesEvents.ToString
    End Sub

    ''' <summary>
    ''' Finds the index of a line that contains one point in the circle
    ''' </summary>
    ''' <param name="cir"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function FindDiagram(ByVal cir As Circle) As Integer
        For i As Integer = 1 To AllCreatedLines.Count - 1
            If cir.Contains(AllCreatedLines(i)) Then
                Return i
            End If
        Next
        Return -1
    End Function

    Private Function GetVoroNoiGraph() As List(Of VoronoiGraphPoint)
        Dim result As New List(Of VoronoiGraphPoint)
        For i As Integer = 0 To points.Count - 1
            Dim Center As New Point
            Dim Lines As New Polygon
            Center = points(i)

            Dim Enclosed As Boolean = False
            For j As Integer = 1 To AllCreatedLines.Count - 1
                If AllCreatedLines(j).Contains(Center) Then
                    'Important to check this befor the lines are added, else the first added point will ensure that it is enclosed
                    If Lines.Points.Contains(AllCreatedLines(j).StartPoint) And Lines.Points.Contains(AllCreatedLines(j).EndPoint) Then
                        Enclosed = True
                    End If

                    If Not Lines.Points.Contains(AllCreatedLines(j).StartPoint) Then
                        Lines.Points.Add(AllCreatedLines(j).StartPoint)
                    End If

                    If Not Lines.Points.Contains(AllCreatedLines(j).EndPoint) Then
                        Lines.Points.Add(AllCreatedLines(j).EndPoint)
                    End If
                End If
            Next
            result.Add(New VoronoiGraphPoint(Center, Lines, Enclosed))
            Canvas1.Children.Add(result(i).VoronoiPolygon)
        Next

        For Each p As VoronoiGraphPoint In result
            If Not p.Enclosed Then
                ' The have the same bondary line
                'They have opposite bonday lines
                'The have the same corner bondary
                'They have just two separate lines, it is possible that you would need ot rearrange the poitns

                Debug.WriteLine("Polygon not enclosed")
            End If
        Next

        Return result
    End Function

    Public Class VoronoiGraphPoint

        Sub New()

        End Sub

        Sub New(ByVal p As Point, ByVal pp As Polygon)
            CenterPoint = p
            VoronoiPolygon = pp
            VoronoiPolygon.Fill = Brushes.Blue
            VoronoiPolygon.Stroke = Brushes.Black
            VoronoiPolygon.StrokeThickness = 2
        End Sub


        Sub New(ByVal p As Point, ByVal pp As Polygon, ByVal pEnclosed As Boolean)
            CenterPoint = p
            VoronoiPolygon = pp
            VoronoiPolygon.Fill = Brushes.Blue
            VoronoiPolygon.Stroke = Brushes.Black
            VoronoiPolygon.StrokeThickness = 2
            Me.Enclosed = pEnclosed
        End Sub

        Private _Enclosed As Boolean = False
        Public Property Enclosed() As Boolean
            Get
                Return _Enclosed
            End Get
            Set(ByVal value As Boolean)
                _Enclosed = value
            End Set
        End Property

        Private _CenterPoint As Point
        Public Property CenterPoint() As Point
            Get
                Return _CenterPoint
            End Get
            Set(ByVal value As Point)
                _CenterPoint = value
            End Set
        End Property

        Private _VoronoiPolygon As Polygon
        Public Property VoronoiPolygon() As Polygon
            Get
                Return _VoronoiPolygon
            End Get
            Set(ByVal value As Polygon)
                _VoronoiPolygon = value
            End Set
        End Property
    End Class

    Private Function LinesExist(ByVal p1 As Point, ByVal p2 As Point) As Boolean
        Dim result As Boolean = False
        For Each p As VoronoiLine In AllCreatedLines
            If p.Contains(p1) And p.Contains(p2) Then
                result = True
            End If
        Next
        Return result
    End Function

    Private Function CircleEvent(ByVal p As Point) As Circle

        'We would have to find the circle event in one of the previous created lines
        For i As Integer = 1 To AllCreatedLines.Count - 1
            Dim G As New Circle
            G.CreatCircleFromVoronoiLine(AllCreatedLines(i), p)
            'TODO: Need to fix the situation with two voronoi lines
            If Not DoesBeachLineHAvePointsInsideThisCircle(G) Then
                Return G
            End If
        Next
        Dim G2 As New Circle
        G2.IsEmpty = True
        Return G2
    End Function

    Private Function DoesBeachLineHAvePointsInsideThisCircle(ByVal c As Circle) As Boolean
        For Each p As Point In points
            If Not c.CreationPoints.Contains(p) Then
                If c.DoesCircleContainPoint(p) Then
                    Return True
                End If
            End If
        Next
        Return False
    End Function

    ''' <summary>
    ''' Returns the y value construcked by the event from the newpoint and the contructed arc of the oldpoint
    ''' </summary>
    ''' <param name="NewPoint">This is the point on the sweep line</param>
    ''' <param name="OldPoint">This is one point above the sweep line</param>
    ''' <param name="SweepLine">Y position of the sweep line</param>
    ''' <returns>Calculates the distance fromn a point (NewPoint) to the Parabolic arc generated by the OldPoint and the Sweep line</returns>
    ''' <remarks>The Function only gives you the Y value of the position on the parabolic intersection given the X location</remarks>
    Private Function Intersection2(ByVal NewPoint As Point, ByVal OldPoint As Point, ByVal SweepLine As Double) As Double
        Dim res As Double
        res = (1 / (2 * ((OldPoint.Y) - SweepLine)))
        res *= (NewPoint.X ^ 2 - 2 * OldPoint.X * NewPoint.X + OldPoint.X ^ 2 + OldPoint.Y ^ 2 - SweepLine ^ 2)
        Return (res)
    End Function

    'Lines appers at every conjunction between two points, 
    Public Class VoronoiLine

        Sub New()

        End Sub

        Private _VoronoiParent As VoronoiLine
        Public Property VoronoiParent() As VoronoiLine
            Get
                Return _VoronoiParent
            End Get
            Set(ByVal value As VoronoiLine)
                _VoronoiParent = value
            End Set
        End Property

        Private _VoronoiChildren As New List(Of VoronoiLine)
        Public Property VoronoiChildren() As List(Of VoronoiLine)
            Get
                Return _VoronoiChildren
            End Get
            Set(ByVal value As List(Of VoronoiLine))
                _VoronoiChildren = value
            End Set
        End Property

        'A check to see if one of the points is the same as the creation point
        Public Function Contains(ByVal P As Point) As Boolean
            If CreationPointLeft = P Or CreationPointRight = P Then
                Return True
            Else
                Return False
            End If
        End Function

        ''' <summary>
        ''' Finds which side of a line the point is
        ''' </summary>
        ''' <param name="PointToBeEvaluated">Evaluation point</param>
        ''' <returns>-1 for a point to the right, 0 for a point on the line, +1 for a point to the left</returns>
        ''' <remarks></remarks>
        Public Function WhichSide(ByVal PointToBeEvaluated As Point) As Integer

            Dim ReturnvalueEquation As Double
            ReturnvalueEquation = ((PointToBeEvaluated.Y - Me.StartPoint.Y) _
                                   * (Me.EndPoint.X - Me.StartPoint.X)) - ((Me.EndPoint.Y - Me.StartPoint.Y) _
                                   * (PointToBeEvaluated.X - Me.StartPoint.X))

            If ReturnvalueEquation > 0 Then
                Return -1
            ElseIf ReturnvalueEquation = 0 Then
                Return 0
            Else
                Return 1
            End If
        End Function

        Private _CreationPointRight As New Point
        Public Property CreationPointRight() As Point
            Get
                Return _CreationPointRight
            End Get
            Set(ByVal value As Point)
                _CreationPointRight = value
            End Set
        End Property

        Private _StartPointCreatedByCircle As Boolean = False
        Public Property StartPointCreatedByCircle() As Boolean
            Get
                Return _StartPointCreatedByCircle
            End Get
            Set(ByVal value As Boolean)
                _StartPointCreatedByCircle = value
            End Set
        End Property


        Private _EndPointCreatedByCircle As Boolean = False
        Public Property EndPointCreatedByCircle() As Boolean
            Get
                Return _EndPointCreatedByCircle
            End Get
            Set(ByVal value As Boolean)
                _EndPointCreatedByCircle = value
            End Set
        End Property

        Private _CreationPointLeft As New Point
        Public Property CreationPointLeft() As Point
            Get
                Return _CreationPointLeft
            End Get
            Set(ByVal value As Point)
                _CreationPointLeft = value
            End Set
        End Property

        'Use this if you want to cut the lines afterword
        Sub New(ByVal p1 As Point, ByVal p2 As Point)

            'In this class it is irrelevant witch point is the startpoint
            'and witch is the endpoint, as they are only used to calculate
            'the line equation coefficients first.
            StartPoint = p1
            EndPoint = p2
        End Sub

        'Use this if you want to cut the lines at creation
        Sub New(ByVal p1 As Point, ByVal p2 As Point, ByVal b As Boundary)

            'In this class it is irrelevant witch point is the startpoint
            'and witch is the endpoint, as they are only used to calculate
            'the line equation coefficients. However they cant be equal.
            StartPoint = p1
            EndPoint = p2

            CutLinesByBoundaries(b)
        End Sub

        Private _StartPoint As New Point
        Public Property StartPoint() As Point
            Get
                Return _StartPoint
            End Get
            Set(ByVal value As Point)
                _StartPoint = value
            End Set
        End Property

        Private _EndPoint As New Point
        Public Property EndPoint() As Point
            Get
                Return _EndPoint
            End Get
            Set(ByVal value As Point)
                _EndPoint = value
            End Set
        End Property

        'It is important to notice that another line event would never cut an existing line!
        'A line can only be cut if one of these two events below occurs!

        'All the calculated lines must in any event be cut by the boundaries
        'This is mearly a test function and has to be changed later on.
        Public Function CutLinesByBoundaries(ByVal Box As Boundary) As Polyline
            ' We first calculate the equation coefficients
            CalculateLineEquation(StartPoint, EndPoint)

            Dim TempTopY, TempTopX, TempBottomY, TempBottomX As Double

            TempTopY = Box.TopLeft.X * A + B
            TempTopX = (Box.TopLeft.Y - B) / A

            TempBottomY = Box.BottomRight.X * A + B
            TempBottomX = (Box.BottomRight.Y - B) / A

            'Deals with startpoint
            If Not StartPointCreatedByCircle Then
                If TempTopX > Box.TopLeft.X Then
                    If TempTopX < Box.BottomRight.X Then
                        StartPoint = New Point(TempTopX, Box.TopLeft.Y)
                    Else

                        StartPoint = New Point(Box.BottomRight.X, TempBottomY)
                    End If
                Else
                    StartPoint = New Point(Box.TopLeft.X, TempTopY)
                End If
            End If

            'Deals with endpoint
            If Not EndPointCreatedByCircle Then
                If TempBottomX > Box.TopLeft.X Then
                    If TempBottomX < Box.BottomRight.X Then
                        EndPoint = New Point(TempBottomX, Box.BottomRight.Y)
                    Else
                        EndPoint = New Point(Box.BottomRight.X, TempBottomY)
                    End If
                Else
                    TempBottomY = Box.TopLeft.X * A + B
                    EndPoint = New Point(Box.TopLeft.X, TempBottomY)
                End If
            End If

            Dim d As New Polyline
            d.Points.Add(StartPoint)
            d.Points.Add(EndPoint)
            d.ToolTip = Math.Round(StartPoint.X, 0) & " and  " & Math.Round(StartPoint.Y, 0) & "; " & Math.Round(EndPoint.X, 0) & " and  " & Math.Round(EndPoint.Y, 0)
            d.Stroke = Brushes.Black
            d.StrokeThickness = 2
            Return d
        End Function

        'All the lines in the center of the Voronoi map would be cut by at least one or two circle events
        Public Function GetLine() As Polyline
            Dim d As New Polyline
            d.Points.Add(StartPoint)
            d.Points.Add(EndPoint)
            d.Stroke = Brushes.Black
            d.StrokeThickness = 2
            Return d
        End Function
        'We will store up to two points in the private collection
        Private CircleEvents As New List(Of Point)

        Private LineIsCreatedFromVertexEvent As Boolean = False

        Public Sub CircleEventAppear(ByVal CircleCenter As Circle)
            CircleEvents.Add(CircleCenter.CenterPoint)
            If CreationPointLeft = Nothing Then
                LineIsCreatedFromVertexEvent = True
            End If
        End Sub

        Public Sub CutLineOnCircleEvents()

            'If we at the end end up with just one circle event we would have to assume that
            'the line go's from the one Voronoi vertex (circle point) to one of the boundaries

            If CircleEvents.Count = 0 Then
                'This could happen if we for instance design a Voronoi diagram with just two points
                Exit Sub
            End If

            If CircleEvents.Count = 1 Then
                'The circle cuts the line in half, the question is witch half sould you cut? 
                If LineIsCreatedFromVertexEvent Then
                    ' The Vertex is below either one or both line creation points meaning that it is 
                    ' Remove the line that goes from the higest Y point
                    _StartPoint = CircleEvents(0)
                Else
                    _EndPoint = CircleEvents(0)
                End If
            Else
                'The maximum circle event for a single line is two
                If CircleEvents(0).Y > CircleEvents(1).Y Then
                    _StartPoint = CircleEvents(0)
                    _EndPoint = CircleEvents(1)
                Else
                    _StartPoint = CircleEvents(1)
                    _EndPoint = CircleEvents(0)
                End If
            End If

            'To determine witch of the two boundary points we would have to remove, we can do that by checking the creation point 
            'and the circle point. If the circle point is below the CreationPoint, The line below have to go, and if the circle 
            'point is above the CreationPoint the line above have to be cut. Remember that this is only valid if just one circle 
            'event is present when the diagram is completed!

        End Sub

        'Line equation coefficients, only used internally in this class
        ' y = Ax + B
        Dim A, B As Double

        Private Sub CalculateLineEquation(ByVal p1 As Point, ByVal p2 As Point)
            'Calculate and store the A and B coefficients from the equation here
            'http://en.wikipedia.org/wiki/Line_equation#Two-point_form

            Dim slope As Double
            slope = (p2.Y - p1.Y) / (p2.X - p1.X)
            A = (slope)
            B = (-slope * p1.X + p1.Y)
        End Sub

        ''' <summary>
        ''' Calculates the line between two Parabolic intersections
        ''' </summary>
        ''' <param name="Point1">A point in the Voronoi diagram</param>
        ''' <param name="point2">A Point in the Voronoi diagram (different from point 1)</param>
        ''' <param name="ys">The position of the sweep line</param>
        ''' <remarks>It would give wrong values if the two points have the same or close to the same Y coordinate, as the double has limited significant storage</remarks>
        Public Sub ParabolicCut(ByVal Point1 As Point, ByVal point2 As Point, ys As Double) 'As VoronoiLine

            'Stores the values in double format, as I didnt bother to rewrite Benjamin Dittes quadratic equation.
            Dim x1, y1, x2, y2 As Double

            'Inizialize Point 1
            x1 = Point1.X
            y1 = Point1.Y

            'Inizialize Point 2 
            x2 = point2.X
            y2 = point2.Y



            'Sweep line, added 500 to make sure the two calculated points are well of the boundaries
            ys = ys + 500

            'Setting ut calculation of the quadratic equation
            Dim a1 As Double = 1 / (2 * (y1 - ys))
            Dim a2 As Double = 1 / (2 * (y2 - ys))

            'The two resulting values of x from the quadratic equation
            Dim xs1 As Double = 0.5 / (2 * a1 - 2 * a2) * (4 * a1 * x1 - 4 * a2 * x2 + 2 * Math.Sqrt(-8 * a1 * x1 * a2 * x2 - 2 * a1 * y1 + 2 * a1 * y2 + 4 * a1 * a2 * x2 * x2 + 2 * a2 * y1 + 4 * a2 * a1 * x1 * x1 - 2 * a2 * y2))
            Dim xs2 As Double = 0.5 / (2 * a1 - 2 * a2) * (4 * a1 * x1 - 4 * a2 * x2 - 2 * Math.Sqrt(-8 * a1 * x1 * a2 * x2 - 2 * a1 * y1 + 2 * a1 * y2 + 4 * a1 * a2 * x2 * x2 + 2 * a2 * y1 + 4 * a2 * a1 * x1 * x1 - 2 * a2 * y2))

            'Generate two points to store the two intersection points
            Dim p1, p2 As New Point
            p1.X = xs1
            p2.X = xs2
            p1.Y = 0
            p2.Y = 0

            'Find the resulting Y values calculated from the quadratic equation
            ' (It dosent matter that the Y is 0 as the function Intersection2 only uses the X value for computation)
            p1.Y = Intersection2(p1, Point1, ys)
            p2.Y = Intersection2(p2, Point1, ys)

            'Sort first and then add the two calculated poitns
            If p1.Y > p2.Y Then
                Me.StartPoint = (p1)
                Me.EndPoint = (p2)
            ElseIf p1.Y = p2.Y Then
                ' if they are the same save them in the order of the X values
                If p1.X < p2.X Then
                    Me.StartPoint = (p1)
                    Me.EndPoint = (p2)
                Else
                    Me.StartPoint = (p2)
                    Me.EndPoint = (p1)
                End If
            Else
                Me.StartPoint = (p2)
                Me.EndPoint = (p1)
            End If

            If WhichSide(Point1) >= 0 Then
                CreationPointRight = Point1
                CreationPointLeft = point2
            Else
                CreationPointRight = point2
                CreationPointLeft = Point1
            End If



        End Sub

        ''' <summary>
        ''' Returns the y value construcked by the event from the newpoint and the contructed arc of the oldpoint
        ''' </summary>
        ''' <param name="NewPoint">This is the point on the sweep line</param>
        ''' <param name="OldPoint">This is one point above the sweep line</param>
        ''' <param name="SweepLine">Y position of the sweep line</param>
        ''' <returns>Calculates the distance fromn a point (NewPoint) to the Parabolic arc generated by the OldPoint and the Sweep line</returns>
        ''' <remarks>The Function only gives you the Y value of the position on the parabolic intersection given the X location</remarks>
        Private Function Intersection2(ByVal NewPoint As Point, ByVal OldPoint As Point, ByVal SweepLine As Double) As Double
            Dim res As Double
            res = (1 / (2 * ((OldPoint.Y) - SweepLine)))
            res *= (NewPoint.X ^ 2 - 2 * OldPoint.X * NewPoint.X + OldPoint.X ^ 2 + OldPoint.Y ^ 2 - SweepLine ^ 2)
            Return (res)
        End Function

        'We also generate a function that returns the distance 

    End Class

#Region "Sorting algorithm"
    ''' <summary>
    ''' Returns a sorted pointcollection based on Lexografically sorting
    ''' </summary>
    ''' <param name="samplepoints"></param>
    ''' <param name="SortByXdirection"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function SortPoints(ByVal samplepoints As PointCollection, ByVal SortByXdirection As Boolean) As PointCollection
        'Create another array so we can keep the original array out of order
        Dim copySamplePoints As Point() = New Point(samplepoints.Count - 1) {}
        samplepoints.CopyTo(copySamplePoints, 0)

        If SortByXdirection Then
            Array.Sort(copySamplePoints, New PointSort(PointSort.Mode.X))
        Else
            Array.Sort(copySamplePoints, New PointSort(PointSort.Mode.Y))
        End If

        Dim result As New PointCollection

        For Each p As Point In copySamplePoints
            result.Add(p)
        Next

        Return result
    End Function

    Private Class PointSort
        Implements IComparer
        Public Enum Mode
            X
            Y
        End Enum

        Private currentMode As Mode = Mode.X

        Public Sub New(ByVal mode As Mode)
            currentMode = mode
        End Sub

        'Comparing function
        'Returns one of three values - 0 (equal), 1 (greater than), -1 (less than)
        Private Function IComparer_Compare(ByVal a As Object, ByVal b As Object) As Integer Implements IComparer.Compare
            Dim point1 As Point = CType(a, Point)
            Dim point2 As Point = CType(b, Point)

            If currentMode = Mode.X Then
                'Compare X values
                If point1.X < point2.X Then
                    Return -1
                ElseIf point1.X > point2.X Then
                    Return 1
                Else
                    If point1.Y < point2.Y Then
                        Return -1
                    ElseIf point1.Y > point2.Y Then
                        Return 1
                    Else 'Identical points
                        Return 0
                    End If
                End If
            Else
                If point1.Y < point2.Y Then
                    'Compare Y Values
                    Return -1
                ElseIf point1.Y > point2.Y Then
                    Return 1
                Else 'Y1 = Y2
                    If point1.X < point2.X Then
                        'Compare Y Values
                        Return -1
                    ElseIf point1.X > point2.X Then
                        Return 1
                    Else 'Identical points
                        Return 0
                    End If
                End If
            End If
        End Function
    End Class

#End Region

    Private Sub btn_Retangle_Click(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles btn_Retangle.Click
        Dim b As New Boundary(points)
        b.ReturnRectangle(Canvas1)
    End Sub

    Private Sub btnClear_Click(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles btnClear.Click
        points.Clear()
        AllCreatedLines.Clear()
        BeachLinePoints.Clear()
        Canvas1.Children.Clear()
        stLines.Content = "Number of lines added: 0"
    End Sub

    Private Sub Canvas1_MouseMove(sender As System.Object, e As System.Windows.Input.MouseEventArgs)
        Dim tempPoint As New Point
        tempPoint = e.GetPosition(Canvas1)
        stPosition.Content = "(" & Math.Abs(tempPoint.X).ToString & "; " & Math.Abs(tempPoint.Y).ToString & ")"
    End Sub

    ''' <summary>
    ''' A class for preforming circle tests
    ''' </summary>
    ''' <remarks></remarks>
    Public Class Circle

        Public Function Contains(ByVal dia As VoronoiLine) As Boolean
            Dim pleft As Boolean = False
            Dim pright As Boolean = False
            For Each p As Point In CreationPoints
                If dia.CreationPointLeft = p Then
                    pleft = True
                End If

                If dia.CreationPointLeft = p Then
                    pright = True
                End If
            Next

            If pleft And pright Then
                Return True
            Else
                Return False
            End If
        End Function

        Private _IsEmpty As Boolean = False
        Public Property IsEmpty() As Boolean
            Get
                Return _IsEmpty
            End Get
            Set(ByVal value As Boolean)
                _IsEmpty = value
            End Set
        End Property

        Private _CreationPoints As New List(Of Point)
        Public Property CreationPoints() As List(Of Point)
            Get
                Return _CreationPoints
            End Get
            Set(ByVal value As List(Of Point))
                _CreationPoints = value
            End Set
        End Property

        Private _CenterPoint As Point
        Public Property CenterPoint() As Point
            Get
                Return _CenterPoint
            End Get
            Set(ByVal value As Point)
                _CenterPoint = value
            End Set
        End Property

        Private _radius As Double
        Public Property Radius() As Double
            Get
                Return _radius
            End Get
            Set(ByVal value As Double)
                _radius = value
            End Set
        End Property

        Public Function OutsideBoundary(ByVal box As Boundary) As Boolean
            If CenterPoint.Y < box.TopLeft.Y Then
                Return True
            ElseIf CenterPoint.Y > box.BottomRight.Y Then
                Return True
            ElseIf CenterPoint.X < box.TopLeft.X Then
                Return True
            ElseIf CenterPoint.X > box.BottomRight.X Then
                Return True
            Else
                Return False
            End If
        End Function

        Private Function Distance(ByVal p1 As Point, ByVal p2 As Point) As Double
            Return Math.Sqrt((p1.X - p2.X) ^ 2 + (p1.Y - p2.Y) ^ 2)
        End Function

        Public Function DoesCircleContainPoint(ByVal p1 As Point) As Boolean
            Dim d As Double
            d = Distance(p1, CenterPoint)

            'Determine if the point is within the Circle
            If d < Radius Then
                Return True
            Else
                'We will detect more creationpoints of the circle here and 
                'add them to the Circle creation point list for later usage
                If d = Radius Then
                    CreationPoints.Add(p1)
                End If
                Return False
            End If
        End Function

        Public Sub ReturnCenterPoint(ByVal can As Canvas)
            Dim p As New Ellipse
            p.Fill = Brushes.Blue
            p.StrokeThickness = 2
            p.Stroke = Brushes.Blue

            ' Set the width and height of the Ellipse.
            p.Width = 5
            p.Height = 5

            can.Children.Add(p)
            Canvas.SetLeft(p, CenterPoint.X - 2.5)
            Canvas.SetTop(p, CenterPoint.Y - 2.5)
        End Sub

        Public Sub ReturnEllipse(ByVal can As Canvas)
            Dim p As New Ellipse
            Dim mySolidColorBrush As New SolidColorBrush()

            ' Describes the brush's color using RGB values. 
            ' Each value has a range of 0-255. (The resulting color is black)
            mySolidColorBrush.Color = Color.FromArgb(255, 255, 255, 0)
            p.Fill = mySolidColorBrush
            p.StrokeThickness = 2
            p.Stroke = Brushes.Black

            ' Set the width and height of the Ellipse.
            p.Width = Radius * 2
            p.Height = Radius * 2

            can.Children.Add(p)
            Canvas.SetLeft(p, CenterPoint.X - Radius)
            Canvas.SetTop(p, CenterPoint.Y - Radius)
        End Sub

        Public Sub CreatCircleFromThreePoints(ByVal Point1 As Point, ByVal Point2 As Point, ByVal Point3 As Point)
            Dim Pt(3) As Point
            Pt(0) = Point1
            Pt(1) = Point2
            Pt(2) = Point3

            CreationPoints.Add(New Point(Pt(0).X, Pt(0).Y))
            CreationPoints.Add(New Point(Pt(1).X, Pt(1).Y))
            CreationPoints.Add(New Point(Pt(2).X, Pt(2).Y))

            GetCircleRectFromPoints(Pt)
        End Sub

        Private OldLine As VoronoiLine
        Public Sub CreatCircleFromVoronoiLine(ByVal VoronoiLine As VoronoiLine, ByVal Point3 As Point)
            OldLine = VoronoiLine
            Dim Pt(3) As Point
            Pt(0) = VoronoiLine.CreationPointRight
            Pt(1) = VoronoiLine.CreationPointLeft
            Pt(2) = Point3

            CreationPoints.Add(New Point(Pt(0).X, Pt(0).Y))
            CreationPoints.Add(New Point(Pt(1).X, Pt(1).Y))
            CreationPoints.Add(New Point(Pt(2).X, Pt(2).Y))

            GetCircleRectFromPoints(Pt)
        End Sub

        Public Sub AddVoronoiLines(ByVal diagram As List(Of VoronoiLine))
            OldLine.EndPointCreatedByCircle = True
            OldLine.EndPoint = CenterPoint

            Dim Right As New VoronoiLine
            Right.ParabolicCut(OldLine.CreationPointRight, CreationPoints(2), CreationPoints(2).Y)
            Right.VoronoiParent = OldLine

            Dim Left As New VoronoiLine
            Left.ParabolicCut(OldLine.CreationPointLeft, CreationPoints(2), CreationPoints(2).Y)
            Left.VoronoiParent = OldLine

            If OldLine.WhichSide(Right.StartPoint) = OldLine.WhichSide(OldLine.CreationPointRight) Then
                Right.StartPoint = CenterPoint
                Right.StartPointCreatedByCircle = True
            Else
                Right.EndPoint = CenterPoint
                Right.EndPointCreatedByCircle = True

            End If

            diagram.Add(Right)

            If OldLine.WhichSide(Left.StartPoint) = OldLine.WhichSide(OldLine.CreationPointLeft) Then
                Left.StartPoint = CenterPoint
                Left.StartPointCreatedByCircle = True
            Else
                Left.EndPoint = CenterPoint
                Left.EndPointCreatedByCircle = True
            End If

            diagram.Add(Left)

        End Sub

        Private Function PointsAboveCenterPointInCircle() As Integer
            Dim result As Integer = 0
            For Each p As Point In CreationPoints
                If p.Y >= CenterPoint.Y Then
                    result += 1
                End If
            Next
            Return result
        End Function

        Private Sub GetCircleRectFromPoints(ByVal Pts() As Point) 'As RectangleF
            '(X - Cx)^2 + (Y - Cy)^2 = R^2
            '(R^2 - Cx^2 - Cy^2) + 2X*Cx + 2Y*Cy = X^2 +  Y^2
            'Cr + A*X + B*Y = X^2 + Y^2
            'Solve matrix using gaussian elimination.
            Dim N As Integer = Pts.Length - 1
            Dim X(N, N) As Double, Y(N) As Double
            For I As Integer = 0 To N
                X(I, 0) = 1 : X(I, 1) = Pts(I).X : X(I, 2) = Pts(I).Y
                Y(I) = X(I, 1) * X(I, 1) + X(I, 2) * X(I, 2)
            Next
            Dim MatInv As New Elimination
            MatInv.ComputeCoefficents(X, Y)
            Dim A As Single = CSng(Y(1) / 2)
            Dim B As Single = CSng(Y(2) / 2)
            Dim R As Single = CSng(Math.Sqrt(Y(0) + A * A + B * B))
            CenterPoint = New Point(A, B)
            Radius = R
            ' Return New RectangleF(A - R, B - R, 2 * R, 2 * R)
        End Sub

        Private Class Elimination
            Sub ComputeCoefficents(ByVal X(,) As Double, ByVal Y() As Double)
                Dim I, J, K, K1, N As Integer
                N = Y.Length
                For K = 0 To N - 1
                    K1 = K + 1
                    For I = K To N - 1
                        If X(I, K) <> 0 Then
                            For J = K1 To N - 1
                                X(I, J) /= X(I, K)
                            Next J
                            Y(I) /= X(I, K)
                        End If
                    Next I
                    For I = K1 To N - 1
                        If X(I, K) <> 0 Then
                            For J = K1 To N - 1
                                X(I, J) -= X(K, J)
                            Next J
                            Y(I) -= Y(K)
                        End If
                    Next I
                Next K
                For I = N - 2 To 0 Step -1
                    For J = N - 1 To I + 1 Step -1
                        Y(I) -= X(I, J) * Y(J)
                    Next J
                Next I
            End Sub
        End Class


    End Class
End Class




By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Kenneth Haugland
Engineer
Norway Norway
I hope that you like the stuff I have created and if you do wish to say thank you then a donation is always appreciated.
You can donate here[^].

| Advertise | Privacy | Terms of Use | Mobile
Web03 | 2.8.141223.1 | Last Updated 17 Jul 2012
Article Copyright 2012 by Kenneth Haugland
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid