advent03/src/advent03.hs

   1 import Data.Text (Text)
   2 import qualified Data.Text.IO as TIO
   3
   4 import Data.Void (Void)
   5
   6 import Text.Megaparsec hiding (State)
   7 import Text.Megaparsec.Char
   8 import qualified Text.Megaparsec.Char.Lexer as L
   9 import qualified Control.Applicative as CA
  10
  11 import Data.List (foldl')
  12 import qualified Data.Set as S
  13 import qualified Data.Map as M
  14 import Data.Map ((!))
  15
  16 import Linear (V2(..), (^+^), (^-^), (*^), (*^))
  17
  18 data Direction = East | South | West | North deriving (Show, Eq)
  19
  20 type Location = V2 Int -- x, y
  21
  22 type Visited = S.Set Location
  23
  24 type TrackedVisited = M.Map Location Int
  25
  26 data Path = Path { _visited :: TrackedVisited
  27                  , _tip :: Location
  28                  , _currentLength :: Int
  29                  }
  30                deriving (Show, Eq)
  31
  32 data Segment = Segment { _direction :: Direction
  33                        , _steps :: Int
  34                        } deriving (Show, Eq)
  35
  36
  37 main :: IO ()
  38 main = do
  39         text <- TIO.readFile "data/advent03.txt"
  40         let segmentss = successfulParse text
  41         let paths = travelAllPaths segmentss
  42         -- print $ travelPath $ head segmentss
  43         print $ part1 paths
  44         print $ part2 paths
  45
  46 part1 :: [Path] -> Int
  47 part1 paths = closest $ crossovers paths
  48
  49 part2 :: [Path] -> Int
  50 part2 paths = shortestPaths paths $ crossovers paths
  51
  52
  53 closest :: Visited -> Int
  54 closest points = S.findMin $ S.map manhattan points
  55
  56
  57 shortestPaths :: [Path] -> Visited -> Int
  58 shortestPaths paths crossings = minimum $ S.map crossingPathLengths crossings
  59     where crossingPathLengths crossing = sum $ map (\p -> (_visited p)!crossing) paths
  60
  61
  62 crossovers :: [Path] -> Visited
  63 crossovers travelledPaths =
  64       foldl' S.intersection
  65              (M.keysSet $ _visited $ head travelledPaths)
  66              (map (M.keysSet . _visited) $ drop 1 travelledPaths)
  67
  68 travelAllPaths :: [[Segment]] -> [Path]
  69 travelAllPaths = map travelPath
  70
  71 travelPath :: [Segment] -> Path
  72 travelPath segments = foldl' travelSegment path0 segments
  73     where   path0 = Path { _visited = M.empty, _tip = V2 0 0, _currentLength = 0 }
  74
  75 travelSegment :: Path -> Segment -> Path
  76 travelSegment path segment = path { _tip = tip', _visited = visited', _currentLength = len'}
  77     where   delta = facing $ _direction segment
  78             distance = _steps segment
  79             start = _tip path
  80             len = _currentLength path
  81             len' = len + distance
  82             visited = _visited path
  83             visited' = foldl' insertStep visited $ take distance $ drop 1 $ zip [len, (len + 1) ..] $ iterate (^+^ delta) start
  84             tip' = start ^+^ distance *^ delta
  85             insertStep visits (dist, loc) = if loc `M.member` visits
  86                                             then visits
  87                                             else M.insert loc dist visits
  88
  89 facing :: Direction -> Location
  90 facing East = V2 1 0
  91 facing South = V2 0 (-1)
  92 facing West = V2 (-1) 0
  93 facing North = V2 0 1
  94
  95
  96 manhattan (V2 x y) = (abs x) + (abs y)
  97
  98 -- Parse the input file
  99 type Parser = Parsec Void Text
 100
 101 sc :: Parser ()
 102 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 103 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 104
 105 lexeme  = L.lexeme sc
 106 integer = lexeme L.decimal
 107 -- signedInteger = L.signed sc integer
 108 symb = L.symbol sc
 109 comma = symb ","
 110
 111 wiresP = some pathP
 112 pathP = segmentP `sepBy1` comma
 113
 114 segmentP = segmentify <$> directionP <*> integer
 115     where segmentify direction steps =
 116               Segment { _direction = direction, _steps = steps }
 117
 118
 119 directionP = eP <|> sP <|> wP <|> nP
 120 eP = (symb "R" *> pure East)
 121 sP = (symb "D" *> pure South)
 122 wP = (symb "L" *> pure West)
 123 nP = (symb "U" *> pure North)
 124
 125
 126 successfulParse :: Text -> [[Segment]]
 127 successfulParse input =
 128         case parse wiresP "input" input of
 129                 Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 130                 Right wires -> wires