Replace some instances of sorting with minimums

src/Dodge/Base.hs

@@ -20,7 +20,7 @@ import qualified IntMapHelp as IM
 
 import Control.Lens
 --import Control.Monad.State
-import Data.List
+--import Data.List
 --import Data.Function
 import Data.Maybe
 --import Data.Bifunctor
@@ -82,14 +82,6 @@ wallsOnLine p1 p2 ws = hitWalls
     hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
     hitWalls = filter (isJust . hitPoint) (IM.elems ws)
 
-wallOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Wall
-wallOnLine p1 p2 ws 
-    = listToMaybe $ sortBy f hitWalls
-  where 
-    hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
-    hitWalls = filter (isJust . hitPoint) (IM.elems ws)
-    f w1 w2 = compare (magV (p1 -.- fromJust (hitPoint w1))) (magV (p1 -.- fromJust (hitPoint w2)))
-
 wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
 wallsOnCirc p r = IM.filter f
   where 
@@ -206,7 +198,6 @@ reflectPointCreature p1 p2 cr = case collidePointCirc p1 p2 (_crRad cr) (_crPos
 reflectPointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Point2,Int)
 reflectPointCreatures p1 p2 cs 
     = safeMinimumOn f
-    . IM.elems 
     $ IM.mapMaybe (reflectPointCreature p1 p2) cs
   where 
     f (a,_,_) = magV (a -.- p1)
@@ -233,9 +224,7 @@ reflectCircCreatures
     -> IM.IntMap Creature 
     -> Maybe (Point2,Point2,Int)
 reflectCircCreatures rad p1 p2 cs 
-    = listToMaybe 
+    = safeMinimumOn f 
-    . sortOn f 
-    . IM.elems 
     $ IM.mapMaybe (reflectCircCreature rad p1 p2) cs
   where 
     f (a,_,_) = magV (a -.- p1)
@@ -265,9 +254,7 @@ collidePointFF  = undefined
 -- If found, gives point and reflection velocity, reflection damped in normal.
 collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
 collideCircWalls' p1 p2 rad ws 
-    = listToMaybe 
+    = safeMinimumOn f 
-    . sortOn f 
-    . IM.elems 
     $ IM.mapMaybe 
         (( \(x:y:_) -> fmap 
             ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
@@ -293,8 +280,7 @@ collideCircWalls' p1 p2 rad ws
 -- If found, gives point and normal of wall.
 collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
 collidePointLines p1 p2 ws 
-    = listToMaybe 
+    = safeMinimumOn f
-    . sortOn f
     $ mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
         . _wlLine') ws
   where 
@@ -304,9 +290,7 @@ collidePointLines p1 p2 ws
 -- If found, gives point and normal of wall.
 collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
 collidePointWallsNorm p1 p2 ws 
-    = listToMaybe 
+    = safeMinimumOn f 
-    . sortOn f 
-    . IM.elems 
     $ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
         . _wlLine) ws
   where 
@@ -315,8 +299,7 @@ collidePointWallsNorm p1 p2 ws
 collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int
 collidePointCreatures p1 p2 w 
     = fmap fst 
-    . listToMaybe 
+    . safeMinimumOn snd
-    . sortOn snd
     . IM.toList 
     . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (_crRad x) (_crPos x)) 
     $_creatures w
@@ -325,8 +308,7 @@ collidePointCreatures p1 p2 w
 collideCircCreatures :: Point2 -> Point2 -> Float -> World -> Maybe Int
 collideCircCreatures p1 p2 rad w 
     = fmap fst 
-    . listToMaybe 
+    . safeMinimumOn snd
-    . sortOn snd
     . IM.toList 
     . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (rad + _crRad x) (_crPos x)) 
     $ _creatures w
@@ -335,8 +317,7 @@ collideCircCreatures p1 p2 rad w
 collidePointCrsPoint :: Point2 -> Point2 -> World -> Maybe (Point2,Int)
 collidePointCrsPoint p1 p2 w 
     = fmap f 
-    . listToMaybe 
+    . safeMinimumOn (snd . snd)
-    . sortOn (snd . snd)
     . IM.toList 
     . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
     $ _creatures w
@@ -347,8 +328,7 @@ Maybe evaluates the creature id and hit point. -}
 collideCircCrsPoint :: Point2 -> Point2 -> Float -> World -> Maybe (Point2,Int)
 collideCircCrsPoint p1 p2 rad w 
     = fmap f 
