--- /dev/null
+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
+
+import Data.Ix
+import qualified Data.Set as S
+import Control.Monad
+
+
+data Point = Point Int Int -- row, column
+ deriving (Show, Eq, Ord, Ix)
+
+type Grid = S.Set Point
+
+gridBounds = (Point 1 1, Point 7 7)
+pathStart = Point 1 1
+pathEnd = Point 7 1
+fullPathLength = 48
+
+-- gridBounds = (Point 1 1, Point 2 2)
+-- pathStart = Point 1 1
+-- pathEnd = Point 2 1
+-- fullPathLength = 3
+
+-- gridBounds = (Point 1 1, Point 4 4)
+-- pathStart = Point 1 1
+-- pathEnd = Point 4 1
+-- fullPathLength = 15
+
+data Direction = U | R | D | L
+ deriving (Show, Eq, Ord, Enum, Bounded)
+
+data DirectionConstraint = CU | CR | CD | CL | Unknown
+ deriving (Show, Eq, Ord, Enum, Bounded)
+
+data State = State { visited :: Grid
+ , pos :: Point
+ , trail :: [Direction]
+ , constraints :: [DirectionConstraint]
+ }
+ deriving (Show, Eq, Ord)
+
+initialState :: [DirectionConstraint] -> State
+initialState cs =
+ State { visited = S.singleton pathStart
+ , pos = pathStart
+ , constraints = cs
+ , trail = []
+ }
+
+
+main :: IO ()
+main = do
+ -- let cs = replicate fullPathLength Unknown
+ let cs = readConstraints "??????R??????U??????????????????????????LD????D?"
+ -- let cs = readConstraints "DRURRRRRDDDLUULDDDLDRRURDDLLLLLURULURRUULDLLDDDD"
+ let paths = allPaths cs
+ print $ length paths
+ -- print paths
+ -- line <- getLine
+ -- let n = read line
+ -- let nums = unfoldr collatzStep n
+ -- let outStr = intercalate " " $ map show nums
+ -- putStrLn outStr
+
+readConstraints :: String -> [DirectionConstraint]
+readConstraints = map readConstraint
+
+readConstraint :: Char -> DirectionConstraint
+readConstraint 'U' = CU
+readConstraint 'R' = CR
+readConstraint 'D' = CD
+readConstraint 'L' = CL
+readConstraint _ = Unknown
+
+delta :: Direction -> Point
+delta U = Point (-1) 0
+delta R = Point 0 1
+delta D = Point 1 0
+delta L = Point 0 (-1)
+
+(^+^) :: Point -> Point -> Point
+(Point x1 y1) ^+^ (Point x2 y2) = Point (x1 + x2) (y1 + y2)
+
+opposite :: Direction -> Direction -> Bool
+opposite U D = True
+opposite D U = True
+opposite L R = True
+opposite R L = True
+opposite _ _ = False
+
+
+compatible :: Direction -> DirectionConstraint -> Bool
+compatible U CU = True
+compatible R CR = True
+compatible D CD = True
+compatible L CL = True
+compatible _ Unknown = True
+compatible _ _ = False
+
+
+isComplete :: State -> Bool
+isComplete (State {..}) =
+ pos == pathEnd && length trail == fullPathLength
+
+successors :: State -> [State]
+successors state@(State {..})
+ | pos == pathEnd = []
+ | isComplete state = []
+ | otherwise =
+ do dir <- [minBound..maxBound]
+ let givenDirection = head constraints
+ guard $ compatible dir givenDirection
+ let nextPos = pos ^+^ (delta dir)
+ guard $ inRange gridBounds nextPos
+ {-# SCC "setNonMember" #-} guard $ S.notMember nextPos visited
+ let nextVisited = S.insert nextPos visited
+ return $ State { visited = nextVisited
+ , pos = nextPos
+ , constraints = tail constraints
+ , trail = dir : trail
+ }
+
+allPaths :: [DirectionConstraint] -> [State]
+allPaths constraints = dfs [initialState constraints] []
+
+-- bfs :: [State] -> [State] -> [State]
+-- bfs [] visited = visited
+-- bfs (current:agenda) visited
+-- | isComplete current = bfs agenda (current : visited)
+-- | otherwise =
+-- let succs = successors current
+-- newAgenda = agenda ++ succs
+-- in bfs newAgenda visited
+
+dfs :: [State] -> [State] -> [State]
+dfs [] visited = visited
+dfs (current:agenda) visited
+ | isComplete current = dfs agenda (current : visited)
+ | otherwise =
+ let succs = successors current
+ newAgenda = succs ++ agenda
+ in dfs newAgenda visited