Доброго времени суток.
Взялся ради эксперимента сделать OcTree на haskell.
Но пока что не трехмерный случай а одномерный.
Идея в том, что если имеется список точек с координатами от 0 до 1, то мы его делим на две части, в первой части точки с координатой меньше 0.5, во второй — больше 0.5. Далее процесс повторяется, делим точки первой части еще на две (в одной координаты меньше 0.25 в другой больше 0.25), и вторую часть тоже делим на две (до 0.75 и после 0.75). И так впринципе "до бесконечности".
На Хаскеле удобно это сделать так как ленивые вычисления.
По дизайну естественно хочется разделить процесс генерации бесконечного дерева от процесса ограничения этого дерева. Ограничения могут быть разные: по глубине дерева, по количеству точек в интервале, по каким-то характеристикам этих точек, и так далее.
Но вот возникла проблема. При разделении списка С1 текущего уровня на два новых списка хочется чтобы С1 уже память не забирал.
Тоесть смотрю я что в списке С1 1000 точек и думаю, нет, нужно следующий уровень взять, опускаюсь ниже по дереву, и С1 отпускаю чтоб удалился. Так вот не удаляется. Не могу разобраться почему.
Задачу упростил до того что просто на этапе самой генерации дерева обрубаю пустые ветки.
Если без обрубания — память идет только на последний уровень дерева а промежуточные списки действительно удаляются походу.
Если ставлю проверку на пустой список — хранится все списки на всех уровнях.
( см строку с (*) в коде )
Почему так?
Помогите кто может
type Point a = a
type PointList a = [Point a]
data OcTree a = Node (PointList a,PointList a) [OcTree a] | Empty
leafs Empty = [[]]
leafs (Node (items1,items2) forest) = items1 : items2 : concat (map leafs forest)
main = do
putStrLn $ "Begin"
seed <- newStdGen
let randomPoints = randomlist 1000000 seed `use` forceList
let tree = chopByLevelNumber 15 . makeOcTree $ randomPoints
let lastlevel = leafs $ tree
let lastlevelCount = map length lastlevel
putStrLn $ " Last level len : " ++ show ( length lastlevel )
putStrLn $ " Last level lengths : " ++ show lastlevelCount
putStrLn $ "End"
randomlist :: Int -> StdGen -> [Double]
randomlist n = take n . randoms
--
-- utilites
--
forceList :: [a] -> ()
forceList [] = ()
forceList ((!a):as) = forceList as
use :: a -> (a -> ()) -> a
use expr strat = strat expr `seq` expr
--
-- procedures to create an OcTree
--
split2 param items = split2base items
where split2base [] = ([],[])
split2base (x:xs) | x < param = (x:s1,s2)
| otherwise = (s1,x:s2)
where (s1,s2) = split2base xs
makeOcTree :: RealFloat a => PointList a -> OcTree a
makeOcTree items = mkOcTree0 0.5 items
where
mkOcTree0 :: RealFloat a => a -> PointList a -> OcTree a
--(*) mkOcTree0 _ [] = Empty
mkOcTree0 param items = Node (items1,items2) [lt,rt]
where
(items1,items2) = split2 param items
lt = mkOcTree0 (0.5*param) items1
rt = mkOcTree0 (1.5*param) items2
--
-- procedures to chop OcTree
--
chopByLevelNumber :: Int -> OcTree a -> OcTree a
chopByLevelNumber _ Empty = Empty
chopByLevelNumber 0 (Node lst _) = Node lst [Empty,Empty]
chopByLevelNumber n (Node lst forest) = Node lst (map (chopByLevelNumber (n-1)) forest)
извиняюсь, вопрос снят. причина оказалась в другом.
Здравствуйте, STilda, Вы писали:
ST>извиняюсь, вопрос снят. причина оказалась в другом.
Покажи правильно решение.
Чисто в академических целях.
ST>>извиняюсь, вопрос снят. причина оказалась в другом.
P>Покажи правильно решение. Чисто в академических целях.
Ну было несколько ляпов. Расход памяти был изза того что функция leafs написана не правильно. Так как она написана действительно требуются все списки на всех уровнях. Вот оно и держало.
Сейчас это выглядит вот так:
Добавил функции для получения данных из дерева.
{-# LANGUAGE BangPatterns #-}
module Main where
import System.Random
import Data.List
type Point a = a
type Interval a = (Point a, Point a)
type BelongFunction a = Interval a -> Bool
data OcTree a = Node (Interval a) [Point a] [OcTree a]
main = do
putStrLn $ "Begin"
seed <- newStdGen
let randomPoints = randomlist 5000000 seed
let tree = chopByLevelNumber 15 . chopEmpty . makeOcTree split2 splitInterval2 (0,1) $ randomPoints
let lastlevel = leafs tree
let lastlevelCount = map length lastlevel
let insphere = selector (inSphere 0.33 0.03) tree
putStrLn $ " Last level len : " ++ show ( length lastlevel )
putStrLn $ " Last level lengths : " ++ show lastlevelCount
putStrLn $ " In Sphere : " ++ show insphere
putStrLn $ " In Sphere len : " ++ show (length insphere)
putStrLn $ "End"
randomlist :: Int -> StdGen -> [Double]
randomlist n = take n . randoms
leafs :: OcTree a -> [[Point a]]
leafs (Node _ items []) = [items]
leafs (Node _ _ forest) = concat $ map leafs forest
--
-- procedure to create an OcTree
--
makeOcTree splitFunc splitIntervalFunc interval items = mkOcTree0 interval items
where
mkOcTree0 int itms = Node int itms treeList
where
itemsList = splitFunc int itms
intervalList = splitIntervalFunc int
treeList = zipWith mkOcTree0 intervalList itemsList
--
-- procedures to split lists and parameters
--
split2 (x,y) items = split2base items
where split2base [] = [[],[]]
split2base (i:is) | i < c = [i:s1,s2]
| otherwise = [s1,i:s2]
where [s1,s2] = split2base is
c = 0.5*(x+y)
splitInterval2 (x,y) = let c = 0.5*(x+y) in [(x,c),(c,y)]
--
-- procedures to chop OcTree
--
chopEmpty :: OcTree a -> OcTree a
chopEmpty (Node int items forest)
| null items = Node int items []
| otherwise = Node int items (map chopEmpty forest)
chopByLevelNumber :: Int -> OcTree a -> OcTree a
chopByLevelNumber 0 (Node int lst _) = Node int lst []
chopByLevelNumber n (Node int lst forest) = Node int lst (map (chopByLevelNumber (n-1)) forest)
--
-- procedures to make calls to tree
--
-- Return a Function to determine if Interval intersects with circle. Parameters : Center and radius
inSphere :: RealFloat a => Point a -> a -> BelongFunction a
inSphere pt r (x0,x1) = ((pt+r)>=x0 && (pt+r)<x1) || ((pt-r)>=x0 && (pt-r)<x1)
-- Return leafs' points. Belong function says which leafs we are interested in.
selector :: BelongFunction a -> OcTree a -> [Point a]
selector belong (Node interval items [])
| belong interval = items
| otherwise = []
selector belong (Node interval _ trees)
| belong interval = concat . map (selector belong) $ trees
| otherwise = []
Привожу последнюю версию этого дела. Вдруг кому интересно.
Одномерный случай.
Основной модуль: создает дерево для 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 очень просто решила проблему с неосвобождением памяти, которая была в первом сообщении описана и представляла суть вопроса.
