Refactor

src/Dodge/Path.hs

@@ -2,23 +2,20 @@ module Dodge.Path where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Graph
-
 import Geometry
 
-import Control.Monad
-
 import Data.List
 import Data.Maybe
 import Data.Function
-import Data.Graph.Inductive.Graph
-import qualified Data.HashSet as HS
-import qualified Data.Heap as HP
-
-import qualified Data.Map as M
-
-import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
+import Data.Graph.Inductive.Graph hiding ((&))
+import qualified Data.HashSet as HS
+import qualified Data.Heap as HP
+import qualified Data.Map as M
+import Control.Monad
+import Control.Monad.State
+import System.Random
 
 worldGraph :: World -> Point2 -> HS.HashSet Point2
 worldGraph w p = HS.unions $ fmap (\q -> HS.fromList $ pointsAlong w p (p +.+ q)) 
@@ -164,3 +161,44 @@ maybeToEither :: a -> Maybe b -> Either a b
 maybeToEither _ (Just x) = Right x
 maybeToEither y Nothing  = Left y
 
+randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int)
+randomGraphStep n g = 
+    do let ns = neighbors g n
+       i  <- state $ randomR (0,length ns - 1)
+       case ns of [] -> return Nothing
+                  _  -> return $ Just $ ns !! i
+randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int)
+randomGraphStepRestricted n notns g = do 
+    let ns = neighbors g n \\ notns
+    i  <- state $ randomR (0,length ns - 1)
+    case ns of 
+        [] -> return Nothing
+        _  -> return $ Just $ ns !! i
+
+---- continues a walk from a list of points, without repetitions
+---- 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 
+        Nothing -> return (n:ns)
+        Just n' -> randomGraphWalk (n':n:ns) g
+
+randomPointXStepsFrom :: Int -> Point2 -> World -> Point2
+randomPointXStepsFrom i p w = 
+    let g  = _pathGraph w
+        ns = labNodes g
+        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
+    in case mp of 
+        Nothing -> p
+        Just (n,_) -> fromJust 
+            $ lab g (last $ take i $ randomGraphWalk [n] g Data.Function.& evalState  $ _randGen w)
+
+randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2]
+randomPointsXStepsFrom i p w = 
+    let g  = _pathGraph w
+        ns = labNodes g
+        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
+    in case mp of 
+        Nothing -> [p]
+        Just (n,_) -> mapMaybe (lab g) (take i $ randomGraphWalk [n] g Data.Function.& evalState $ _randGen w)