advent03/src/advent03.hs

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