Advertisement
Guest User

Untitled

a guest
Jan 22nd, 2017
121
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 15.83 KB | None | 0 0
  1. Imports System.IO
  2.  
  3. Public Class Form1
  4. Private minimum As Integer = 3
  5. Dim Pen As System.Drawing.Pen
  6.  
  7. Private Function DivideHull(ByVal start As aPoint, ByVal fin As aPoint, ByVal allVertices As List(Of aPoint)) As List(Of aPoint)
  8. allVertices.TrimExcess()
  9. allVertices.Sort()
  10. allVertices.Add(fin)
  11. allVertices.Insert(0, start)
  12.  
  13. If allVertices.Count <= minimum Then
  14. Return ConvexHull(allVertices)
  15. Else
  16. Dim split1 = New List(Of aPoint)
  17. Dim split2 = New List(Of aPoint)
  18. Split(allVertices, split1, split2)
  19. Return combineHulls(DivideHull(split1), DivideHull(split2))
  20. End If
  21. End Function
  22. Private Function DivideHull(ByVal allVertices As List(Of aPoint)) As List(Of aPoint)
  23.  
  24. If allVertices.Count <= minimum Then
  25. Return ConvexHull(allVertices)
  26. Else
  27. Dim split1 = New List(Of aPoint)
  28. Dim split2 = New List(Of aPoint)
  29. Split(allVertices, split1, split2)
  30. Return combineHulls(DivideHull(split1), DivideHull(split2))
  31. End If
  32. End Function
  33.  
  34. Private Sub Split(ByVal allVertices As List(Of aPoint), ByRef split1 As List(Of aPoint), ByRef split2 As List(Of aPoint))
  35.  
  36. Dim med As Double = allVertices.Count / 2
  37.  
  38. For ct As Integer = 0 To allVertices.Count - 1
  39. If ct < med Then
  40. split1.Add(allVertices.ElementAt(ct))
  41. Else
  42. split2.Add(allVertices.ElementAt(ct))
  43. End If
  44. Next
  45. End Sub
  46. Private Function ConvexHull(ByVal allVertices As List(Of aPoint))
  47.  
  48. Dim upperVertices As List(Of aPoint) = CalcUpper(allVertices)
  49. Dim lowerVertices As List(Of aPoint) = CalcLower(allVertices)
  50. Dim returnList As New List(Of aPoint)
  51. returnList = merge(upperVertices, lowerVertices)
  52. Return returnList
  53.  
  54. End Function
  55.  
  56. Private Function combineHulls(ByVal hull1 As List(Of aPoint), ByVal hull2 As List(Of aPoint)) As List(Of aPoint)
  57. Dim upperTangents As List(Of aPoint) = findUpperTangent(hull1, hull2)
  58. Dim lowerTangents As List(Of aPoint) = findLowerTangent(hull1, hull2)
  59. Dim upperRight, lowerRight, upperLeft, lowerLeft, thisPoint As aPoint
  60. Dim mergedHull As New List(Of aPoint)
  61. upperLeft = upperTangents.ElementAt(0)
  62. upperRight = upperTangents.ElementAt(1)
  63. lowerLeft = lowerTangents.ElementAt(0)
  64. lowerRight = lowerTangents.ElementAt(1)
  65.  
  66. Dim ct As Integer
  67.  
  68. ct = hull1.IndexOf(upperLeft)
  69. thisPoint = upperLeft
  70. Do Until thisPoint.getPoint = lowerLeft.getPoint
  71. mergedHull.Add(thisPoint)
  72. ct = modulus(ct + 1, hull1.Count)
  73. thisPoint = hull1.ElementAt(ct)
  74. Loop
  75. mergedHull.Add(thisPoint)
  76. ct = hull2.IndexOf(lowerRight)
  77. thisPoint = lowerRight
  78. Do Until thisPoint.getPoint = upperRight.getPoint
  79. mergedHull.Add(thisPoint)
  80. ct = modulus(ct + 1, hull2.Count)
  81. thisPoint = hull2.ElementAt(ct)
  82. Loop
  83. mergedHull.Add(thisPoint)
  84. Return mergedHull
  85.  
  86. End Function
  87.  
  88. Private Function findUpperTangent(ByVal shape1 As List(Of aPoint), ByVal shape2 As List(Of aPoint)) As List(Of aPoint)
  89. Dim pointerHull1, pointerHull2 As Integer
  90. Dim finished As Boolean
  91. Dim returnTop As New List(Of aPoint)
  92. pointerHull1 = 0
  93. pointerHull2 = 0
  94. For Each v As aPoint In shape1
  95. If v.getPoint.X >= shape1.ElementAt(pointerHull1).getPoint.X Then
  96. pointerHull1 = shape1.IndexOf(v)
  97. End If
  98. Next
  99. For Each v As aPoint In shape2
  100. If v.getPoint.X < shape2.ElementAt(pointerHull2).getPoint.X Then
  101. pointerHull2 = shape2.IndexOf(v)
  102. End If
  103. Next
  104.  
  105. Do
  106. finished = True
  107. Do While (rightTurn(shape1.ElementAt(modulus(pointerHull1, shape1.Count)), shape1.ElementAt(modulus(pointerHull1 + 1, shape1.Count)), shape2.ElementAt(modulus(pointerHull1, shape2.Count))))
  108. pointerHull1 = modulus(pointerHull1 + 1, shape1.Count)
  109. Loop
  110. Do While (leftTurn(shape2.ElementAt(modulus(pointerHull2, shape2.Count)), shape2.ElementAt(modulus(pointerHull2 - 1, shape2.Count)), shape1.ElementAt(modulus(pointerHull1, shape1.Count))))
  111. pointerHull2 = modulus(pointerHull2 - 1, shape2.Count)
  112. finished = False
  113. Loop
  114. Loop While finished = False
  115. returnTop.Add(shape1.ElementAt(modulus(pointerHull1, shape1.Count)))
  116. returnTop.Add(shape2.ElementAt(modulus(pointerHull2, shape2.Count)))
  117. Return returnTop
  118. End Function
  119. Private Function findLowerTangent(ByVal shape1 As List(Of aPoint), ByVal shape2 As List(Of aPoint)) As List(Of aPoint)
  120. Dim ptrHull1, ptrHull2 As Integer
  121. Dim finished As Boolean
  122. Dim returnLower As New List(Of aPoint)
  123.  
  124. ptrHull1 = 0
  125. ptrHull2 = 0
  126. For Each v As aPoint In shape1
  127. If v.getPoint.X > shape1.ElementAt(ptrHull1).getPoint.X Then
  128. ptrHull1 = shape1.IndexOf(v)
  129. End If
  130. Next
  131. For Each v As aPoint In shape2
  132. If v.getPoint.X <= shape2.ElementAt(ptrHull2).getPoint.X Then
  133. ptrHull2 = shape2.IndexOf(v)
  134. End If
  135. Next
  136. Do
  137. finished = True
  138. Do While (leftTurn(shape1.ElementAt(modulus(ptrHull1, shape1.Count)), shape1.ElementAt(modulus(ptrHull1 - 1, shape1.Count)), shape2.ElementAt(modulus(ptrHull2, shape2.Count))))
  139. ptrHull1 = modulus(ptrHull1 - 1, shape1.Count)
  140. Loop
  141. Do While (rightTurn(shape2.ElementAt(modulus(ptrHull2, shape2.Count)), shape2.ElementAt(modulus(ptrHull2 + 1, shape2.Count)), shape1.ElementAt(modulus(ptrHull1, shape1.Count))))
  142. ptrHull2 = modulus(ptrHull2 + 1, shape2.Count)
  143. finished = False
  144. Loop
  145. Loop While finished = False
  146. returnLower.Add(shape1.ElementAt(modulus(ptrHull1, shape1.Count)))
  147. returnLower.Add(shape2.ElementAt(modulus(ptrHull2, shape2.Count)))
  148. Return returnLower
  149. End Function
  150.  
  151. Private Function rightTurn(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Boolean
  152. If (CalcTurningDirection(x, y, z) > 0) Then
  153. Return True
  154. Else
  155. Return False
  156. End If
  157. End Function
  158.  
  159. Private Function leftTurn(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Boolean
  160. If (CalcTurningDirection(x, y, z) < 0) Then
  161. Return True
  162. Else
  163. Return False
  164. End If
  165. End Function
  166. Private Function merge(ByVal list1 As List(Of aPoint), ByVal list2 As List(Of aPoint)) As List(Of aPoint)
  167. Dim returnList As New List(Of aPoint)
  168. returnList = list2
  169. list1.Sort()
  170.  
  171. For i As Integer = list1.Count - 1 To 0 Step -1
  172. If Not list2.Contains(list1.ElementAt(i)) Then
  173. returnList.Add(list1.ElementAt(i))
  174. End If
  175. Next
  176. Return returnList
  177. End Function
  178. Private Function CalcUpper(ByVal Points As List(Of aPoint)) As List(Of aPoint)
  179. If Points.Count = 1 Then
  180. Return Points
  181. End If
  182. Dim Upper = New List(Of aPoint)
  183. Upper.Add(Points(0))
  184. Upper.Add(Points(1))
  185. Dim lastTurn As Double
  186. Dim lupperct = 2
  187. For ct As Integer = 2 To Points.Count - 1
  188. Upper.Add(Points.ElementAt(ct))
  189. Do
  190. lupperct = Upper.Count
  191. lastTurn = CalcTurningDirection(Upper.ElementAt(lupperct - 3), Upper.ElementAt(lupperct - 2), Upper.ElementAt(lupperct - 1))
  192. If lastTurn <= 0 Then
  193. Upper.RemoveAt(Upper.Count - 2)
  194. Else
  195. Exit Do
  196. End If
  197. Loop While (Upper.Count > 2 And lastTurn <= 0)
  198. Next
  199. Return Upper
  200. End Function
  201. Private Function CalcLower(ByVal lstPoints As List(Of aPoint)) As List(Of aPoint)
  202. If lstPoints.Count = 1 Then
  203. Return lstPoints
  204. End If
  205. Dim Lower = New List(Of aPoint)
  206. Lower.Add(lstPoints(0))
  207. Lower.Add(lstPoints(1))
  208. Dim lastTurn As Double
  209. Dim Llowerct = 2
  210. For ct As Integer = 2 To lstPoints.Count - 1
  211. Lower.Add(lstPoints.ElementAt(ct))
  212. Do
  213. Llowerct = Lower.Count
  214. lastTurn = CalcTurningDirection(Lower.ElementAt(Llowerct - 3), Lower.ElementAt(Llowerct - 2), Lower.ElementAt(Llowerct - 1))
  215. If lastTurn >= 0 Then
  216. Lower.RemoveAt(Lower.Count - 2)
  217. Else
  218. Exit Do
  219. End If
  220. Loop While (Lower.Count > 2 And lastTurn >= 0)
  221. Next
  222. Return Lower
  223. End Function
  224. Private Function CalcTurningDirection(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint)
  225. Dim point1 As Point = x.getPoint
  226. Dim point2 As Point = y.getPoint
  227. Dim point3 As Point = z.getPoint
  228. Return (point2.X - point1.X) * (point3.Y - point1.Y) - (point2.Y - point1.Y) * (point3.X - point1.X)
  229. End Function
  230. Private Function CalcAngle(ByVal x As aPoint, ByVal y As aPoint) As Double
  231. Dim point1 As Point = x.getPoint
  232. Dim point2 As Point = y.getPoint
  233. Dim changeX, changeY As Integer
  234. changeX = point2.X - point1.X
  235. changeY = point2.Y - point1.Y
  236.  
  237. Return Math.Atan2(changeY, changeX)
  238. End Function
  239. Private Function CalcAngle(ByVal x As aPoint, ByVal y As aPoint, ByVal z As aPoint) As Double
  240. Dim xyLength, xzLength, yzLength As Double
  241. xyLength = CalcLength(x, y)
  242. xzLength = CalcLength(x, z)
  243. yzLength = CalcLength(y, z)
  244. Dim temp As Double = Math.Acos((xyLength ^ 2 + yzLength ^ 2 - xzLength ^ 2) / (2 * xyLength * xzLength))
  245. Return temp
  246. End Function
  247. Private Function CalcLength(ByVal x As aPoint, ByVal y As aPoint) As Double
  248. Dim point1 As Point = x.getPoint
  249. Dim point2 As Point = y.getPoint
  250. Return Math.Sqrt((point1.X - point2.X) ^ 2 + (point1.Y - point2.Y) ^ 2)
  251. End Function
  252. Public Sub DrawPoint(ByVal x As Integer, ByVal y As Integer)
  253. Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
  254. Dim formGraphics As System.Drawing.Graphics
  255. formGraphics = Me.CreateGraphics
  256.  
  257. formGraphics.DrawLine(myPen, x - 5, y - 5, x + 5, y + 5)
  258. formGraphics.DrawLine(myPen, x + 5, y - 5, x - 5, y + 5)
  259. myPen.Dispose()
  260. formGraphics.Dispose()
  261. End Sub
  262. Public Sub DrawPoint(ByVal x As Integer, ByVal y As Integer, ByVal label As Char)
  263. DrawPoint(x, y)
  264. Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
  265. Dim formGraphics As System.Drawing.Graphics
  266. formGraphics = Me.CreateGraphics
  267. formGraphics.DrawString(label, DefaultFont, Brushes.Black, New Point(x - 5, y + 5))
  268. End Sub
  269. Public Sub DrawPoint(ByVal point As Point)
  270. DrawPoint(point.X, point.Y)
  271. End Sub
  272. Public Sub DrawPoint(ByVal point As Point, label As Char)
  273. DrawPoint(point.X, point.Y, label)
  274. End Sub
  275. Private Function LoadObstacleFromFile(ByVal FilePath As String) As Obstacle
  276. Dim tempObstacle As Obstacle
  277. Dim obstacleList As List(Of aPoint) = New List(Of aPoint)
  278. Dim input As String
  279. Dim read As StreamReader = My.Computer.FileSystem.OpenTextFileReader(FilePath)
  280. Dim intputArray() As String
  281. Do
  282. input = read.ReadLine
  283. Try
  284. intputArray = input.Split(",")
  285. Catch
  286. Exit Do
  287. End Try
  288. obstacleList.Add(New aPoint(New Point(intputArray(0), intputArray(1)), Nothing))
  289. Loop Until input Is Nothing
  290.  
  291. tempObstacle = New Obstacle(obstacleList)
  292.  
  293. Return tempObstacle
  294. End Function
  295. Private Function modulus(number As Integer, remainder As Integer) As Integer
  296. If number < 0 Then
  297. Do While number < 0
  298. number += remainder
  299. Loop
  300. Else
  301. number = number Mod remainder
  302. End If
  303. Return number
  304. End Function
  305. Public Sub DrawObstacle(ByVal obstacle As List(Of aPoint))
  306. Dim lastPoint As Point = Nothing
  307. If obstacle Is Nothing Then
  308. Exit Sub
  309. End If
  310. For Each v As aPoint In obstacle
  311. DrawPoint(v.getPoint)
  312. If Not lastPoint = Nothing Then
  313. DrawLine(lastPoint, v.getPoint)
  314. End If
  315. lastPoint = v.getPoint
  316. Next
  317. DrawLine(lastPoint, obstacle.ElementAt(0).getPoint)
  318. End Sub
  319. Public Sub DrawLine(ByVal startpt As Point, ByVal endpt As Point)
  320. Pen = New System.Drawing.Pen(Color.Black)
  321. Dim display As System.Drawing.Graphics
  322. display = Me.CreateGraphics
  323. display.DrawLine(Pen, startpt, endpt)
  324. End Sub
  325.  
  326. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  327. Dim start As aPoint = New aPoint(New Point(0, 45), Nothing)
  328. Dim finish As aPoint = New aPoint(New Point(250, 45), Nothing)
  329. Dim Obstacle As Obstacle = LoadObstacleFromFile("C:\Users\Luke\Documents\Visual Studio 2015\Projects\Algorithms\Algorithms\Obstacle.txt")
  330. Obstacle.PrintObstacle()
  331. Dim convexhullresult As List(Of aPoint) = DivideHull(start, finish, Obstacle.getVertices)
  332. DrawObstacle(convexhullresult)
  333. DrawPoint(start.getPoint, "A")
  334. DrawPoint(finish.getPoint, "B")
  335.  
  336.  
  337.  
  338. End Sub
  339.  
  340.  
  341. Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  342.  
  343. End Sub
  344. End Class
  345.  
  346. Public Class Obstacle
  347. Private allVertices As List(Of aPoint)
  348. Public Sub New(_allVertices As List(Of aPoint))
  349.  
  350. allVertices = _allVertices
  351. End Sub
  352. Public Function getVertices() As List(Of aPoint)
  353. Dim returnList = New List(Of aPoint)
  354. For Each v As aPoint In allVertices
  355. returnList.Add(v)
  356. Next
  357. Return returnList
  358. End Function
  359. Public Sub setVertices(_allVertices As List(Of aPoint))
  360. allVertices = _allVertices
  361. End Sub
  362. Public Sub PrintObstacle()
  363. Dim lastPoint As Point = Nothing
  364. For Each v As aPoint In allVertices
  365. Form1.DrawPoint(v.getPoint)
  366. If Not lastPoint = Nothing Then
  367. Form1.DrawLine(lastPoint, v.getPoint)
  368. End If
  369.  
  370. lastPoint = v.getPoint
  371. Next
  372. Form1.DrawLine(lastPoint, allVertices.ElementAt(0).getPoint)
  373. End Sub
  374.  
  375. End Class
  376.  
  377.  
  378. Public Class aPoint
  379. Implements IComparer(Of aPoint)
  380. Implements IComparable(Of aPoint)
  381. Private point As Point
  382. Private nextVertex As aPoint
  383. Public Function CompareTo(ByVal other As aPoint) _
  384. As Integer _
  385. Implements IComparable(Of aPoint).CompareTo
  386.  
  387. Return Compare(Me, other)
  388.  
  389. End Function
  390. Public Function Compare(x As aPoint, y As aPoint) _
  391. As Integer _
  392. Implements System.Collections.Generic.IComparer(Of aPoint).Compare
  393. Dim returnVal As Integer = x.point.X.CompareTo(y.point.X)
  394. If returnVal <> 0 Then
  395. Return returnVal
  396. Else
  397. If x.point.Y <= y.point.Y Then
  398. Return +1
  399. Else
  400. Return -1
  401. End If
  402. End If
  403.  
  404. End Function
  405. Public Sub New(_point As Point, _nextVertex As aPoint)
  406. point = _point
  407. nextVertex = _nextVertex
  408. End Sub
  409. Public Function getPoint() As Point
  410. Return point
  411. End Function
  412. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement