Привожу последнюю версию этого дела. Вдруг кому интересно.
Одномерный случай.
Основной модуль: создает дерево для 100000 случайных точек, делает запросы для 30000 случайных отрезков.
module Main where
import System.Random
import Data.List
import OcTree
main = do
putStrLn $ "Begin"
seed <- newStdGen
let randPoints = take 100000 . rndPoints1D . rndList $ seed
let tree = releaseNodes . chopByLevel 15 . chopEmpty . makeOcTree splitter1D (0,1) $ randPoints
putStrLn $ "Calls to the tree"
seed2 <- newStdGen
let randspheres = take 30000 . rndCircles1D . rndList $ seed2
let inspheres = map (selector tree . uncurry intersectSphere1D) randspheres
let spherescounts = map length inspheres
putStrLn $ " In Spheres counts : " ++ show (spherescounts)
putStrLn $ "End"
rndList :: StdGen -> [Double]
rndList = randoms
rndCircles1D :: [Double] -> [(Double,Double)]
rndCircles1D rnds = zip rnds (map (\x->x/10) (drop 1 rnds))
rndPoints1D :: [Double] -> [Double]
rndPoints1D rnds = rnds
Модуль реализации самого OcTree:
module OcTree where
data OcTree dom item = Node dom [item] [OcTree dom item] | Leaf dom [item]
type BelongFunction dom = dom -> Bool
type Point1D = Double
makeOcTree :: (d -> [i] -> [(d,[i])]) -> d -> [i] -> OcTree d i
makeOcTree splitter domain items = Node domain items $ map (uncurry $ makeOcTree splitter) $ splitter domain items
releaseNodes :: OcTree d i -> OcTree d i
releaseNodes (Node dom items forest) = Node dom [] (map releaseNodes forest)
releaseNodes leaf = leaf
chopEmpty :: OcTree d i -> OcTree d i
chopEmpty (Node dom [] _) = Leaf dom []
chopEmpty (Node dom items forest) = Node dom items (map chopEmpty forest)
chopEmpty leaf = leaf
chopByLevel :: Int -> OcTree d i -> OcTree d i
chopByLevel 0 (Node dom items _) = Leaf dom items
chopByLevel n (Node dom items forest) = Node dom items (map (chopByLevel (n-1)) forest)
chopByLevel _ leaf = leaf
selector :: OcTree dom item -> BelongFunction dom -> [item]
selector tree belong = concat $ selector0 tree
where
selector0 (Leaf domain items) = if belong domain then [items] else []
selector0 (Node domain _ forest) = if belong domain then concatMap selector0 forest else []
--
-- specific for 1D
--
splitter1D :: (Ord a, Fractional a) => (a,a) -> [a] -> [((a,a),[a])]
splitter1D (x0,x1) items = [ ((x0,c),is0), ((c,x1),is1) ]
where c = 0.5*(x0+x1)
(is0,is1) = splitBase items
splitBase [] = ([],[])
splitBase (x:xs) | x < c = (x:ys1,ys2)
| otherwise = (ys1,x:ys2)
where (ys1,ys2) = splitBase xs
intersectSphere1D :: Point1D -> Double -> BelongFunction (Point1D,Point1D)
intersectSphere1D pt r dom = not $ (pt+r<b0) || (pt-r>b1)
Функция releaseNodes очень просто решила проблему с неосвобождением памяти, которая была в первом сообщении описана и представляла суть вопроса.