switch implementation of heap from being based on heap.sml (heap as described by one of Chris Okasaki's papers) to being based on bin-vec.sml (simple vector storing elements in sorted order); more performant this way for cache reasons

fcore/bin-vec.sml

@@ -12,13 +12,16 @@ sig
   type elem
 
   val empty: elem vector
+  val isEmpty: elem vector -> bool
 
   val sub: elem vector * int -> elem
   val contains: elem * elem vector -> bool
+  val findMin: elem vector -> elem
 
   val findInsPos: elem * elem vector -> int
   val insert: elem vector * elem * int -> elem vector
   val delete: elem vector * elem -> elem vector
+  val deleteMin: elem vector -> elem vector
   val updateAtIdx: elem vector * elem * int -> elem vector
 
   val fromList: elem list -> elem vector
@@ -30,8 +33,23 @@ struct
 
   val empty = Vector.fromList []
 
+  fun isEmpty vec = Vector.length vec = 0
+
+  fun deleteMin vec =
+    if Vector.length vec <= 1 then
+      Vector.fromList []
+    else
+      let
+        val len = Vector.length vec - 2
+        val slice = VectorSlice.slice (vec, 1, SOME len)
+      in
+        VectorSlice.vector slice
+      end
+
   val sub = Vector.sub
 
+  fun findMin vec = Vector.sub (vec, 0)
+
   fun reverseLinearSearch (pos, findNum, vec) =
     if pos < 0 then
       ~1
@@ -183,3 +201,15 @@ structure ValSet =
 
        fun g ({distance = a, ...}: elem, {distance = b, ...}: elem) = a > b
      end)
+
+structure DistVec =
+  MakeBinVec
+    (struct
+       type elem = {distance: int, id: int, comesFrom: int}
+
+       fun l ({distance = a, ...}: elem, {distance = b, ...}: elem) = a < b
+
+       fun eq ({distance = a, ...}: elem, {distance = b, ...}: elem) = a = b
+
+       fun g ({distance = a, ...}: elem, {distance = b, ...}: elem) = a > b
+     end)

fcore/heap.sml

