Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Imports System.IO
- Public Class Form1
- Private minimum As Integer = 3
- Dim Pen As System.Drawing.Pen
- Private Function DivideHull(ByVal start As aPoint, ByVal fin As aPoint, ByVal allVertices As List(Of aPoint)) As List(Of aPoint)
- allVertices.TrimExcess()
- allVertices.Sort()
- allVertices.Add(fin)
- allVertices.Insert(0, start)
- If allVertices.Count <= minimum Then
- Return ConvexHull(allVertices)
- Else
- Dim split1 = New List(Of aPoint)
- Dim split2 = New List(Of aPoint)
- Split(allVertices, split1, split2)
- Return combineHulls(DivideHull(split1), DivideHull(split2))
- End If
- End Function
- Private Function DivideHull(ByVal allVertices As List(Of aPoint)) As List(Of aPoint)
- If allVertices.Count <= minimum Then
- Return ConvexHull(allVertices)
- Else
- Dim split1 = New List(Of aPoint)
- Dim split2 = New List(Of aPoint)
- Split(allVertices, split1, split2)
- Return combineHulls(DivideHull(split1), DivideHull(split2))
- End If
- End Function
- Private Sub Split(ByVal allVertices As List(Of aPoint), ByRef split1 As List(Of aPoint), ByRef split2 As List(Of aPoint))
- Dim med As Double = allVertices.Count / 2
- For ct As Integer = 0 To allVertices.Count - 1
- If ct < med Then
- split1.Add(allVertices.ElementAt(ct))
- Else
- split2.Add(allVertices.ElementAt(ct))
- End If
- Next
- End Sub
- Private Function ConvexHull(ByVal allVertices As List(Of aPoint))
- Dim upperVertices As List(Of aPoint) = CalcUpper(allVertices)
- Dim lowerVertices As List(Of aPoint) = CalcLower(allVertices)
- Dim returnList As New List(Of aPoint)
- returnList = merge(upperVertices, lowerVertices)
- Return returnList
- End Function
- Private Function combineHulls(ByVal hull1 As List(Of aPoint), ByVal hull2 As List(Of aPoint)) As List(Of aPoint)
- Dim upperTangents As List(Of aPoint) = findUpperTangent(hull1, hull2)
- Dim lowerTangents As List(Of aPoint) = findLowerTangent(hull1, hull2)
- Dim upperRight, lowerRight, upperLeft, lowerLeft, thisPoint As aPoint
- Dim mergedHull As New List(Of aPoint)
- upperLeft = upperTangents.ElementAt(0)
- upperRight = upperTangents.ElementAt(1)
- lowerLeft = lowerTangents.ElementAt(0)
- lowerRight = lowerTangents.ElementAt(1)
- Dim ct As Integer
- ct = hull1.IndexOf(upperLeft)
- thisPoint = upperLeft
- Do Until thisPoint.getPoint = lowerLeft.getPoint
- mergedHull.Add(thisPoint)
- ct = modulus(ct + 1, hull1.Count)
- thisPoint = hull1.ElementAt(ct)
- Loop
- mergedHull.Add(thisPoint)
- ct = hull2.IndexOf(lowerRight)
- thisPoint = lowerRight
- Do Until thisPoint.getPoint = upperRight.getPoint
- mergedHull.Add(thisPoint)
- ct = modulus(ct + 1, hull2.Count)
- thisPoint = hull2.ElementAt(ct)
- Loop
- mergedHull.Add(thisPoint)
- Return mergedHull
- End Function
- Private Function findUpperTangent(ByVal shape1 As List(Of aPoint), ByVal shape2 As List(Of aPoint)) As List(Of aPoint)
- Dim pointerHull1, pointerHull2 As Integer
- Dim finished As Boolean
- Dim returnTop As New List(Of aPoint)
- pointerHull1 = 0
- pointerHull2 = 0
- For Each v As aPoint In shape1
- If v.getPoint.X >= shape1.ElementAt(pointerHull1).getPoint.X Then
- pointerHull1 = shape1.IndexOf(v)
- End If
- Next
- For Each v As aPoint In shape2
- If v.getPoint.X < shape2.ElementAt(pointerHull2).getPoint.X Then
- pointerHull2 = shape2.IndexOf(v)
- End If
- Next
- Do
- finished = True
- Do While (rightTurn(shape1.ElementAt(modulus(pointerHull1, shape1.Count)), shape1.ElementAt(modulus(pointerHull1 + 1, shape1.Count)), shape2.ElementAt(modulus(pointerHull1, shape2.Count))))
- pointerHull1 = modulus(pointerHull1 + 1, shape1.Count)
- Loop
- Do While (leftTurn(shape2.ElementAt(modulus(pointerHull2, shape2.Count)), shape2.ElementAt(modulus(pointerHull2 - 1, shape2.Count)), shape1.ElementAt(modulus(pointerHull1, shape1.Count))))
- pointerHull2 = modulus(pointerHull2 - 1, shape2.Count)
- finished = False
- Loop
- Loop While finished = False
- returnTop.Add(shape1.ElementAt(modulus(pointerHull1, shape1.Count)))
- returnTop.Add(shape2.ElementAt(modulus(pointerHull2, shape2.Count)))
- Return returnTop
- End Function
- Private Function findLowerTangent(ByVal shape1 As List(Of aPoint), ByVal shape2 As List(Of aPoint)) As List(Of aPoint)
- Dim ptrHull1, ptrHull2 As Integer
- Dim finished As Boolean
- Dim returnLower As New List(Of aPoint)
- ptrHull1 = 0
- ptrHull2 = 0
- For Each v As aPoint In shape1
- If v.getPoint.X > shape1.ElementAt(ptrHull1).getPoint.X Then
- ptrHull1 = shape1.IndexOf(v)
- End If
- Next
- For Each v As aPoint In shape2
- If v.getPoint.X <= shape2.ElementAt(ptrHull2).getPoint.X Then
- ptrHull2 = shape2.IndexOf(v)
- End If
- Next
- Do
- finished = True
- Do While (leftTurn(shape1.ElementAt(modulus(ptrHull1, shape1.Count)), shape1.ElementAt(modulus(ptrHull1 - 1, shape1.Count)), shape2.ElementAt(modulus(ptrHull2, shape2.Count))))
- ptrHull1 = modulus(ptrHull1 - 1, shape1.Count)
- Loop
- Do While (rightTurn(shape2.ElementAt(modulus(ptrHull2, shape2.Count)), shape2.ElementAt(modulus(ptrHull2 + 1, shape2.Count)), shape1.ElementAt(modulus(ptrHull1, shape1.Count))))
- ptrHull2 = modulus(ptrHull2 + 1, shape2.Count)
- finished = False
- Loop
- Loop While finished = False
- returnLower.Add(shape1.ElementAt(modulus(ptrHull1, shape1.Count)))
- returnLower.Add(shape2.ElementAt(modulus(ptrHull2, shape2.Count)))
- Return returnLower
- End Function
- Private Function rightTurn(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Boolean
- If (CalcTurningDirection(x, y, z) > 0) Then
- Return True
- Else
- Return False
- End If
- End Function
- Private Function leftTurn(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Boolean
- If (CalcTurningDirection(x, y, z) < 0) Then
- Return True
- Else
- Return False
- End If
- End Function
- Private Function merge(ByVal list1 As List(Of aPoint), ByVal list2 As List(Of aPoint)) As List(Of aPoint)
- Dim returnList As New List(Of aPoint)
- returnList = list2
- list1.Sort()
- For i As Integer = list1.Count - 1 To 0 Step -1
- If Not list2.Contains(list1.ElementAt(i)) Then
- returnList.Add(list1.ElementAt(i))
- End If
- Next
- Return returnList
- End Function
- Private Function CalcUpper(ByVal Points As List(Of aPoint)) As List(Of aPoint)
- If Points.Count = 1 Then
- Return Points
- End If
- Dim Upper = New List(Of aPoint)
- Upper.Add(Points(0))
- Upper.Add(Points(1))
- Dim lastTurn As Double
- Dim lupperct = 2
- For ct As Integer = 2 To Points.Count - 1
- Upper.Add(Points.ElementAt(ct))
- Do
- lupperct = Upper.Count
- lastTurn = CalcTurningDirection(Upper.ElementAt(lupperct - 3), Upper.ElementAt(lupperct - 2), Upper.ElementAt(lupperct - 1))
- If lastTurn <= 0 Then
- Upper.RemoveAt(Upper.Count - 2)
- Else
- Exit Do
- End If
- Loop While (Upper.Count > 2 And lastTurn <= 0)
- Next
- Return Upper
- End Function
- Private Function CalcLower(ByVal lstPoints As List(Of aPoint)) As List(Of aPoint)
- If lstPoints.Count = 1 Then
- Return lstPoints
- End If
- Dim Lower = New List(Of aPoint)
- Lower.Add(lstPoints(0))
- Lower.Add(lstPoints(1))
- Dim lastTurn As Double
- Dim Llowerct = 2
- For ct As Integer = 2 To lstPoints.Count - 1
- Lower.Add(lstPoints.ElementAt(ct))
- Do
- Llowerct = Lower.Count
- lastTurn = CalcTurningDirection(Lower.ElementAt(Llowerct - 3), Lower.ElementAt(Llowerct - 2), Lower.ElementAt(Llowerct - 1))
- If lastTurn >= 0 Then
- Lower.RemoveAt(Lower.Count - 2)
- Else
- Exit Do
- End If
- Loop While (Lower.Count > 2 And lastTurn >= 0)
- Next
- Return Lower
- End Function
- Private Function CalcTurningDirection(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint)
- Dim point1 As Point = x.getPoint
- Dim point2 As Point = y.getPoint
- Dim point3 As Point = z.getPoint
- Return (point2.X - point1.X) * (point3.Y - point1.Y) - (point2.Y - point1.Y) * (point3.X - point1.X)
- End Function
- Private Function CalcAngle(ByVal x As aPoint, ByVal y As aPoint) As Double
- Dim point1 As Point = x.getPoint
- Dim point2 As Point = y.getPoint
- Dim changeX, changeY As Integer
- changeX = point2.X - point1.X
- changeY = point2.Y - point1.Y
- Return Math.Atan2(changeY, changeX)
- End Function
- Private Function CalcAngle(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Double
- Dim xyLength, xzLength, yzLength As Double
- xyLength = CalcLength(x, y)
- xzLength = CalcLength(x, z)
- yzLength = CalcLength(y, z)
- Dim temp As Double = Math.Acos((xyLength ^ 2 + yzLength ^ 2 - xzLength ^ 2) / (2 * xyLength * xzLength))
- Return temp
- End Function
- Private Function CalcLength(ByVal x As aPoint, ByVal y As aPoint) As Double
- Dim point1 As Point = x.getPoint
- Dim point2 As Point = y.getPoint
- Return Math.Sqrt((point1.X - point2.X) ^ 2 + (point1.Y - point2.Y) ^ 2)
- End Function
- Public Sub DrawPoint(ByVal x As Integer, ByVal y As Integer)
- Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
- Dim formGraphics As System.Drawing.Graphics
- formGraphics = Me.CreateGraphics
- formGraphics.DrawLine(myPen, x - 5, y - 5, x + 5, y + 5)
- formGraphics.DrawLine(myPen, x + 5, y - 5, x - 5, y + 5)
- myPen.Dispose()
- formGraphics.Dispose()
- End Sub
- Public Sub DrawPoint(ByVal x As Integer, ByVal y As Integer, ByVal label As Char)
- DrawPoint(x, y)
- Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
- Dim formGraphics As System.Drawing.Graphics
- formGraphics = Me.CreateGraphics
- formGraphics.DrawString(label, DefaultFont, Brushes.Black, New Point(x - 5, y + 5))
- End Sub
- Public Sub DrawPoint(ByVal point As Point)
- DrawPoint(point.X, point.Y)
- End Sub
- Public Sub DrawPoint(ByVal point As Point, label As Char)
- DrawPoint(point.X, point.Y, label)
- End Sub
- Private Function LoadObstacleFromFile(ByVal FilePath As String) As Obstacle
- Dim tempObstacle As Obstacle
- Dim obstacleList As List(Of aPoint) = New List(Of aPoint)
- Dim input As String
- Dim read As StreamReader = My.Computer.FileSystem.OpenTextFileReader(FilePath)
- Dim intputArray() As String
- Do
- input = read.ReadLine
- Try
- intputArray = input.Split(",")
- Catch
- Exit Do
- End Try
- obstacleList.Add(New aPoint(New Point(intputArray(0), intputArray(1)), Nothing))
- Loop Until input Is Nothing
- tempObstacle = New Obstacle(obstacleList)
- Return tempObstacle
- End Function
- Private Function modulus(number As Integer, remainder As Integer) As Integer
- If number < 0 Then
- Do While number < 0
- number += remainder
- Loop
- Else
- number = number Mod remainder
- End If
- Return number
- End Function
- Public Sub DrawObstacle(ByVal obstacle As List(Of aPoint))
- Dim lastPoint As Point = Nothing
- If obstacle Is Nothing Then
- Exit Sub
- End If
- For Each v As aPoint In obstacle
- DrawPoint(v.getPoint)
- If Not lastPoint = Nothing Then
- DrawLine(lastPoint, v.getPoint)
- End If
- lastPoint = v.getPoint
- Next
- DrawLine(lastPoint, obstacle.ElementAt(0).getPoint)
- End Sub
- Public Sub DrawLine(ByVal startpt As Point, ByVal endpt As Point)
- Pen = New System.Drawing.Pen(Color.Black)
- Dim display As System.Drawing.Graphics
- display = Me.CreateGraphics
- display.DrawLine(Pen, startpt, endpt)
- End Sub
- Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
- Dim start As aPoint = New aPoint(New Point(0, 45), Nothing)
- Dim finish As aPoint = New aPoint(New Point(250, 45), Nothing)
- Dim Obstacle As Obstacle = LoadObstacleFromFile("C:\Users\Luke\Documents\Visual Studio 2015\Projects\Algorithms\Algorithms\Obstacle.txt")
- Obstacle.PrintObstacle()
- Dim convexhullresult As List(Of aPoint) = DivideHull(start, finish, Obstacle.getVertices)
- DrawObstacle(convexhullresult)
- DrawPoint(start.getPoint, "A")
- DrawPoint(finish.getPoint, "B")
- End Sub
- Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
- End Sub
- End Class
- Public Class Obstacle
- Private allVertices As List(Of aPoint)
- Public Sub New(_allVertices As List(Of aPoint))
- allVertices = _allVertices
- End Sub
- Public Function getVertices() As List(Of aPoint)
- Dim returnList = New List(Of aPoint)
- For Each v As aPoint In allVertices
- returnList.Add(v)
- Next
- Return returnList
- End Function
- Public Sub setVertices(_allVertices As List(Of aPoint))
- allVertices = _allVertices
- End Sub
- Public Sub PrintObstacle()
- Dim lastPoint As Point = Nothing
- For Each v As aPoint In allVertices
- Form1.DrawPoint(v.getPoint)
- If Not lastPoint = Nothing Then
- Form1.DrawLine(lastPoint, v.getPoint)
- End If
- lastPoint = v.getPoint
- Next
- Form1.DrawLine(lastPoint, allVertices.ElementAt(0).getPoint)
- End Sub
- End Class
- Public Class aPoint
- Implements IComparer(Of aPoint)
- Implements IComparable(Of aPoint)
- Private point As Point
- Private nextVertex As aPoint
- Public Function CompareTo(ByVal other As aPoint) _
- As Integer _
- Implements IComparable(Of aPoint).CompareTo
- Return Compare(Me, other)
- End Function
- Public Function Compare(x As aPoint, y As aPoint) _
- As Integer _
- Implements System.Collections.Generic.IComparer(Of aPoint).Compare
- Dim returnVal As Integer = x.point.X.CompareTo(y.point.X)
- If returnVal <> 0 Then
- Return returnVal
- Else
- If x.point.Y <= y.point.Y Then
- Return +1
- Else
- Return -1
- End If
- End If
- End Function
- Public Sub New(_point As Point, _nextVertex As aPoint)
- point = _point
- nextVertex = _nextVertex
- End Sub
- Public Function getPoint() As Point
- Return point
- End Function
- End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement