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.
This commit is contained in:
hasufell 2014-12-17 03:35:33 +01:00
parent c33827b63e
commit 2ccb52eb62
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
6 changed files with 59 additions and 33 deletions

View File

@ -24,12 +24,24 @@ data Alignment = CW
deriving (Eq) deriving (Eq)
-- |Checks whether the Point is in a given dimension. -- |Convert two dimensions such as (xmin, xmax) and (ymin, ymax)
inRange :: Square -- ^ the square: ((xmin, xmax), (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 -> PT -- ^ Coordinate
-> Bool -- ^ result -> Bool -- ^ result
inRange ((xmin, xmax), (ymin, ymax)) p = inRange ((xmin, ymin), (xmax, ymax)) p
x <= xmax && x >= xmin && y <= ymax && y >= ymin = x >= min xmin xmax
&& x <= max xmin xmax
&& y >= min ymin ymax
&& y <= max ymin ymax
where where
(x, y) = unp2 p (x, y) = unp2 p

View File

@ -104,9 +104,9 @@ rangeSearch :: KDTree PT -> Square -> ([PT], Tree String)
rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True) rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True)
where where
-- either y1 or x1 depending on the orientation -- 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 -- 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 -- either the second or first of the tuple, depending on the orientation
cur' dir = if' (dir == Vertical) snd fst cur' dir = if' (dir == Vertical) snd fst
-- All points in the range. -- All points in the range.

View File

@ -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. -- |Get a sub-square of the current square, e.g. nw, ne, sw or se.
nwSq, neSq, swSq, seSq :: Square -> Square nwSq, neSq, swSq, seSq :: Square -> Square
nwSq ((xl, xu), (yl, yu)) = (,) (xl, (xl + xu) / 2) ((yl + yu) / 2, yu) nwSq ((xl, yl), (xu, yu)) = (,) (xl, (yl + yu) / 2) ((xl + xu) / 2, yu)
neSq ((xl, xu), (yl, yu)) = (,) ((xl + xu) / 2, xu) ((yl + yu) / 2, yu) neSq ((xl, yl), (xu, yu)) = (,) ((xl + xu) / 2, (yl + yu) / 2) (xu, yu)
swSq ((xl, xu), (yl, yu)) = (,) (xl, (xl + xu) / 2) (yl, (yl + yu) / 2) swSq ((xl, yl), (xu, yu)) = (,) (xl, yl) ((xl + xu) / 2, (yl + yu) / 2)
seSq ((xl, xu), (yl, yu)) = (,) ((xl + xu) / 2, xu) (yl, (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 -- |Check whether the current Node is an nw, ne, sw or se child of it's

View File

@ -2,6 +2,7 @@
module GUI.Gtk (makeGUI) where module GUI.Gtk (makeGUI) where
import Algebra.Vector (dimToSquare)
import Control.Applicative import Control.Applicative
import Control.Monad(unless) import Control.Monad(unless)
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -308,8 +309,9 @@ saveAndDrawDiag fp fps mygui =
haveGrid = gridActive, haveGrid = gridActive,
showCoordText = coordTextActive, showCoordText = coordTextActive,
quadPath = quadPathEntry', quadPath = quadPathEntry',
rangeSquare = (fromMaybe (0, 500) rxDim, rangeSquare = case (rxDim, ryDim) of
fromMaybe (0, 500) ryDim) (Just xd', Just yd') -> dimToSquare xd' yd'
_ -> ((0, 0), (500, 500))
}) })
mesh) mesh)
(s, r) = renderDiag daW daH diagS (s, r) = renderDiag daW daH diagS

View File

