diff --git a/Algorithms/KDTree/KDTree.hs b/Algorithms/KDTree/KDTree.hs
index 254db92..b8483a1 100644
--- a/Algorithms/KDTree/KDTree.hs
+++ b/Algorithms/KDTree/KDTree.hs
@@ -4,6 +4,7 @@ module Algorithms.KDTree.KDTree where
import Algebra.VectorTypes
import Algebra.Vector
import Data.Maybe (fromJust, catMaybes)
+import Data.Tree
import Diagrams.TwoD.Types
import MyPrelude (pivot,if',Not, not')
import Safe
@@ -81,17 +82,47 @@ partitionX (xs, ys) = (\(x, y) -> (y, x))
. partition' (fromJust . pivot $ xs) $ (ys, xs)
--- |Execute a range search in O(log n).
-rangeSearch :: KDTree PT -> Square -> [PT]
-rangeSearch KTNil _ = []
-rangeSearch (KTNode ln pt Vertical rn) sq@(_, (y1, y2)) =
- [pt | inRange sq pt]
- ++ (if y1 < (snd . unp2 $ pt) then rangeSearch ln sq else [])
- ++ (if (snd . unp2 $ pt) < y2 then rangeSearch rn sq else [])
-rangeSearch (KTNode ln pt Horizontal rn) sq@((x1, x2), _) =
- [pt | inRange sq pt]
- ++ (if x1 < (fst . unp2 $ pt) then rangeSearch ln sq else [])
- ++ (if (fst . unp2 $ pt) < x2 then rangeSearch rn sq else [])
+-- |Execute a range search in O(log n). It returns a tuple
+-- of the points found in the range and also gives back a pretty
+-- rose tree suitable for printing.
+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
+ -- either y2 or x2 depending on the orientation
+ 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.
+ goPt :: KDTree PT -> Square -> [PT]
+ goPt KTNil _ = []
+ goPt (KTNode ln pt dir rn) sq =
+ [pt | inRange sq pt]
+ ++ (if' (p1' dir sq < (cur' dir . unp2 $ pt))
+ (goPt ln sq)
+ []
+ )
+ ++ (if' ((cur' dir . unp2 $ pt) < p2' dir sq)
+ (goPt rn sq)
+ [])
+ where
+ -- A pretty rose tree suitable for printing.
+ goTree :: KDTree PT -> Square -> Bool -> Tree String
+ goTree KTNil _ _ = Node "nil" []
+ goTree (KTNode ln pt dir rn) sq vis =
+ Node treeText
+ [if' (p1' dir sq < (cur' dir . unp2 $ pt))
+ (goTree ln sq vis)
+ (goTree ln sq False)
+ , if' ((cur' dir . unp2 $ pt) < p2' dir sq)
+ (goTree rn sq vis)
+ (goTree rn sq False)]
+ where
+ treeText
+ | vis && inRange sq pt = "** " ++ (show . unp2 $ pt)
+ | vis = "* " ++ (show . unp2 $ pt)
+ | otherwise = show . unp2 $ pt
@@ -130,3 +161,10 @@ getDirection (KTNode _ _ dir _) = Just dir
getDirection _ = Nothing
+-- |Convert a kd-tree to a rose tree, for pretty printing.
+kdTreeToRoseTree :: KDTree PT -> Tree String
+kdTreeToRoseTree (KTNil) = Node "nil" []
+kdTreeToRoseTree (KTNode ln val _ rn) =
+ Node (show . unp2 $ val) [kdTreeToRoseTree ln, kdTreeToRoseTree rn]
+
+
diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs
index 0262241..d867f33 100644
--- a/GUI/Gtk.hs
+++ b/GUI/Gtk.hs
@@ -6,6 +6,7 @@ import Control.Applicative
import Control.Monad(unless)
import Control.Monad.IO.Class
import qualified Data.ByteString.Char8 as B
+import Data.Maybe
import Diagrams.Prelude
import Diagrams.Backend.Cairo
import Diagrams.Backend.Cairo.Internal
@@ -61,7 +62,17 @@ data MyGUI = MkMyGUI {
-- |Path entry widget for the quad tree.
quadPathEntry :: Entry,
-- |Horizontal box containing the path entry widget.
- vbox7 :: Box
+ vbox7 :: Box,
+ -- |Horizontal box containing the Rang search entry widgets.
+ vbox10 :: Box,
+ -- |Range entry widget for lower x bound
+ rangeXminEntry :: Entry,
+ -- |Range entry widget for upper x bound
+ rangeXmaxEntry :: Entry,
+ -- |Range entry widget for lower y bound
+ rangeYminEntry :: Entry,
+ -- |Range entry widget for upper y bound
+ rangeYmaxEntry :: Entry
}
@@ -96,6 +107,11 @@ makeMyGladeGUI = do
<*> xmlGetWidget xml castToCheckButton "coordcheckbutton"
<*> xmlGetWidget xml castToEntry "path"
<*> xmlGetWidget xml castToBox "vbox7"
+ <*> xmlGetWidget xml castToBox "vbox10"
+ <*> xmlGetWidget xml castToEntry "rxMin"
+ <*> xmlGetWidget xml castToEntry "rxMax"
+ <*> xmlGetWidget xml castToEntry "ryMin"
+ <*> xmlGetWidget xml castToEntry "ryMax"
-- |Main entry point for the GTK GUI routines.
@@ -164,6 +180,7 @@ makeGUI startFile = do
widgetShowAll (rootWin mygui)
widgetShowAll (treeWin mygui)
widgetHide (vbox7 mygui)
+ widgetHide (vbox10 mygui)
widgetHide (treeWin mygui)
mainGUI
@@ -193,6 +210,13 @@ onAlgoBoxChange mygui = do
else do
widgetHide (vbox7 mygui)
widgetHide (treeWin mygui)
+ if item == 5
+ then do
+ widgetShow (vbox10 mygui)
+ widgetShow (treeWin mygui)
+ else do
+ widgetHide (vbox10 mygui)
+ widgetHide (treeWin mygui)
return ()
@@ -251,6 +275,10 @@ saveAndDrawDiag fp fps mygui =
gridActive <- toggleButtonGetActive (gridCheckBox mygui)
coordTextActive <- toggleButtonGetActive (coordCheckBox mygui)
quadPathEntry' <- entryGetText (quadPathEntry mygui)
+ rxminEntryText <- entryGetText (rangeXminEntry mygui)
+ rxmaxEntryText <- entryGetText (rangeXmaxEntry mygui)
+ ryminEntryText <- entryGetText (rangeYminEntry mygui)
+ rymaxEntryText <- entryGetText (rangeYmaxEntry mygui)
let
xDim = (,) <$>
@@ -259,31 +287,36 @@ saveAndDrawDiag fp fps mygui =
yDim = (,) <$>
readMaybe yminEntryText <*>
readMaybe ymaxEntryText :: Maybe (Double, Double)
- renderDiag winWidth winHeight buildDiag xDim' yDim' =
+ rxDim = (,) <$>
+ readMaybe rxminEntryText <*>
+ readMaybe rxmaxEntryText :: Maybe (Double, Double)
+ ryDim = (,) <$>
+ readMaybe ryminEntryText <*>
+ readMaybe rymaxEntryText :: Maybe (Double, Double)
+ renderDiag winWidth winHeight buildDiag =
renderDia Cairo
(CairoOptions fps
(Dims (fromIntegral winWidth) (fromIntegral winHeight))
SVG False)
(buildDiag (def{
dotSize = scaleVal,
- xDimension = xDim',
- yDimension = yDim',
+ xDimension = fromMaybe (0, 500) xDim,
+ yDimension = fromMaybe (0, 500) yDim,
algo = algoActive,
haveGrid = gridActive,
showCoordText = coordTextActive,
- quadPath = quadPathEntry'})
+ quadPath = quadPathEntry',
+ rangeSquare = (fromMaybe (0, 500) rxDim,
+ fromMaybe (0, 500) ryDim)
+ })
mesh)
+ (s, r) = renderDiag daW daH diagS
+ (_, r') = renderDiag daTW daTH diagTreeS
- case (xDim, yDim) of
- (Just xDim', Just yDim') -> do
- let (s, r) = renderDiag daW daH diagS xDim' yDim'
- let (_, r') = renderDiag daTW daTH diagTreeS xDim' yDim'
+ renderWithDrawable mainDrawWindow r
+ renderWithDrawable treeDrawWindow r'
- renderWithDrawable mainDrawWindow r
- renderWithDrawable treeDrawWindow r'
-
- unless (null fps) s
- return 0
- _ -> return 1
+ unless (null fps) s
+ return 0
else return 2
diff --git a/GUI/gtk2.glade b/GUI/gtk2.glade
index f28ff42..9e4b5e1 100644
--- a/GUI/gtk2.glade
+++ b/GUI/gtk2.glade
@@ -848,6 +848,212 @@ Public License instead of this License.
6
+
+
+ True
+ False
+
+
+ True
+ False
+
+
+ True
+ False
+ Range search
+
+
+ True
+ True
+ 5
+ 0
+
+
+
+
+ True
+ False
+
+
+ True
+ False
+ X min
+
+
+ True
+ True
+ 0
+
+
+
+
+ 5
+ True
+ True
+ ●
+ False
+ False
+ True
+ True
+
+
+ True
+ True
+ 1
+
+
+
+
+ True
+ True
+ 1
+
+
+
+
+ True
+ False
+
+
+ True
+ False
+ X max
+
+
+ True
+ True
+ 0
+
+
+
+
+ 5
+ True
+ True
+ ●
+ False
+ False
+ True
+ True
+
+
+ True
+ True
+ 1
+
+
+
+
+ True
+ True
+ 2
+
+
+
+
+ True
+ False
+
+
+ True
+ False
+ Y min
+
+
+ True
+ True
+ 0
+
+
+
+
+ 5
+ True
+ True
+ ●
+ False
+ False
+ True
+ True
+
+
+ True
+ True
+ 1
+
+
+
+
+ True
+ True
+ 3
+
+
+
+
+ True
+ False
+
+
+ True
+ False
+ Y max
+
+
+ True
+ True
+ 0
+
+
+
+
+ 5
+ True
+ True
+ ●
+ False
+ False
+ True
+ True
+
+
+ True
+ True
+ 1
+
+
+
+
+ True
+ True
+ 4
+
+
+
+
+ False
+ False
+ 0
+
+
+
+
+ True
+ False
+
+
+ False
+ True
+ 1
+
+
+
+
+ False
+ False
+ 7
+
+
True
@@ -862,7 +1068,7 @@ Show kd tree squares
False
False
- 7
+ 8
diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs
index c692809..f87af39 100644
--- a/Graphics/Diagram/Gtk.hs
+++ b/Graphics/Diagram/Gtk.hs
@@ -24,7 +24,7 @@ diag p obj@(Object _)
coordPoints, polyLines, plotterBG])
p obj
| algo p == 5 =
- mkDiag (mconcat [kdSquares, coordPointsText,
+ mkDiag (mconcat [kdRange, kdSquares, coordPointsText,
coordPoints, plotterBG])
p obj
| otherwise = mempty
@@ -60,4 +60,8 @@ diagTreeS p mesh
. filterValidPT p
. meshToArr
$ mesh)
+ | algo p == 5 = mkDiag kdTreeDiag p (Object
+ . filterValidPT p
+ . meshToArr
+ $ mesh)
| otherwise = mempty
diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs
index 32c3f60..c346763 100644
--- a/Graphics/Diagram/Plotter.hs
+++ b/Graphics/Diagram/Plotter.hs
@@ -16,6 +16,7 @@ import Diagrams.TwoD.Layout.Tree
import Graphics.Diagram.Types
import Parser.PathParser
+import qualified Debug.Trace as D
-- |Creates a Diagram that shows the coordinates from the points
-- as dots. The points and thickness of the dots can be controlled
@@ -23,13 +24,20 @@ import Parser.PathParser
coordPoints :: Diag
coordPoints = Diag cp
where
- cp p (Object vt) = drawP vt p
- cp p (Objects vts) = drawP (concat vts) p
- drawP [] _ = mempty
- drawP vt p =
- position (zip vt (repeat dot))
- where
- dot = (circle $ dotSize p :: Diagram Cairo R2) # fc black
+ cp p (Object vt) = drawP vt (dotSize p) black
+ cp p (Objects vts) = drawP (concat vts) (dotSize p) black
+
+
+-- |Draw a list of points.
+drawP :: [PT] -- ^ the points to draw
+ -> Double -- ^ dot size
+ -> Colour Double -- ^ fc and lc
+ -> Diagram Cairo R2 -- ^ the resulting diagram
+drawP [] _ _ = mempty
+drawP vt ds col =
+ position (zip vt (repeat dot))
+ where
+ dot = (circle ds :: Diagram Cairo R2) # fc col # lc col
-- |Creates a Diagram from a point that shows the coordinates
@@ -182,7 +190,7 @@ squares = Diag f
-- |Draw the squares of the kd-tree.
-kdSquares:: Diag
+kdSquares :: Diag
kdSquares = Diag f
where
f _ (Object []) = mempty
@@ -212,6 +220,46 @@ kdSquares = Diag f
f _ _ = mempty
+-- |Draw the range rectangle and highlight the points inside that range.
+kdRange :: Diag
+kdRange = Diag f
+ where
+ f _ (Object []) = mempty
+ f p (Object vt) =
+ (\((xmin, xmax), (ymin, ymax)) -> rect (xmax - xmin) (ymax - ymin)
+ # moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2))
+ # lc red)
+ (rangeSquare p)
+ <> drawP ptsInRange (dotSize p) red
+ where
+ ptsInRange = fst . rangeSearch (kdTree vt Vertical) $ rangeSquare p
+ f _ _ = mempty
+
+
+-- |The kd-tree visualized as binary tree.
+kdTreeDiag :: Diag
+kdTreeDiag = Diag f
+ where
+ f _ (Object []) = mempty
+ f p (Object vt) =
+ renderTree (\n -> case n of
+ '*':'*':_ -> (text n # fontSizeL 5.0)
+ <> rect 50.0 20.0 # fc green
+ '*':_ -> (text n # fontSizeL 5.0)
+ <> rect 50.0 20.0 # fc red
+ _ -> (text n # fontSizeL 5.0)
+ <> rect 50.0 20.0 # fc white)
+ (~~)
+ (symmLayout' (with & slHSep .~ 60 & slVSep .~ 40) roseTree)
+ # scale 2 # alignT # bg white
+ where
+ roseTree = snd
+ . rangeSearch (kdTree vt Vertical)
+ $ rangeSquare p
+
+ f _ _ = mempty
+
+
-- |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)
diff --git a/Graphics/Diagram/Types.hs b/Graphics/Diagram/Types.hs
index 3c5bf9b..1880e2b 100644
--- a/Graphics/Diagram/Types.hs
+++ b/Graphics/Diagram/Types.hs
@@ -55,7 +55,9 @@ data DiagProp = MkProp {
-- |Square size used to show the grid and x/y-axis.
squareSize :: Double,
-- |The path to a quad in the quad tree.
- quadPath :: String
+ quadPath :: String,
+ -- |The square for the kd-tree range search.
+ rangeSquare :: Square
}
@@ -85,7 +87,8 @@ instance Monoid Diag where
-- |The default properties of the Diagram.
diagDefaultProp :: DiagProp
-diagDefaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 ""
+diagDefaultProp = MkProp 2 (0,500) (0,500)
+ 0 False False 50 "" ((0,500),(0,500))
-- |Extract the lower bound of the x-axis dimension.