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