Implement vertex categorisation for Polygon Triangulation

Algebra/Vector.hs

@@ -128,6 +128,13 @@ notcw a b c = case getOrient a b c of
   _  -> True
 
 
+--- |Checks if 3 points a,b,c do build a clockwise triangle by
+--- connecting a-b-c. This is done by computing the determinant and
+--- checking the algebraic sign.
+cw :: PT -> PT -> PT -> Bool
+cw a b c = not . notcw a b $ c
+
+
 -- |Sort X and Y coordinates lexicographically.
 sortedXY :: [PT] -> [PT]
 sortedXY = fmap p2 . sortLex . fmap unp2

Algorithms/PolygonTriangulation.hs

@@ -0,0 +1,110 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Algorithms.PolygonTriangulation where
+
+import Algebra.Vector
+import Diagrams.Coordinates
+
+
+data VCategory = VStart
+               | VEnd
+               | VRegular
+               | VSplit
+               | VMerge
+  deriving (Show)
+
+
+-- |Classify all vertices on a polygon into five categories (see VCategory).
+classifyList :: [PT] -> [(PT, VCategory)]
+classifyList p@(x:y:_:_) =
+  -- need to handle the first and last element separately
+  [classify (last p) x y] ++ go p ++ [classify (last . init $ p) (last p) x]
+  where
+    go :: [PT] -> [(PT, VCategory)]
+    go (x':y':z':xs) = classify x' y' z' : go (y':z':xs)
+    go _          = []
+classifyList _ = []
+
+
+-- |Classify a vertex on a polygon given it's next and previous vertex
+-- into five categories (see VCategory).
+classify :: PT  -- ^ prev vertex
+         -> PT  -- ^ classify this one
+         -> PT  -- ^ next vertex
+         -> (PT, VCategory)
+classify prev v next
+  | isVStart prev v next = (v, VStart)
+  | isVSplit prev v next = (v, VSplit)
+  | isVEnd prev v next   = (v, VEnd)
+  | isVMerge prev v next = (v, VMerge)
+  | otherwise            = (v, VRegular)
+
+
+-- |Whether the vertex, given it's next and previous vertex
+-- is a start vertex.
+isVStart :: PT  -- ^ previous vertice
+         -> PT  -- ^ vertice to check
+         -> PT  -- ^ next vertice
+         -> Bool
+isVStart prev v next =
+  (ptCmpY next v == LT) && (ptCmpY prev v == LT) && (cw next v prev)
+
+
+-- |Whether the vertex, given it's next and previous vertex
+-- is a split vertex.
+isVSplit :: PT  -- ^ previous vertice
+         -> PT  -- ^ vertice to check
+         -> PT  -- ^ next vertice
+         -> Bool
+isVSplit prev v next =
+  (ptCmpY prev v == LT) && (ptCmpY next v == LT) && (cw prev v next)
+
+
+-- |Whether the vertex, given it's next and previous vertex
+-- is an end vertex.
+isVEnd :: PT  -- ^ previous vertice
+       -> PT  -- ^ vertice to check
+       -> PT  -- ^ next vertice
+       -> Bool
+isVEnd prev v next =
+  (ptCmpY prev v == GT) && (ptCmpY next v == GT) && (cw next v prev)
+
+
+-- |Whether the vertex, given it's next and previous vertex
+-- is a merge vertex.
+isVMerge :: PT  -- ^ previous vertice
+         -> PT  -- ^ vertice to check
+         -> PT  -- ^ next vertice
+         -> Bool
+isVMerge prev v next =
+  (ptCmpY next v == GT) && (ptCmpY prev v == GT) && (cw prev v next)
+
+
+-- |Whether the vertex, given it's next and previous vertex
+-- is a regular vertex.
+isVRegular :: PT  -- ^ previous vertice
+           -> PT  -- ^ vertice to check
+           -> PT  -- ^ next vertice
+           -> Bool
+isVRegular prev v next =
+     (not . isVStart prev v $ next)
+  && (not . isVSplit prev v $ next)
+  && (not . isVEnd prev v $ next)
+  && (not . isVMerge prev v $ next)
+
+
+-- A point u is below of v ( u < v ),
+-- if u_y < v_y or u_y = v_y and u_x > v_x.
+below :: PT  -- ^ is this one below the other?
+      -> PT
+      -> Bool
+below (coords -> ux :& uy) (coords -> vx :& vy) =
+  (uy <= vy ) && (ux > vx)
+
+
+-- A point u is above of v , if v < u.
+above :: PT  -- ^ is this one above the other?
+      -> PT
+      -> Bool
+above = flip below

CG2.cabal

@@ -57,6 +57,7 @@ executable Gtk
   other-modules:       Algebra.Vector
                        Algorithms.GrahamScan
                        Algorithms.PolygonIntersection
+                       Algorithms.PolygonTriangulation
                        Algorithms.QuadTree
                        Algorithms.KDTree
                        Graphics.Diagram.AlgoDiags
@@ -105,6 +106,7 @@ executable Gif
   other-modules:       Algebra.Vector
                        Algorithms.GrahamScan
                        Algorithms.PolygonIntersection
+                       Algorithms.PolygonTriangulation
                        Algorithms.QuadTree
                        Algorithms.KDTree
                        Graphics.Diagram.AlgoDiags
@@ -150,6 +152,7 @@ executable Test
   other-modules:       Algebra.Vector
                        Algorithms.GrahamScan
                        Algorithms.PolygonIntersection
+                       Algorithms.PolygonTriangulation
                        Algorithms.QuadTree
                        Algorithms.KDTree
                        Graphics.Diagram.AlgoDiags

GUI/gtk2.glade

@@ -1063,7 +1063,8 @@ Show convex hull
 Show polygons
 Show polygons intersection
 Show quad tree squares
-Show kd tree squares</property>
+Show kd tree squares
+Polygon Triangulation</property>
           </widget>
           <packing>
             <property name="expand">False</property>

Graphics/Diagram/AlgoDiags.hs

@@ -7,6 +7,7 @@ import Algorithms.GrahamScan
 import Algorithms.QuadTree
 import Algorithms.KDTree
 import Algorithms.PolygonIntersection
+import Algorithms.PolygonTriangulation
 import Data.Maybe
 import Data.Monoid
 import Data.Tree
@@ -243,3 +244,23 @@ treePretty = Diag f
                      (~~)
                      (symmLayout' (with & slHSep .~ 60 & slVSep .~ 40) tree)
           # scale 2 # alignT # bg white
+
+
+-- |Show the points for polygon triangulation in different colors.
+polyTriCategorizedPoints :: Diag
+polyTriCategorizedPoints = Diag f
+  where
+    f p vts =
+      foldl (\diag' (x, y) ->
+               diag' <> (drawP [x] (dotSize p) # lc (vcatToCol y))
+                                               # fc (vcatToCol y))
+        mempty
+        (classifyList . concat $ vts)
+    -- category to color mapping
+    vcatToCol :: VCategory -> Colour Double
+    vcatToCol VStart   = green
+    vcatToCol VSplit   = blue
+    vcatToCol VEnd     = red
+    vcatToCol VMerge   = pink
+    vcatToCol VRegular = yellow
+

Graphics/Diagram/Gtk.hs

@@ -32,7 +32,9 @@ diagAlgos =
                  coordPoints, polyLines, plotterBG])
   ,DiagAlgo (4, [quadPathSquare, squares, coordPointsText,
                  coordPoints, plotterBG])
-  ,DiagAlgo (5, [kdRange, kdSquares, coordPointsText, coordPoints, plotterBG])]
+  ,DiagAlgo (5, [kdRange, kdSquares, coordPointsText, coordPoints, plotterBG])
+  ,DiagAlgo (6, [polyLines, coordPointsText, polyTriCategorizedPoints,
+                 plotterBG])]
 
 
 -- |Introspective data structure holding all algorithms for the