From 7cdb867cf4daea6773edc789993f5975f2cf9ad0 Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Mon, 13 Oct 2014 19:49:53 +0200
Subject: [PATCH] ALGO: Split scanH out and make the graham API more modular

---
 Algorithms/ConvexHull/GrahamScan.hs | 49 ++++++++++++++++++-----------
 Graphics/Diagram/Plotter.hs         | 12 +++----
 2 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/Algorithms/ConvexHull/GrahamScan.hs b/Algorithms/ConvexHull/GrahamScan.hs
index f6d3306..856b354 100644
--- a/Algorithms/ConvexHull/GrahamScan.hs
+++ b/Algorithms/ConvexHull/GrahamScan.hs
@@ -76,28 +76,41 @@ ys = []
 return [(100, 100), (400, 200)]
 =========================================================
 --}
-grahamGetCH :: [PT] -> [PT]
-grahamGetCH vs =
-  scanH uH uHRest ++ tailInit (scanH lH lHRest)
+grahamCH :: [PT] -> [PT]
+grahamCH vs = grahamUCH vs ++ (tailInit . grahamLCH $ vs)
+
+
+-- |Get the lower part of the convex hull.
+grahamLCH :: [PT] -> [PT]
+grahamLCH vs = scanH lH lHRest
   where
     sortedXY     = fmap p2 . sortLex . fmap unp2 $ vs
     (lH, lHRest) = first reverse . splitAt 3 $ sortedXY
+
+
+-- |Get the upper part of the convex hull.
+grahamUCH :: [PT] -> [PT]
+grahamUCH vs = scanH uH uHRest
+  where
+    sortedXY     = fmap p2 . sortLex . fmap unp2 $ vs
     (uH, uHRest) = first reverse . splitAt 3 . reverse $ sortedXY
-    -- This scans only a half of the convex hull. If it's the upper
-    -- or lower half depends on the input.
-    -- Also, the first list is reversed since we only care about the last
-    -- 3 elements and want to stay efficient.
-    scanH :: [PT] -- ^ the first 3 starting points in reversed order
-          -> [PT] -- ^ the rest of the points
-          -> [PT] -- ^ all convex hull points for the half
-    scanH hs@(x:y:z:xs) (r':rs')
-      |	notcw z y x     = scanH (r':hs) rs'
-      | otherwise       = scanH (x:z:xs) (r':rs')
-    scanH hs@(x:y:z:xs) []
-      |	notcw z y x     = hs
-      | otherwise       = scanH (x:z:xs) []
-    scanH hs (r':rs')   = scanH (r':hs) rs'
-    scanH hs _          = hs
+
+
+-- |This scans only a half of the convex hull. If it's the upper
+-- or lower half depends on the input.
+-- Also, the first list is reversed since we only care about the last
+-- 3 elements and want to stay efficient.
+scanH :: [PT] -- ^ the first 3 starting points in reversed order
+      -> [PT] -- ^ the rest of the points
+      -> [PT] -- ^ all convex hull points for the half
+scanH hs@(x:y:z:xs) (r':rs')
+  |	notcw z y x     = scanH (r':hs) rs'
+  | otherwise       = scanH (x:z:xs) (r':rs')
+scanH hs@(x:y:z:xs) []
+  |	notcw 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
diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs
index 0660daa..b3f4c92 100644
--- a/Graphics/Diagram/Plotter.hs
+++ b/Graphics/Diagram/Plotter.hs
@@ -52,7 +52,7 @@ convexHullPoints = Diag chp
         (repeat dot))
       where
         dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
-        vtch = grahamGetCH vt
+        vtch = grahamCH vt
 
 
 -- |Show coordinates as text above the convex hull points.
@@ -64,7 +64,7 @@ convexHullPointsText = Diag chpt
         zip vtchf
             (pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
       where
-        vtchf = grahamGetCH . filter (inRange (dX p) (dY p)) $ vt
+        vtchf = grahamCH . filter (inRange (dX p) (dY p)) $ vt
 
 
 -- |Create a diagram which shows the lines along the convex hull
@@ -76,10 +76,10 @@ convexHullLines = Diag chl
     chl p vt =
       (strokeTrail                           .
           fromVertices                       .
-          flip (++) [head $ grahamGetCH vtf] .
-          grahamGetCH                        $
-          vtf)                          #
-        moveTo (head $ grahamGetCH vtf) #
+          flip (++) [head $ grahamCH vtf]    .
+          grahamCH                           $
+          vtf)                       #
+        moveTo (head $ grahamCH vtf) #
         lc red
       where
         vtf = filter (inRange (dX p) (dY p)) vt