@ -2,7 +2,7 @@
module Graphics.Diagram.AlgoDiags where module Graphics.Diagram.AlgoDiags where
import Algebra.Vector(PT,Square) import Algebra.Vector(PT,Square,dimToSquare)
import Algorithms.GrahamScan import Algorithms.GrahamScan
import Algorithms.QuadTree import Algorithms.QuadTree
import Algorithms.KDTree import Algorithms.KDTree
@ -106,9 +106,9 @@ squares = Diag f
mconcat mconcat
$ (uncurry rectByDiagonal # lw ultraThin) $ (uncurry rectByDiagonal # lw ultraThin)
<$> <$>
(quadTreeSquares (xDimension p, yDimension p) (quadTreeSquares (diagDimSquare p)
. quadTree (mconcat vts) . quadTree (mconcat vts)
$ (xDimension p, yDimension p)) $ diagDimSquare p)
-- |Draw the squares of the kd-tree. -- |Draw the squares of the kd-tree.
@ -118,23 +118,24 @@ kdSquares = Diag f
f p vts = f p vts =
mconcat mconcat
. fmap (uncurry (~~)) . fmap (uncurry (~~))
$ kdLines (kdTree (mconcat vts) Horizontal) (xDimension p, yDimension p) $ kdLines (kdTree (mconcat vts) Horizontal)
(diagDimSquare p)
where where
-- Gets all lines that make up the kdSquares. Every line is -- Gets all lines that make up the kdSquares. Every line is
-- described by two points, start and end respectively. -- described by two points, start and end respectively.
kdLines :: KDTree PT -> Square -> [(PT, PT)] 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))]) (\(x, _) -> [(p2 (x, ymin), p2 (x, ymax))])
(unp2 pt) (unp2 pt)
++ kdLines ln ((xmin, x'), (ymin, ymax)) ++ kdLines ln ((xmin, ymin), (x', ymax))
++ kdLines rn ((x', xmax), (ymin, ymax)) ++ kdLines rn ((x', ymin), (xmax, ymax))
where where
(x', _) = unp2 pt (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))]) (\(_, y) -> [(p2 (xmin, y), p2 (xmax, y))])
(unp2 pt) (unp2 pt)
++ kdLines ln ((xmin, xmax), (ymin, y')) ++ kdLines ln ((xmin, ymin), (xmax, y'))
++ kdLines rn ((xmin, xmax), (y', ymax)) ++ kdLines rn ((xmin, y'), (xmax, ymax))
where where
(_, y') = unp2 pt (_, y') = unp2 pt
kdLines _ _ = [] kdLines _ _ = []
@ -178,7 +179,7 @@ kdTreeDiag = Diag f
-- |Get the quad tree corresponding to the given points and diagram properties. -- |Get the quad tree corresponding to the given points and diagram properties.
qt :: [PT] -> DiagProp -> QuadTree PT 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 -- |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, [])) (getSquare (stringToQuads (quadPath p)) (qt (mconcat vts) p, []))
where where
getSquare :: [Either Quad Orient] -> QTZipper PT -> Square 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 getSquare (q:qs) z = case q of
Right x -> getSquare qs (fromMaybe z (findNeighbor x z)) Right x -> getSquare qs (fromMaybe z (findNeighbor x z))
Left x -> getSquare qs (fromMaybe z (goQuad 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, []) <$> getSquares (stringToQuads (quadPath p)) (qt vt p, [])
where where
getSquares :: [Either Quad Orient] -> QTZipper PT -> [Square] 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 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)) 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)) getSquares qs (fromMaybe z (goQuad x z))

View File

@ -35,9 +35,9 @@ data DiagProp = MkProp {
-- |The thickness of the dots. -- |The thickness of the dots.
dotSize :: Double, dotSize :: Double,
-- |The dimensions of the x-axis. -- |The dimensions of the x-axis.
xDimension :: Coord, xDimension :: (Double, Double),
-- |The dimensions of the y-axis. -- |The dimensions of the y-axis.
yDimension :: Coord, yDimension :: (Double, Double),
-- |Algorithm to use. -- |Algorithm to use.
algo :: Int, algo :: Int,
-- |If we want to show the grid. -- |If we want to show the grid.
@ -135,7 +135,14 @@ maybeDiag b d
filterValidPT :: DiagProp -> [PT] -> [PT] 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. -- |Draw a list of points.
@ -154,9 +161,13 @@ drawP vt ds =
rectByDiagonal :: (Double, Double) -- ^ sw point rectByDiagonal :: (Double, Double) -- ^ sw point
-> (Double, Double) -- ^ nw point -> (Double, Double) -- ^ nw point
-> Diagram Cairo R2 -> Diagram Cairo R2
rectByDiagonal (xmin, xmax) (ymin, ymax) = rectByDiagonal (xmin, ymin) (xmax, ymax) =
rect (xmax - xmin) (ymax - ymin) fromVertices [p2 (xmin, ymin)
# moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2)) , p2 (xmax, ymin)
, p2 (xmax, ymax)
, p2 (xmin, ymax)
, p2 (xmin, ymin)
]
-- |Creates a Diagram from a point that shows the coordinates -- |Creates a Diagram from a point that shows the coordinates