From 2ccb52eb628f89086b558f89ee4a04922309cf3f Mon Sep 17 00:00:00 2001 From: hasufell Date: Wed, 17 Dec 2014 03:35:33 +0100 Subject: [PATCH] VEC: Fix the inRange function It now takes a PROPER square, as in ((xmin, ymin), (xmax, ymax)) instead of ((xmin, xmax), (ymin, ymax)) and also works with negative values. Because the meaning of the arguments has changed, we also had to fix all uses of it. --- Algebra/Vector.hs | 20 ++++++++++++++++---- Algorithms/KDTree.hs | 4 ++-- Algorithms/QuadTree.hs | 8 ++++---- GUI/Gtk.hs | 6 ++++-- Graphics/Diagram/AlgoDiags.hs | 31 ++++++++++++++++--------------- Graphics/Diagram/Core.hs | 23 +++++++++++++++++------ 6 files changed, 59 insertions(+), 33 deletions(-) diff --git a/Algebra/Vector.hs b/Algebra/Vector.hs index c0bf19e..0f25d6d 100644 --- a/Algebra/Vector.hs +++ b/Algebra/Vector.hs @@ -24,12 +24,24 @@ data Alignment = CW deriving (Eq) --- |Checks whether the Point is in a given dimension. -inRange :: Square -- ^ the square: ((xmin, xmax), (ymin, ymax)) +-- |Convert two dimensions such as (xmin, xmax) and (ymin, ymax) +-- to proper square coordinates, as in: +-- ((xmin, ymin), (xmax, ymax)) +dimToSquare :: (Double, Double) -- ^ x dimension + -> (Double, Double) -- ^ y dimension + -> Square -- ^ square describing those dimensions +dimToSquare (x1, x2) (y1, y2) = ((x1, y1), (x2, y2)) + + +-- |Checks whether the Point is in a given Square. +inRange :: Square -- ^ the square: ((xmin, ymin), (xmax, ymax)) -> PT -- ^ Coordinate -> Bool -- ^ result -inRange ((xmin, xmax), (ymin, ymax)) p = - x <= xmax && x >= xmin && y <= ymax && y >= ymin +inRange ((xmin, ymin), (xmax, ymax)) p + = x >= min xmin xmax + && x <= max xmin xmax + && y >= min ymin ymax + && y <= max ymin ymax where (x, y) = unp2 p diff --git a/Algorithms/KDTree.hs b/Algorithms/KDTree.hs index 5052b7c..82ab39a 100644 --- a/Algorithms/KDTree.hs +++ b/Algorithms/KDTree.hs @@ -104,9 +104,9 @@ rangeSearch :: KDTree PT -> Square -> ([PT], Tree String) rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True) where -- either y1 or x1 depending on the orientation - p1' dir ((x1, _), (y1, _)) = if' (dir == Vertical) y1 x1 + p1' dir ((x1, y1), (_, _)) = if' (dir == Vertical) y1 x1 -- either y2 or x2 depending on the orientation - p2' dir ((_, x2), (_, y2)) = if' (dir == Vertical) y2 x2 + p2' dir ((_, _), (x2, y2)) = if' (dir == Vertical) y2 x2 -- either the second or first of the tuple, depending on the orientation cur' dir = if' (dir == Vertical) snd fst -- All points in the range. diff --git a/Algorithms/QuadTree.hs b/Algorithms/QuadTree.hs index 081158d..7251e0b 100644 --- a/Algorithms/QuadTree.hs +++ b/Algorithms/QuadTree.hs @@ -57,10 +57,10 @@ data Orient = North | South | East | West -- |Get a sub-square of the current square, e.g. nw, ne, sw or se. nwSq, neSq, swSq, seSq :: Square -> Square -nwSq ((xl, xu), (yl, yu)) = (,) (xl, (xl + xu) / 2) ((yl + yu) / 2, yu) -neSq ((xl, xu), (yl, yu)) = (,) ((xl + xu) / 2, xu) ((yl + yu) / 2, yu) -swSq ((xl, xu), (yl, yu)) = (,) (xl, (xl + xu) / 2) (yl, (yl + yu) / 2) -seSq ((xl, xu), (yl, yu)) = (,) ((xl + xu) / 2, xu) (yl, (yl + yu) / 2) +nwSq ((xl, yl), (xu, yu)) = (,) (xl, (yl + yu) / 2) ((xl + xu) / 2, yu) +neSq ((xl, yl), (xu, yu)) = (,) ((xl + xu) / 2, (yl + yu) / 2) (xu, yu) +swSq ((xl, yl), (xu, yu)) = (,) (xl, yl) ((xl + xu) / 2, (yl + yu) / 2) +seSq ((xl, yl), (xu, yu)) = (,) ((xl + xu) / 2, yl) (xu, (yl + yu) / 2) -- |Check whether the current Node is an nw, ne, sw or se child of it's diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs index 0982024..5e53753 100644 --- a/GUI/Gtk.hs +++ b/GUI/Gtk.hs @@ -2,6 +2,7 @@ module GUI.Gtk (makeGUI) where +import Algebra.Vector (dimToSquare) import Control.Applicative import Control.Monad(unless) import Control.Monad.IO.Class @@ -308,8 +309,9 @@ saveAndDrawDiag fp fps mygui = haveGrid = gridActive, showCoordText = coordTextActive, quadPath = quadPathEntry', - rangeSquare = (fromMaybe (0, 500) rxDim, - fromMaybe (0, 500) ryDim) + rangeSquare = case (rxDim, ryDim) of + (Just xd', Just yd') -> dimToSquare xd' yd' + _ -> ((0, 0), (500, 500)) }) mesh) (s, r) = renderDiag daW daH diagS diff --git a/Graphics/Diagram/AlgoDiags.hs b/Graphics/Diagram/AlgoDiags.hs index 7805fc8..393e282 100644 --- a/Graphics/Diagram/AlgoDiags.hs +++ b/Graphics/Diagram/AlgoDiags.hs @@ -2,7 +2,7 @@ module Graphics.Diagram.AlgoDiags where -import Algebra.Vector(PT,Square) +import Algebra.Vector(PT,Square,dimToSquare) import Algorithms.GrahamScan import Algorithms.QuadTree import Algorithms.KDTree @@ -106,9 +106,9 @@ squares = Diag f mconcat $ (uncurry rectByDiagonal # lw ultraThin) <$> - (quadTreeSquares (xDimension p, yDimension p) + (quadTreeSquares (diagDimSquare p) . quadTree (mconcat vts) - $ (xDimension p, yDimension p)) + $ diagDimSquare p) -- |Draw the squares of the kd-tree. @@ -118,23 +118,24 @@ kdSquares = Diag f f p vts = mconcat . fmap (uncurry (~~)) - $ kdLines (kdTree (mconcat vts) Horizontal) (xDimension p, yDimension p) + $ kdLines (kdTree (mconcat vts) Horizontal) + (diagDimSquare p) where -- Gets all lines that make up the kdSquares. Every line is -- described by two points, start and end respectively. kdLines :: KDTree PT -> Square -> [(PT, PT)] - kdLines (KTNode ln pt Horizontal rn) ((xmin, xmax), (ymin, ymax)) = + kdLines (KTNode ln pt Horizontal rn) ((xmin, ymin), (xmax, ymax)) = (\(x, _) -> [(p2 (x, ymin), p2 (x, ymax))]) (unp2 pt) - ++ kdLines ln ((xmin, x'), (ymin, ymax)) - ++ kdLines rn ((x', xmax), (ymin, ymax)) + ++ kdLines ln ((xmin, ymin), (x', ymax)) + ++ kdLines rn ((x', ymin), (xmax, ymax)) where (x', _) = unp2 pt - kdLines (KTNode ln pt Vertical rn) ((xmin, xmax), (ymin, ymax)) = + kdLines (KTNode ln pt Vertical rn) ((xmin, ymin), (xmax, ymax)) = (\(_, y) -> [(p2 (xmin, y), p2 (xmax, y))]) (unp2 pt) - ++ kdLines ln ((xmin, xmax), (ymin, y')) - ++ kdLines rn ((xmin, xmax), (y', ymax)) + ++ kdLines ln ((xmin, ymin), (xmax, y')) + ++ kdLines rn ((xmin, y'), (xmax, ymax)) where (_, y') = unp2 pt kdLines _ _ = [] @@ -178,7 +179,7 @@ kdTreeDiag = Diag f -- |Get the quad tree corresponding to the given points and diagram properties. qt :: [PT] -> DiagProp -> QuadTree PT -qt vt p = quadTree vt (xDimension p, yDimension p) +qt vt p = quadTree vt (diagDimSquare p) -- |Create a diagram that shows a single square of the RangeSearch algorithm @@ -191,7 +192,7 @@ quadPathSquare = Diag f (getSquare (stringToQuads (quadPath p)) (qt (mconcat vts) p, [])) where getSquare :: [Either Quad Orient] -> QTZipper PT -> Square - getSquare [] z = getSquareByZipper (xDimension p, yDimension p) z + getSquare [] z = getSquareByZipper (diagDimSquare p) z getSquare (q:qs) z = case q of Right x -> getSquare qs (fromMaybe z (findNeighbor x z)) Left x -> getSquare qs (fromMaybe z (goQuad x z)) @@ -207,11 +208,11 @@ gifQuadPath = GifDiag f <$> getSquares (stringToQuads (quadPath p)) (qt vt p, []) where getSquares :: [Either Quad Orient] -> QTZipper PT -> [Square] - getSquares [] z = [getSquareByZipper (xDimension p, yDimension p) z] + getSquares [] z = [getSquareByZipper (diagDimSquare p) z] getSquares (q:qs) z = case q of - Right x -> getSquareByZipper (xDimension p, yDimension p) z : + Right x -> getSquareByZipper (diagDimSquare p) z : getSquares qs (fromMaybe z (findNeighbor x z)) - Left x -> getSquareByZipper (xDimension p, yDimension p) z : + Left x -> getSquareByZipper (diagDimSquare p) z : getSquares qs (fromMaybe z (goQuad x z)) diff --git a/Graphics/Diagram/Core.hs b/Graphics/Diagram/Core.hs index c3ed846..c31bfb4 100644 --- a/Graphics/Diagram/Core.hs +++ b/Graphics/Diagram/Core.hs @@ -35,9 +35,9 @@ data DiagProp = MkProp { -- |The thickness of the dots. dotSize :: Double, -- |The dimensions of the x-axis. - xDimension :: Coord, + xDimension :: (Double, Double), -- |The dimensions of the y-axis. - yDimension :: Coord, + yDimension :: (Double, Double), -- |Algorithm to use. algo :: Int, -- |If we want to show the grid. @@ -135,7 +135,14 @@ maybeDiag b d filterValidPT :: DiagProp -> [PT] -> [PT] -filterValidPT p = filter (inRange (xDimension p, yDimension p)) +filterValidPT = + filter + . inRange + . diagDimSquare + + +diagDimSquare :: DiagProp -> Square +diagDimSquare p = dimToSquare (xDimension p) $ yDimension p -- |Draw a list of points. @@ -154,9 +161,13 @@ drawP vt ds = rectByDiagonal :: (Double, Double) -- ^ sw point -> (Double, Double) -- ^ nw point -> Diagram Cairo R2 -rectByDiagonal (xmin, xmax) (ymin, ymax) = - rect (xmax - xmin) (ymax - ymin) - # moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2)) +rectByDiagonal (xmin, ymin) (xmax, ymax) = + fromVertices [p2 (xmin, ymin) + , p2 (xmax, ymin) + , p2 (xmax, ymax) + , p2 (xmin, ymax) + , p2 (xmin, ymin) + ] -- |Creates a Diagram from a point that shows the coordinates