Day 18: Some Progress
goal needs to be x, so moved into the list comprehension
This commit is contained in:
parent
02bfd4d708
commit
aecf61358f
|
@ -4,22 +4,35 @@ module Main where
|
|||
import Data.List
|
||||
import Data.List.Split
|
||||
import Data.List.Utils
|
||||
import Data.Char
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
import Helpers
|
||||
import Linear.V2
|
||||
import Debug.Trace
|
||||
|
||||
type DungeonMap = M.Map (V2 Int) Char
|
||||
data Distance = Reachable Int | Unreachable deriving (Show, Eq)
|
||||
|
||||
instance Num Distance where
|
||||
Reachable x + Reachable y = Reachable (x+y)
|
||||
Unreachable + _ = Unreachable
|
||||
_ + Unreachable = Unreachable
|
||||
|
||||
instance Ord Distance where
|
||||
Reachable x <= Reachable y = x<=y
|
||||
Unreachable <= _ = False
|
||||
_ <= Unreachable = True
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
map <- updateScreenBuffer M.empty (0, 0) <$> readFile "testinput1"
|
||||
putStrLn $ drawMap map
|
||||
let spos = findPos '@' map
|
||||
let epos = findPos 'e' map
|
||||
print $ getNeighbors map spos
|
||||
print $ getNeighborsMap map (getNeighbors map spos)
|
||||
print $ distanceFromTo map '@' 'd'
|
||||
dMap <- updateScreenBuffer M.empty (0, 0) <$> readFile "testinput1"
|
||||
putStrLn $ drawMap dMap
|
||||
print $ distanceFromTo dMap '@' 'f'
|
||||
print $ distanceFromTo dMap '@' 'a'
|
||||
print $ distanceFromTo dMap '@' 'A'
|
||||
print $ tls1 dMap (S.fromList "abcdef") 'f'
|
||||
|
||||
updateScreenBuffer :: DungeonMap -> (Int, Int) -> String -> DungeonMap
|
||||
updateScreenBuffer buf _ [] = buf
|
||||
|
@ -39,24 +52,43 @@ getNeighbors m coord =
|
|||
M.fromList
|
||||
[ (u + coord, M.findWithDefault '#' (u + coord) m)
|
||||
| u <- unitVecs
|
||||
, M.findWithDefault '#' (u + coord) m /= '#'
|
||||
, let c = M.findWithDefault '#' (u + coord) m in c `elem` ".@⌂" || isLower c
|
||||
]
|
||||
|
||||
getNeighborsMap :: DungeonMap -> DungeonMap -> DungeonMap
|
||||
getNeighborsMap m n = M.unions [getNeighbors m x | (x, _) <- M.toList n]
|
||||
|
||||
distanceFromTo :: DungeonMap -> Char -> Char -> Int
|
||||
distanceFromTo dmap schar echar =
|
||||
distanceFromTo' dmap (M.singleton spos schar) spos epos 1
|
||||
distanceFromTo :: DungeonMap -> Char -> Char -> Distance
|
||||
distanceFromTo dMap schar echar =
|
||||
distanceFromTo' dMap (M.singleton spos schar) spos epos 1
|
||||
where
|
||||
spos = findPos schar dmap
|
||||
epos = findPos echar dmap
|
||||
distanceFromTo' mMap nMap start end n =
|
||||
if M.member end newNMap
|
||||
then n
|
||||
else distanceFromTo' mMap newNMap start end (n + 1)
|
||||
spos = findPos schar dMap
|
||||
epos = findPos echar dMap
|
||||
distanceFromTo' mMap nMap start end n
|
||||
| M.member end newNMap = Reachable n
|
||||
| newNMap == nMap = Unreachable
|
||||
| otherwise = distanceFromTo' mMap newNMap start end (n + 1)
|
||||
where
|
||||
newNMap = M.union nMap (getNeighborsMap mMap nMap)
|
||||
--todo: maek tail recursive
|
||||
|
||||
findPos :: Char -> DungeonMap -> V2 Int
|
||||
findPos c = head . M.keys . M.filter (`elem` [c])
|
||||
|
||||
-- tracePath :: DungeonMap -> Char -> String -> Maybe Int
|
||||
-- tracePath dMap _ [] = Just 0
|
||||
-- tracePath dMap c (x:xs) = case distanceFromTo dMap c x of
|
||||
-- Nothing -> Nothing
|
||||
-- Just y -> let trace = tracePath dMap c xs in if isJust trace then Just (y + fromJust trace) else Nothing
|
||||
tls1 :: DungeonMap -> S.Set Char -> Char -> Distance
|
||||
tls1 dMap nodeSet goal
|
||||
| S.size nodeSet == 1 = (distanceFromTo dMap '@' (head $ S.toList nodeSet))
|
||||
-- ^ S = {c}, different 1 element sets possible?
|
||||
| otherwise =
|
||||
minimum
|
||||
[tls1 dMap sMinusC x + distanceFromTo newDMap x goal | x <- S.toList sMinusC]
|
||||
where
|
||||
sMinusC = traceShowId (S.delete goal nodeSet)
|
||||
newDMap = traceShowId (M.insert door '⌂' dMap)
|
||||
door = traceShowId (findPos (toUpper (traceShowId goal)) dMap)
|
||||
-- tls2 = undefined
|
||||
|
|
Loading…
Reference in New Issue