Re[4]: OcTree на Haskell
От: STilda  
Дата: 04.10.09 18:22
Оценка: 4 (1)
Привожу последнюю версию этого дела. Вдруг кому интересно.
Одномерный случай.

Основной модуль: создает дерево для 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 очень просто решила проблему с неосвобождением памяти, которая была в первом сообщении описана и представляла суть вопроса.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.