-    . listToMaybe 
+    . safeMinimumOn (snd . snd)
-    . sortOn (snd . snd)
     . IM.toList 
     . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x)) 
     $ _creatures w
@@ -358,8 +338,7 @@ collideCircCrsPoint p1 p2 rad w
 collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
 collidePointCrsWithoutPoint cid p1 p2 w 
     = fmap f 
-    . listToMaybe 
+    . safeMinimumOn (snd . snd)
-    . sortOn (snd . snd)
     . IM.toList 
     . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
     . IM.delete cid 
@@ -403,21 +382,18 @@ crsOnThickLine thickness p1 p2 w
 {- | Find 'Maybe' the closest creature to a point, within a circle.
  -}
 nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
-nearestCrInRad p r w = 
+nearestCrInRad p r w 
-    let crs = IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
+    = safeMinimumOn (dist p . _crPos)
-        sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
+    $ IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
-    in listToMaybe sortedCrs
+{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.  -}
-{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.
- -}
 nearestCrInTri 
     :: Point2 
     -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
     -> Float    -- ^ Distance. 
     -> World -> Maybe Creature
-nearestCrInTri p dir x w = 
+nearestCrInTri p dir x w 
-    let crs = IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
+    = safeMinimumOn (dist p . _crPos)
-        sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
+    $ IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
-    in listToMaybe sortedCrs
  where 
     tri = 
         [p 
@@ -432,10 +408,9 @@ nearestCrInFront
     -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
     -> Float    -- ^ Distance.
     -> World -> Maybe Creature
-nearestCrInFront p dir x w = 
+nearestCrInFront p dir x w 
-    let crs = IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
+    = safeMinimumOn (dist p . _crPos)
-        sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
+    $ IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
-    in listToMaybe sortedCrs
   where 
     rec = [p, pR, pR1, pL1, pL ]
     pR  = p +.+ rotateV (dir - pi*(3/8)) (x/2,0)

src/Dodge/Base/Collide.hs

@@ -8,6 +8,7 @@ import Geometry
 
 --import Data.List
 import Data.Maybe
+import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
@@ -16,15 +17,23 @@ import Control.Lens
 --
 -- > safeMinimumOn id [] == Nothing
 -- > safeMinimumOn length ["test","extra","a"] == Just "a"
-safeMinimumOn :: (Ord b) => (a -> b) -> [a] -> Maybe a
+safeMinimumOn' :: (Ord b) => (a -> b) -> [a] -> Maybe a
-safeMinimumOn _ [] = Nothing
+safeMinimumOn' _ [] = Nothing
-safeMinimumOn f (x:xs) = g x (f x) xs
+safeMinimumOn' f (x:xs) = g x (f x) xs
     where
         g v _  [] = Just v
         g v mv (y:ys) | my < mv = g y my ys
                       | otherwise = g v mv ys
             where my = f y
 
+safeMinimumOn :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a
+safeMinimumOn f = foldl' g Nothing
+  where
+    g (Just x) y 
+        | f x < f y = Just x
+        | otherwise = Just y
+    g Nothing y = Just y
+
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w
@@ -44,7 +53,6 @@ hitPointLines p1 p2
 reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
 reflectPointWalls p1 p2 ws 
     = safeMinimumOn (dist p1 . fst)
-    . IM.elems 
     $ IM.mapMaybe 
         (( \(x,y) -> 
             fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
@@ -63,7 +71,6 @@ reflectPointWallsDamped
     -> Maybe (Point2,Point2)
 reflectPointWallsDamped dfact p1 p2 ws 
     = safeMinimumOn (dist p1 . fst)
-    . IM.elems 
     $ IM.mapMaybe 
         (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
                             . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
@@ -84,14 +91,12 @@ furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 furthestPointWalkable p1 p2 ws 
     = fromMaybe p2
     . safeMinimumOn (dist p1) 
-    . IM.elems 
     $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
 
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
 collidePointIndirect p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.elems 
     . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) 
     $ IM.filter (not . _wlIsSeeThrough) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
@@ -99,7 +104,6 @@ collidePointIndirect p1 p2 ws
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 collidePointFire p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.elems 
     . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) 
     $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
 {- | Checks to see whether someone can fire bullets effectively between two points.