ALGO: Improve readability by introducing notcw
This commit is contained in:
parent
be2787103a
commit
f82c948055
@ -58,16 +58,34 @@ vp2 :: PT -- ^ vector origin
|
|||||||
vp2 a b = (pt2Vec b) - (pt2Vec a)
|
vp2 a b = (pt2Vec b) - (pt2Vec a)
|
||||||
|
|
||||||
|
|
||||||
-- |Checks if 3 points a,b,c build a counterclock wise triangle by
|
-- |Computes the determinant of 3 points.
|
||||||
-- connecting a-b-c. This is done by computing the determinant and
|
det :: PT -> PT -> PT -> Double
|
||||||
-- checking the algebraic sign.
|
det a b c =
|
||||||
ccw :: PT -> PT -> PT -> Bool
|
|
||||||
ccw a b c =
|
|
||||||
(bx - ax) *
|
(bx - ax) *
|
||||||
(cy - ay) -
|
(cy - ay) -
|
||||||
(by - ay) *
|
(by - ay) *
|
||||||
(cx - ax) >= 0
|
(cx - ax)
|
||||||
where
|
where
|
||||||
(ax, ay) = unp2 a
|
(ax, ay) = unp2 a
|
||||||
(bx, by) = unp2 b
|
(bx, by) = unp2 b
|
||||||
(cx, cy) = unp2 c
|
(cx, cy) = unp2 c
|
||||||
|
|
||||||
|
|
||||||
|
-- |Get the orientation of 3 points which can either be
|
||||||
|
-- * clock-wise
|
||||||
|
-- * counter-clock-wise
|
||||||
|
-- * collinear
|
||||||
|
getOrient :: PT -> PT -> PT -> Alignment
|
||||||
|
getOrient a b c = case compare (det a b c) 0 of
|
||||||
|
GT -> CW
|
||||||
|
LT -> CCW
|
||||||
|
EQ -> CL
|
||||||
|
|
||||||
|
|
||||||
|
--- |Checks if 3 points a,b,c do not build a clockwise triangle by
|
||||||
|
--- connecting a-b-c. This is done by computing the determinant and
|
||||||
|
--- checking the algebraic sign.
|
||||||
|
notcw :: PT -> PT -> PT -> Bool
|
||||||
|
notcw a b c = case getOrient a b c of
|
||||||
|
CW -> False
|
||||||
|
_ -> True
|
||||||
|
@ -8,3 +8,8 @@ import Diagrams.TwoD.Types
|
|||||||
type Vec = R2
|
type Vec = R2
|
||||||
type PT = P2
|
type PT = P2
|
||||||
type Coord = (Double, Double)
|
type Coord = (Double, Double)
|
||||||
|
|
||||||
|
|
||||||
|
data Alignment = CW
|
||||||
|
| CCW
|
||||||
|
| CL
|
||||||
|
@ -25,14 +25,14 @@ return (scanHalf upperHull restu) ++
|
|||||||
|
|
||||||
=== begin scanHalf function ===
|
=== begin scanHalf function ===
|
||||||
scanHalf (min 3 elem => lowerHull) (min 1 elem => rest)
|
scanHalf (min 3 elem => lowerHull) (min 1 elem => rest)
|
||||||
| isCounterClockWise (last3Elements lowerHull) == True
|
| isNotClockWise (last3Elements lowerHull) == True
|
||||||
= scanHalf (lowerHull + head rest) (tail rest)
|
= scanHalf (lowerHull + head rest) (tail rest)
|
||||||
| otherwise
|
| otherwise
|
||||||
= scanHalf (deleteSndToLastElem lowerHull + head rest)
|
= scanHalf (deleteSndToLastElem lowerHull + head rest)
|
||||||
(rest)
|
(rest)
|
||||||
|
|
||||||
scanHalf (min 3 elem => lowerHull ) []
|
scanHalf (min 3 elem => lowerHull ) []
|
||||||
| isCounterClockWise (last3Elements lowerHull) == True
|
| isNotClockWise (last3Elements lowerHull) == True
|
||||||
= return lowerHull
|
= return lowerHull
|
||||||
| otherwise
|
| otherwise
|
||||||
= scanHalf (deleteSndToLastElem lowerHull) []
|
= scanHalf (deleteSndToLastElem lowerHull) []
|
||||||
@ -49,26 +49,26 @@ scanHalf lowerHull _ = lowerHull
|
|||||||
xs = [(100, 100), (200, 450), (250, 250)]
|
xs = [(100, 100), (200, 450), (250, 250)]
|
||||||
ys = [(300, 400), (400, 200)]
|
ys = [(300, 400), (400, 200)]
|
||||||
|
|
||||||
ccw (100, 100) (200, 450) (250, 250) => false, pop snd2last of xs
|
notcw (100, 100) (200, 450) (250, 250) => false, pop snd2last of xs
|
||||||
===
|
===
|
||||||
move first of ys to end of xs
|
move first of ys to end of xs
|
||||||
|
|
||||||
xs = [(100, 100), (250, 250), (300, 400)]
|
xs = [(100, 100), (250, 250), (300, 400)]
|
||||||
ys = [(400, 200)]
|
ys = [(400, 200)]
|
||||||
|
|
||||||
ccw (100, 100), (250, 250) (300, 400) => true
|
notcw (100, 100), (250, 250) (300, 400) => true
|
||||||
===
|
===
|
||||||
move first of ys to end of xs
|
move first of ys to end of xs
|
||||||
|
|
||||||
xs = [(100, 100), (250, 250), (300, 400), (400, 200)]
|
xs = [(100, 100), (250, 250), (300, 400), (400, 200)]
|
||||||
ys = []
|
ys = []
|
||||||
|
|
||||||
ccw (250, 250) (300, 400) (400, 200) => false, pop snd2last of xs
|
notcw (250, 250) (300, 400) (400, 200) => false, pop snd2last of xs
|
||||||
===
|
===
|
||||||
xs = [(100, 100), (250, 250), (400, 200)]
|
xs = [(100, 100), (250, 250), (400, 200)]
|
||||||
ys = []
|
ys = []
|
||||||
|
|
||||||
ccw (100, 100) (250, 250) (400, 200) => false, pop snd2last of xs
|
notcw (100, 100) (250, 250) (400, 200) => false, pop snd2last of xs
|
||||||
===
|
===
|
||||||
xs = [(100, 100), (400, 200)]
|
xs = [(100, 100), (400, 200)]
|
||||||
ys = []
|
ys = []
|
||||||
@ -91,10 +91,10 @@ grahamGetCH vs =
|
|||||||
-> [PT] -- ^ the rest of the points
|
-> [PT] -- ^ the rest of the points
|
||||||
-> [PT] -- ^ all convex hull points for the half
|
-> [PT] -- ^ all convex hull points for the half
|
||||||
scanH hs@(x:y:z:xs) (r':rs')
|
scanH hs@(x:y:z:xs) (r':rs')
|
||||||
| ccw z y x = scanH (r':hs) rs'
|
| notcw z y x = scanH (r':hs) rs'
|
||||||
| otherwise = scanH (x:z:xs) (r':rs')
|
| otherwise = scanH (x:z:xs) (r':rs')
|
||||||
scanH hs@(x:y:z:xs) []
|
scanH hs@(x:y:z:xs) []
|
||||||
| ccw z y x = hs
|
| notcw z y x = hs
|
||||||
| otherwise = scanH (x:z:xs) []
|
| otherwise = scanH (x:z:xs) []
|
||||||
scanH hs (r':rs') = scanH (r':hs) rs'
|
scanH hs (r':rs') = scanH (r':hs) rs'
|
||||||
scanH hs _ = hs
|
scanH hs _ = hs
|
||||||
@ -116,12 +116,12 @@ grahamGetCHSteps vs =
|
|||||||
where
|
where
|
||||||
scanH c' hs@(x:y:z:xs) (r':rs')
|
scanH c' hs@(x:y:z:xs) (r':rs')
|
||||||
| c' >= c = hs
|
| c' >= c = hs
|
||||||
| ccw z y x = scanH (c' + 1) (r':hs) rs'
|
| notcw z y x = scanH (c' + 1) (r':hs) rs'
|
||||||
| otherwise = scanH (c' + 1) (x:z:xs) (r':rs')
|
| otherwise = scanH (c' + 1) (x:z:xs) (r':rs')
|
||||||
scanH _ [x,y] [] = [y,x]
|
scanH _ [x,y] [] = [y,x]
|
||||||
scanH c' hs@(x:y:z:xs) []
|
scanH c' hs@(x:y:z:xs) []
|
||||||
| c' >= c = hs
|
| c' >= c = hs
|
||||||
| ccw z y x = hs
|
| notcw z y x = hs
|
||||||
| otherwise = scanH (c' + 1) (x:z:xs) []
|
| otherwise = scanH (c' + 1) (x:z:xs) []
|
||||||
scanH c' hs (r':rs')
|
scanH c' hs (r':rs')
|
||||||
| c' >= c = hs
|
| c' >= c = hs
|
||||||
|
Loading…
Reference in New Issue
Block a user