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

Cleanup warnings

Browse Source
This commit is contained in:
jgk
2021-05-17 22:39:18 +02:00
parent d7fcdbf550
commit 69f915a894
102 changed files with 1243 additions and 1185 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Path.hs
+36 -31
View File
@@ -31,7 +31,7 @@ divideLineFixed x a b = fmap
( \i -> a +.+ i * x *.* normalizeV (b -.- a) )
ns
where
numPoints = floor $ dist a b / x
numPoints = floor $ dist a b / x :: Int
ns = map fromIntegral [1 .. numPoints]
-- ok, astar or something like it
@@ -40,25 +40,27 @@ type SearchedNodes = (HP.MinHeap (Float,(Float,[Point2])), [Point2])
stripRight :: Either a b -> b
stripRight (Right x) = x
stripRight _ = error "Trying to strip Right where there is a Left"
stepPath :: (Point2 -> [Point2]) -> Point2 -> SearchedNodes -> Either [Point2] SearchedNodes
stepPath f p (nextNodes, seenNodes) = case HP.view nextNodes of
stepPath h p (nextNodes, seenNodes) = case HP.view nextNodes of
Nothing -> Left []
Just ((_,(cost,q:qs)), nextNodes')
| q == p -> Left (q:qs)
| otherwise ->
let rs' = f q
let rs' = h q
rs = rs' \\ seenNodes
newNodes = map (\r -> (cost + dist q r + dist r p , (cost + dist q r , r:q:qs))) rs
in Right (foldr HP.insert nextNodes' newNodes , rs ++ seenNodes)
newNodes' = map (\r -> (cost + dist q r + dist r p , (cost + dist q r , r:q:qs))) rs
in Right (foldr HP.insert nextNodes' newNodes' , rs ++ seenNodes)
Just _ -> error "In step path"
stepPath' :: (Point2 -> [Point2]) -> Point2 -> SearchedNodes -> [Point2]
stepPath' f p s = case stepPath f p s of
stepPath' h p s = case stepPath h p s of
Left ps -> ps
Right s' -> stepPath' f p s'
Right s' -> stepPath' h p s'
makePath' :: (Point2 -> [Point2]) -> Point2 -> Point2 -> [Point2]
makePath' f s e = stepPath' f e (HP.singleton (0,(0,[s])) , [])
makePath' h s e = stepPath' h e (HP.singleton (0,(0,[s])) , [])
makeNode :: Point2 -> SearchedNodes
makeNode e = (HP.singleton (0,(0,[e])) , [])
@@ -69,18 +71,20 @@ tp1 = (0,1)
tp2 = (0,20)
tp3 = (30,40)
f :: Point2 -> [Point2]
f = incidenceToFunction $ pairsToIncidence
[(tp1,tp2)
,(tp2,tp3)
,(tp2,tp1)
,(tp1,tp3)
]
g = pairsToIncidence
[(tp1,tp2)
,(tp2,tp3)
,(tp2,tp1)
,(tp1,tp3)
]
--g :: [(Point2,[Point2])]
--g = pairsToIncidence
-- [(tp1,tp2)
-- ,(tp2,tp3)
-- ,(tp2,tp1)
-- ,(tp1,tp3)
-- ]
pathBetween :: Point2 -> Point2 -> World -> Maybe [Point2]
pathBetween a b w = (makePath' $ \p -> _pathInc w M.! p) <$> a' <*> b'
@@ -92,46 +96,46 @@ pathBetween a b w = (makePath' $ \p -> _pathInc w M.! p) <$> a' <*> b'
b' = find (flip (isWalkable b) w) nsb
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
makePathBetween a b w = join $ sp <$> fmap fst a' <*> fmap fst b' <*> return g
makePathBetween a b w = join $ sp <$> fmap fst a' <*> fmap fst b' <*> return g'
where
g = _pathGraph w
g' = _pathGraph w
nsa = concat $ lookLookups (zoneAroundPoint a) (_pathPoints w)
nsb = concat $ lookLookups (zoneAroundPoint b) (_pathPoints w)
a' = find (flip (isWalkable a) w . snd) nsa
b' = find (flip (isWalkable b) w . snd) nsb
ezipWith :: Monoid a => (b -> c -> d) -> Either a b -> Either a c -> Either a d
ezipWith f (Right x) (Right y) = Right (f x y)
ezipWith f (Left x) (Right _) = Left x
ezipWith f (Right _) (Left y) = Left y
ezipWith f (Left x) (Left y) = Left (mappend x y)
ezipWith f' (Right x) (Right y) = Right (f' x y)
ezipWith _ (Left x) (Right _) = Left x
ezipWith _ (Right _) (Left y) = Left y
ezipWith _ (Left x) (Left y) = Left (mappend x y)
makePathBetween' :: Point2 -> Point2 -> World -> Either String [Int]
makePathBetween' a b w =
let g = _pathGraph w
ns = labNodes g
nsa = _pathPoints w `ixNZ` a
nsb = _pathPoints w `ixNZ` b
let g' = _pathGraph w
ns = labNodes g'
--nsa = _pathPoints w `ixNZ` a
--nsb = _pathPoints w `ixNZ` b
a' = case listToMaybe $ sortBy (compare `on` dist a . snd) $ filter (flip (isWalkable a) w . snd) ns of
Just p -> Right $ fst p
_ -> Left "FIRST POINT UNSEEN"
b' = case listToMaybe $ sortBy (compare `on` dist b . snd) $ filter (flip (isWalkable b) w . snd) ns of
Just p -> Right $ fst p
_ -> Left $ "SECOND POINT UNSEEN" ++ show b
in case ezipWith (\x y -> sp x y g) a' b' of
in case ezipWith (\x y -> sp x y g') a' b' of
Right (Just xs) -> Right xs
Right Nothing -> Left $ "NO PATH" ++ show a ++ show b ++ show a' ++ show b'
Left m -> Left m
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
makePathBetweenPs a b w = mapMaybe (lab g) <$> makePathBetween b a w
makePathBetweenPs a b w = mapMaybe (lab g') <$> makePathBetween b a w
where
g = _pathGraph w
g' = _pathGraph w
makePathBetweenPs' :: Point2 -> Point2 -> World -> Either String [Point2]
makePathBetweenPs' a b w = mapMaybe (lab g) <$> makePathBetween' a b w
makePathBetweenPs' a b w = mapMaybe (lab g') <$> makePathBetween' a b w
where
g = _pathGraph w
g' = _pathGraph w
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w
@@ -161,10 +165,11 @@ randomGraphStepRestricted n notns g = do
---- supposes that the list is non-empty
randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int]
randomGraphWalk (n:ns) g = do
next <- randomGraphStepRestricted n ns g
case next of
next' <- randomGraphStepRestricted n ns g
case next' of
Nothing -> return (n:ns)
Just n' -> randomGraphWalk (n':n:ns) g
randomGraphWalk _ _ = error "Trying to walk in an empty list"
randomPointXStepsFrom :: Int -> Point2 -> World -> Point2
randomPointXStepsFrom i p w =