hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ALGO: fix algorithm to show collinear points as part of the hull

Browse Source 
There was also a bug to be fixed when doing this. We missed
an important pattern match case which casued wrong results.
This commit is contained in:
hasufell 2014-10-12 19:19:44 +02:00
parent bfcc9bfdf7
commit 37b38115ae
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Algebra/Vector.hs
View File

@ -66,7 +66,7 @@ ccw a b c =
(bx - ax) *
(cy - ay) -
(by - ay) *
(cx - ax) > 0
(cx - ax) >= 0
where
(ax, ay) = unp2 a
(bx, by) = unp2 b

34
Algorithms/ConvexHull/GrahamScan.hs
View File

@ -29,7 +29,7 @@ scanHalf (min 3 elem => lowerHull) (min 1 elem => rest)
= scanHalf (lowerHull + head rest) (tail rest)
| otherwise
= scanHalf (deleteSndToLastElem lowerHull + head rest)
(tail rest)
(rest)
scanHalf (min 3 elem => lowerHull ) []
| isCounterClockWise (last3Elements lowerHull) == True
@ -37,6 +37,10 @@ scanHalf (min 3 elem => lowerHull ) []
| otherwise
= scanHalf (deleteSndToLastElem lowerHull) []
scanHalf lowerHull (min 1 elem => rest) = scanHalf (lowerHull + head rest)
(tail rest)
scanHalf lowerHull _ = lowerHull
=== end scanHalf function ===
@ -87,12 +91,13 @@ grahamGetCH vs =
-> [PT] -- ^ the rest of the points
-> [PT] -- ^ all convex hull points for the half
scanH hs@(x:y:z:xs) (r':rs')
| ccw z y x = scanH (r':hs) rs'
| otherwise = scanH (r':x:z:xs) rs'
| ccw z y x = scanH (r':hs) rs'
| otherwise = scanH (x:z:xs) (r':rs')
scanH hs@(x:y:z:xs) []
| ccw z y x = hs
| otherwise = scanH (x:z:xs) []
scanH xs _ = xs
| ccw z y x = hs
| otherwise = scanH (x:z:xs) []
scanH hs (r':rs') = scanH (r':hs) rs'
scanH hs _ = hs
-- |Compute all steps of the graham scan algorithm to allow
@ -110,12 +115,15 @@ grahamGetCHSteps vs =
| otherwise = []
where
scanH c' hs@(x:y:z:xs) (r':rs')
| c' >= c = hs
| ccw z y x = scanH (c' + 1) (r':hs) rs'
| otherwise = scanH (c' + 1) (r':x:z:xs) rs'
scanH _ [x,y] [] = [y,x]
| c' >= c = hs
| ccw z y x = scanH (c' + 1) (r':hs) rs'
| otherwise = scanH (c' + 1) (x:z:xs) (r':rs')
scanH _ [x,y] [] = [y,x]
scanH c' hs@(x:y:z:xs) []
| c' >= c = hs
| ccw z y x = hs
| otherwise = scanH (c' + 1) (x:z:xs) []
| c' >= c = hs
| ccw z y x = hs
| otherwise = scanH (c' + 1) (x:z:xs) []
scanH c' hs (r':rs')
| c' >= c = hs
| otherwise = scanH (c' + 1) (r':hs) rs'
scanH _ xs _ = xs