@@ -1,145 +0,0 @@
-(* implementation based on Chris Okasaki's paper describing SkewBinomialQueues
- * from the following PDF, based on figure 6 and figure 7.
- * https://www.brics.dk/RS/96/37/BRICS-RS-96-37.pdf
- *
- * Differences: 
- * - No exception is raised as we return a default value
- *   in the case of findMin when queue is empty 
- *   and we return the empty queue when queue is empty
- *   in the case of deleteMin.
- * - Use foldDeleteMin function to eliminate 
- *   runtime cost of closure/defunctionalisation
- * *)
-signature ORDERED =
-sig
-  type t
-
-  val default: t
-  val leq: t * t -> bool
-end
-
-signature PRIORITY_QUEUE =
-sig
-  structure Elem: ORDERED
-
-  type t
-  val empty: t
-  val isEmpty: t -> bool
-  val insert: Elem.t * t -> t
-  val findMin: t -> Elem.t
-  val deleteMin: t -> t
-end
-
-functor MakeSkewHeap(E: ORDERED): PRIORITY_QUEUE =
-struct
-  structure Elem = E
-
-  type rank = int
-
-  datatype tree = NODE of Elem.t * rank * tree list
-  type t = tree list
-
-  fun root (NODE (x, _, _)) = x
-
-  fun rank (NODE (_, r, _)) = r
-
-  fun link (t1, t2) =
-    case (t1, t2) of
-      (NODE (x1, r1, c1), NODE (x2, r2, c2)) =>
-        if Elem.leq (x1, x2) then NODE (x1, r1 + 1, t2 :: c1)
-        else NODE (x2, r2 + 1, t1 :: c2)
-
-  fun skewLink (t0, t1, t2) =
-    case (t0, t1, t2) of
-      (NODE (x0, r0, _), NODE (x1, r1, c1), NODE (x2, r2, c2)) =>
-        if Elem.leq (x1, x0) andalso Elem.leq (x1, x2) then
-          NODE (x1, r1 + 1, t0 :: t2 :: c1)
-        else if Elem.leq (x2, x0) andalso Elem.leq (x2, x1) then
-          NODE (x2, r2 + 1, t0 :: t1 :: c2)
-        else
-          NODE (x0, r1 + 1, [t1, t2])
-
-  fun ins (t, t' :: ts) =
-        if rank t < rank t' then t :: t' :: ts else ins (link (t, t'), ts)
-    | ins (t, []) = [t]
-
-  val empty = []
-
-  fun isEmpty [] = true
-    | isEmpty _ = false
-
-  fun insert (x, ts as t1 :: t2 :: rest) =
-        if rank t1 = rank t2 then skewLink (NODE (x, 0, []), t1, t2) :: rest
-        else NODE (x, 0, []) :: ts
-    | insert (x, ts) =
-        NODE (x, 0, []) :: ts
-
-  fun helpFindMin (prev, []) = root prev
-    | helpFindMin (prev, [t]) = root t
-    | helpFindMin (prev, t :: ts) =
-        let val x = helpFindMin (t, ts)
-        in if Elem.leq (root t, x) then root t else x
-        end
-
-  fun findMin [] = Elem.default
-    | findMin [t] = root t
-    | findMin (t :: ts) = helpFindMin (t, ts)
-
-  fun getMin (prevT, t) =
-    case t of
-      [t] => (t, [])
-    | t :: ts =>
-        let val (t', ts') = getMin (t, ts)
-        in if Elem.leq (root t, root t') then (t, ts) else (t', t :: ts')
-        end
-    | [] => (prevT, [])
-
-  fun split (ts, xs, []) = (ts, xs)
-    | split (ts, xs, t :: c) =
-        if rank t = 0 then split (ts, root t :: xs, c)
-        else split (t :: ts, xs, c)
-
-  fun unify [] = []
-    | unify (t :: ts) = ins (t, ts)
-
-  fun meldUniq ([], ts) = ts
-    | meldUniq (ts, []) = ts
-    | meldUniq (t1 :: ts1, t2 :: ts2) =
-        if rank t1 < rank t2 then t1 :: meldUniq (ts1, t2 :: ts2)
-        else if rank t2 < rank t1 then t2 :: meldUniq (t1 :: ts1, ts2)
-        else ins (link (t1, t2), meldUniq (ts1, ts2))
-
-  fun meld (ts, ts') =
-    meldUniq (unify ts, unify ts')
-
-  fun foldDeleteMin (lst, state) =
-    case lst of
-      [] => state
-    | hd :: tl =>
-        let val state = insert (hd, state)
-        in foldDeleteMin (tl, state)
-        end
-
-  fun deleteMin [] = raise Empty
-    | deleteMin (ts as hd :: tl) =
-        let
-          val (NODE (x, r, c), ts) = getMin (hd, tl)
-          val (ts', xs') = split ([], [], c)
-        in
-          foldDeleteMin (xs', meld (ts, ts'))
-        end
-end
-
-structure DistHeap =
-  MakeSkewHeap
-    (struct
-       type t = {distance: int, id: int, comesFrom: int}
-       type id = int
-
-       (* default = defaultID returned when queue is empty *)
-       val default = {distance = ~1, id = ~1, comesFrom = ~1}
-
-       fun getID {id, distance = _} = id
-
-       fun leq ({distance = d1, ...}: t, {distance = d2, ...}: t) = d1 <= d2
-     end)

fcore/path-finding.sml

@@ -12,7 +12,7 @@ struct
       , distSoFar: int
       }
 
-    type state = ValSet.elem vector * DistHeap.t
+    type state = ValSet.elem vector * DistVec.elem vector
 
     fun isBetween (p1, check, p2) = check >= p1 andalso check <= p2
 
@@ -122,11 +122,10 @@ struct
             else
               (* key not explored, so add to queue *)
               let
-                val q =
+                val insRecord =
-                  DistHeap.insert
+                  {distance = dist, id = foldPlatID, comesFrom = fromPlatID}
-                    ( {distance = dist, id = foldPlatID, comesFrom = fromPlatID}
+                val insPos = DistVec.findInsPos (insRecord, q)
-                    , q
+                val q = DistVec.insert (q, insRecord, insPos)
-                    )
               in
                 (eVals, q)
               end
@@ -134,9 +133,10 @@ struct
         else
           (* key not explored, so add to queue *)
           let
-            val q =
+            val insRecord =
-              DistHeap.insert
+              {distance = dist, id = foldPlatID, comesFrom = fromPlatID}
-                ({distance = dist, id = foldPlatID, comesFrom = fromPlatID}, q)
+            val insPos = DistVec.findInsPos (insRecord, q)
+            val q = DistVec.insert (q, insRecord, insPos)
           in
             (eVals, q)
           end
@@ -229,17 +229,21 @@ struct
   end
 
   fun filterMinDuplicates (q, eKeys) =
-    let
+    if DistVec.isEmpty q then
-      val {id = min, ...} = DistHeap.findMin q
+      q
-      val pos = IntSet.findInsPos (min, eKeys)
+    else
-    in
+      let
-      if IntSet.contains (min, eKeys) then
+        val {id = min, ...} = DistVec.findMin q
-        let val q = DistHeap.deleteMin q
+
-        in filterMinDuplicates (q, eKeys)
+        val pos = IntSet.findInsPos (min, eKeys)
-        end
+      in
-      else
+        if IntSet.contains (min, eKeys) then
-        q
+          let val q = DistVec.deleteMin q
-    end
+          in filterMinDuplicates (q, eKeys)
+          end
+        else
+          q
+      end
 
   fun helpGetPathList (curID, eID, eKeys, eVals, acc) =
     if curID = eID then
@@ -283,57 +287,51 @@ struct
       if IntSet.contains (pID, eKeys) then
         (* return path if we explored pid *)
         getPathList (pID, eID, eKeys, eVals)
+      else (* continue dijkstra's algorithm *) if DistVec.isEmpty q then
+        (* return empty list to signify that there is no path *)
+        []
       else
-        (* continue dijkstra's algorithm *)
+        (* find reachable values from min in quad tree *)
         let
-          val {distance = distSoFar, id = minID, comesFrom} = DistHeap.findMin q
+          val {distance = distSoFar, id = minID, comesFrom} = DistVec.findMin q
+          val plat = Platform.find (minID, platforms)
+
+          (* add explored *)
+          val insPos = IntSet.findInsPos (minID, eKeys)
+          val eKeys = IntSet.insert (eKeys, minID, insPos)
+          val eVals =
+            ValSet.insert
+              (eVals, {distance = distSoFar, from = comesFrom}, insPos)
+
+          val env =
+            { platforms = platforms
+            , currentPlat = plat
+            , eKeys = eKeys
+            , distSoFar = distSoFar
+            }
+
+          val state = (eVals, q)
+
+          (* calculate area to fold over quad tree *)
+          val ww = Constants.worldWidth
+          val wh = Constants.worldHeight
+
+          val {x, y, width, ...} = plat
+          val y = y - Constants.jumpLimit
+          val height = wh - y
+
+          (* fold over quad tree, updating any distances 
+           * we find the shortest path for *)
+          val (eVals, q) = addPlatforms (0, (eVals, q), env)
         in
-          if minID = ~1 then
+          loop (pID, eID, platforms, platformTree, q, eKeys, eVals)
-            (* return empty list to signify that there is no path *)
-            []
-          else
-            (* find reachable values from min in quad tree *)
-            let
-              val plat = Platform.find (minID, platforms)
-
-              (* add explored *)
-              val insPos = IntSet.findInsPos (minID, eKeys)
-              val eKeys = IntSet.insert (eKeys, minID, insPos)
-              val eVals =
-                ValSet.insert
-                  (eVals, {distance = distSoFar, from = comesFrom}, insPos)
-
-              val env =
-                { platforms = platforms
-                , currentPlat = plat
-                , eKeys = eKeys
-                , distSoFar = distSoFar
-                }
-
-              val state = (eVals, q)
-
-              (* calculate area to fold over quad tree *)
-              val ww = Constants.worldWidth
-              val wh = Constants.worldHeight
-
-              val {x, y, width, ...} = plat
-              val y = y - Constants.jumpLimit
-              val height = wh - y
-
-              (* fold over quad tree, updating any distances 
-               * we find the shortest path for *)
-              val (eVals, q) = addPlatforms (0, (eVals, q), env)
-            in
-              loop (pID, eID, platforms, platformTree, q, eKeys, eVals)
-            end
         end
     end
 
   fun start (pID, eID, platforms, platformTree) =
     let
       (* initialise data structures: the priority queue and the explored map *)
-      val q = DistHeap.empty
+      val q = DistVec.fromList [{distance = 0, id = eID, comesFrom = eID}]
-      val q = DistHeap.insert ({distance = 0, id = eID, comesFrom = eID}, q)
 
       (* explored keys and values *)
       val eKeys = IntSet.empty

oms.mlb

@@ -2,7 +2,6 @@ $(SML_LIB)/basis/basis.mlb
 
 (* fcore *)
 fcore/constants.sml
-fcore/heap.sml
 
 fcore/quad-tree-type.sml
 fcore/quad-tree.sml