Build a Barnes-Hut tree

src/Lib.hs

@@ -22,6 +22,7 @@ module Lib (
   subOctree,
   updateRegion,
   insertBody,
+  buildTree,
   -- * Gravity force
   field,
   acceleration,
@@ -32,6 +33,9 @@ module Lib (
   au, sun, earth, moon, mercury, venus, mars
   ) where
 
+import Data.List
+import Data.Foldable
+
 import Linear.Vector
 import Linear.V3
 import Linear.Affine
@@ -164,6 +168,27 @@ insertBody b t = case t of
         SEU -> Node r' ned nwd swd sed neu nwu swu (insertBody b seu)
 
 
+-- | Build a Barnes-Hut Octree from a list of Bodies
+buildTree :: [Body] -> Octree
+buildTree bs = foldr insertBody (Empty r) bs
+  where r = Region { _regionCenter = center,
+                     _regionCenterOfMass = center,
+                     _regionMass = 0,
+                     _regionDiameter = diameter
+                   }
+        -- We determine the initial center and diameter of the region
+        -- using the positions of all input bodies.
+        positions :: [Point V3 Double]
+        positions = map (flip (^.) bodyPosition) bs
+        -- The center is just the geometric center of all positions.
+        center :: Point V3 Double
+        center = (sum $ positions) ^/ (fromIntegral $ length positions)
+        -- The diameter is the maximum range of the coordinates. This
+        -- is roughly 2x more what is needed.
+        diameter :: Double
+        diameter = maximum $ map (\xs -> maximum xs - minimum xs) $ transpose $ map toList positions
+
+
 --------------------------------------------------------------------------------
 -- GRAVITY FORCE
 --------------------------------------------------------------------------------