AoC/2019/day18/day18.hs

{-# LANGUAGE LambdaCase #-}
module Main where

import Data.List
import Data.List.Split
import Data.List.Utils
import qualified Data.Map.Strict as M
import Data.Maybe
import Helpers
import Linear.V2

type DungeonMap = M.Map (V2 Int) Char

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'

updateScreenBuffer :: DungeonMap -> (Int, Int) -> String -> DungeonMap
updateScreenBuffer buf _ [] = buf
updateScreenBuffer buf (x, y) (a:as) = updateScreenBuffer bufNew coord as
  where
    bufNew =
      if a /= '\n'
        then M.insert (V2 x y) a buf
        else buf
    coord =
      if a /= '\n'
        then (x + 1, y)
        else (0, y + 1)

getNeighbors :: DungeonMap -> V2 Int -> DungeonMap
getNeighbors m coord =
  M.fromList
    [ (u + coord, M.findWithDefault '#' (u + coord) m)
    | u <- unitVecs
    , M.findWithDefault '#' (u + coord) m /= '#'
    ]

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
  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)
      where
        newNMap = M.union nMap (getNeighborsMap mMap nMap)

findPos :: Char -> DungeonMap -> V2 Int
findPos c = head . M.keys . M.filter (`elem` [c])

-- countBlocks :: ScreenBuffer -> String
-- countBlocks = show . length . M.filter (== 2)
-- getIntersections :: ScreenBuffer -> ScreenBuffer
-- getIntersections buf = M.filterWithKey f buf
--   where
--     f k v = v == 35 && and [buf M.!? (k + u) == Just 35 | u <- unitVecs]
--
-- getTurns :: ScreenBuffer -> ScreenBuffer
-- getTurns buf = M.filterWithKey f buf M.\\ getIntersections buf
--   where
--     f k v =
--       v == 35 &&
--       or
--         [ buf M.!? (k + u) == Just 35 && buf M.!? (k + perp u) == Just 35
--         | u <- unitVecs
--         ]
-- countIntAlign :: ScreenBuffer -> String
-- countIntAlign m = show $ sum [x * y | (V2 x y, _) <- M.toList m]
toRelPath :: [V2 Int] -> [V2 Int]
toRelPath path = zipWith (-) (tail path) path

toCMD :: V2 Int -> [V2 Int] -> [String]
toCMD _ [] = []
toCMD u (x:xs)
  | crossZ u x < 0 = ("R" ++ (show . abs . sum) x) : toCMD (perp u) xs
  | crossZ u x >= 0 = ("L" ++ (show . abs . sum) x) : toCMD (perp (u * (-1))) xs

-- getCMD :: ScreenBuffer -> [String]
-- getCMD buf = toCMD dir (toRelPath path)
--   where
--     (pos, dir) = roboPos buf
--     path = pos : getPath buf [] [pos]
-- getPath :: ScreenBuffer -> [V2 Int] -> [V2 Int] -> [V2 Int]
-- getPath _ acc [] = acc
-- getPath m acc currs =
--   let a = nextTurn \\ acc
--    in getPath m (acc ++ a) a
--   where
--     curr = head currs
--     candidates =
--       M.filterWithKey
--         (\k _ -> v2x (k - curr) == 0 || v2y (k - curr) == 0)
--         (getTurns m)
--     isConnected =
--       M.filterWithKey
--         (\k _ ->
--            and
--              [ m M.!? x `elem` [Just 35, Just 94]
--              | x <- map (+ curr) $ drawLine (k - curr)
--              ])
--     nextTurn =
--       map fst $
--       M.toList $ M.filterWithKey (\k _ -> M.member k m) $ isConnected candidates
--nur keys^ im lambda