justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Replace some instances of sorting with minimums

Browse Source
This commit is contained in:
jgk
2021-07-20 05:26:27 +02:00
parent 58b2c8a842
commit 8bc5b49a3c
2 changed files with 32 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+20 -45
View File
@@ -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
. sortOn f
. IM.elems
= safeMinimumOn f
$ 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
. sortOn f
. IM.elems
= safeMinimumOn f
$ 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
. sortOn f
= safeMinimumOn 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
. sortOn f
. IM.elems
= safeMinimumOn f
$ 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
. sortOn snd
. safeMinimumOn 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
. sortOn snd
. safeMinimumOn 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
. sortOn (snd . snd)
. safeMinimumOn (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
. sortOn (snd . snd)
. safeMinimumOn (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
. sortOn (snd . snd)
. safeMinimumOn (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 =
let crs = IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
in listToMaybe sortedCrs
{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.
-}
nearestCrInRad p r w
= safeMinimumOn (dist p . _crPos)
$ IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
{- | 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 =
let crs = IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
in listToMaybe sortedCrs
nearestCrInTri p dir x w
= safeMinimumOn (dist p . _crPos)
$ IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
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 =
let crs = IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs
in listToMaybe sortedCrs
nearestCrInFront p dir x w
= safeMinimumOn (dist p . _crPos)
$ IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
where
rec = [p, pR, pR1, pL1, pL ]
pR = p +.+ rotateV (dir - pi*(3/8)) (x/2,0)
src/Dodge/Base/Collide.hs
+12 -8
View File
@@ -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 _ [] = Nothing
safeMinimumOn f (x:xs) = g x (f x) xs
safeMinimumOn' :: (Ord b) => (a -> b) -> [a] -> Maybe a
safeMinimumOn' _ [] = Nothing
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.