code functor to fold through a specified region of the quad tree, without having to allocate an intermediary list or using a closure (which both have runtime costs)

2025-01-18 22:54:34 +00:00
parent 2c6b1556d1
commit 84ea0ce24b
4 changed files with 171 additions and 17 deletions
--- a/fcore/quad-tree-fold.sml
+++ b/fcore/quad-tree-fold.sml
@@ -0,0 +1,116 @@
+signature QUAD_FOLDER =
+sig
+  type env
+  type state
+
+  val isReachable: state * env * int -> bool
+  val fState: state * env * int -> state
+end
+
+functor MakeQuadFolder(Fn: QUAD_FOLDER) =
+struct
+  open QuadTreeType
+
+  fun foldVec (iX, iY, iW, iH, pos, elements, state, env) =
+    if pos = Vector.length elements then
+      state
+    else
+      let
+        val {itemID, ...} = Vector.sub (elements, pos)
+        val state =
+          if Fn.isReachable (state, env, itemID) then
+            Fn.fState (state, env, itemID)
+          else
+            state
+      in
+        foldVec (iX, iY, iW, iH, pos + 1, elements, state, env)
+      end
+
+  fun foldRegion
+    ( itemX
+    , itemY
+    , itemW
+    , itemH
+    , quadX
+    , quadY
+    , quadW
+    , quadH
+    , env: Fn.env
+    , state: Fn.state
+    , tree: QuadTreeType.t
+    ) =
+    case tree of
+      NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
+        let
+          (* fold over intersecting elements in this vector first *)
+          val state = foldVec
+            (itemX, itemY, itemW, itemH, 0, elements, state, env)
+
+          val halfW = quadW div 2
+          val halfH = quadH div 2
+        in
+          (case
+             QuadTree.whichQuadrant
+               (itemX, itemY, itemW, itemH, quadX, quadY, quadW, quadH)
+           of
+             TOP_LEFT =>
+               foldRegion
+                 ( itemX
+                 , itemY
+                 , itemW
+                 , itemH
+                 , quadX
+                 , quadY
+                 , halfW
+                 , halfH
+                 , env
+                 , state
+                 , topLeft
+                 )
+           | TOP_RIGHT =>
+               foldRegion
+                 ( itemX
+                 , itemY
+                 , itemW
+                 , itemH
+                 , quadX + halfW (* middleX *)
+                 , quadY
+                 , halfW
+                 , halfH
+                 , env
+                 , state
+                 , topRight
+                 )
+           | BOTTOM_LEFT =>
+               foldRegion
+                 ( itemX
+                 , itemY
+                 , itemW
+                 , itemH
+                 , quadX
+                 , quadY + halfH (* middleY *)
+                 , halfW
+                 , halfH
+                 , env
+                 , state
+                 , bottomLeft
+                 )
+           | BOTTOM_RIGHT =>
+               foldRegion
+                 ( itemX
+                 , itemY
+                 , itemW
+                 , itemH
+                 , quadX + halfW (* middleX *)
+                 , quadY + halfH (* middleY *)
+                 , halfW
+                 , halfH
+                 , env
+                 , state
+                 , bottomRight
+                 )
+           | PARENT_QUADRANT => state)
+        end
+    | LEAF elements =>
+        foldVec (itemX, itemY, itemW, itemH, 0, elements, state, env)
+end