diff --git a/Algebra/Vector.hs b/Algebra/Vector.hs index e386514..c23cbe2 100644 --- a/Algebra/Vector.hs +++ b/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 diff --git a/Algorithms/PolygonTriangulation.hs b/Algorithms/PolygonTriangulation.hs new file mode 100644 index 0000000..e0522fc --- /dev/null +++ b/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 diff --git a/CG2.cabal b/CG2.cabal index e308456..6b580f3 100644 --- a/CG2.cabal +++ b/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 diff --git a/GUI/gtk2.glade b/GUI/gtk2.glade index cc32756..f3595f3 100644 --- a/GUI/gtk2.glade +++ b/GUI/gtk2.glade @@ -1063,7 +1063,8 @@ Show convex hull Show polygons Show polygons intersection Show quad tree squares -Show kd tree squares +Show kd tree squares +Polygon Triangulation False diff --git a/Graphics/Diagram/AlgoDiags.hs b/Graphics/Diagram/AlgoDiags.hs index 393e282..d985722 100644 --- a/Graphics/Diagram/AlgoDiags.hs +++ b/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 + diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs index 3cd436a..8cde612 100644 --- a/Graphics/Diagram/Gtk.hs +++ b/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