adventofcode1601/app/Main.hs

   1 module Main(main) where
   2
   3 import Data.List (sort)
   4 import Data.List.Split (splitOn)
   5
   6 -- turn direction, number of steps
   7 data Step = Step Char Int deriving (Show)
   8
   9 data Direction = North | East | South | West
  10     deriving (Enum, Show, Bounded, Eq)
  11
  12 -- direction, easting, northing
  13 data Position = Position Direction Int Int deriving (Show)
  14 -- Two positions are the same if they're in the same place,
  15 -- regardless of facing
  16 instance Eq Position where
  17     Position _ e n == Position _ e' n' = e == e' && n == n'
  18
  19 main :: IO ()
  20 main = do
  21         instructions <- readFile "data/advent01.txt"
  22         part1 instructions
  23         part2 instructions
  24
  25 part1 :: String -> IO ()
  26 part1 instructions = do
  27         let answer = finalDistance $ last $ stepsFromStart $ steps instructions
  28         print answer
  29
  30 part2 :: String -> IO ()
  31 part2 instructions = do
  32         let visited = finalDistance $ firstRepeat $ stepsFromStart $ expandSteps $ steps instructions
  33         print visited
  34
  35
  36 -- Extract the steps from the input string.
  37 steps :: String -> [Step]
  38 steps s = map readStep $ splitOn ", " s
  39     where readStep (d:l) = Step d (read l)
  40
  41 -- Take steps from the starting position
  42 stepsFromStart :: [Step] -> [Position]
  43 stepsFromStart = takeSteps (Position North 0 0)
  44
  45 -- Calculate manhattan distance from start to this state
  46 finalDistance :: Position -> Int
  47 finalDistance (Position _ e n) = (abs e) + (abs n)
  48
  49 -- For part 2: convert one step of many spaces to many steps of one space each
  50 expandSteps :: [Step] -> [Step]
  51 expandSteps =
  52     concatMap expandStep
  53     where expandStep (Step dir d) = (Step dir 1) : replicate (d - 1) (Step 'S' 1)
  54
  55 -- Execute a series of steps, keeping track of the positions after each step
  56 takeSteps :: Position -> [Step] -> [Position]
  57 -- takeSteps pos steps = scanl move pos steps
  58 takeSteps = scanl move
  59
  60 -- Make one move, by updating direction then position
  61 move :: Position -> Step -> Position
  62 move (Position facing easting northing)
  63     (Step turnInstr distance) =
  64     Position facing' easting' northing'
  65     where facing' = turn turnInstr facing
  66           (easting', northing') = takeStep facing' distance easting northing
  67
  68 -- Turn right, left, or straight
  69 turn :: Char -> Direction -> Direction
  70 turn 'R' direction = turnCW direction
  71 turn 'L' direction = turnACW direction
  72 turn 'S' direction = direction
  73
  74 -- Move in the current direction
  75 takeStep :: Direction -> Int -> Int -> Int -> (Int, Int)
  76 takeStep North d e n = (e, n+d)
  77 takeStep South d e n = (e, n-d)
  78 takeStep West  d e n = (e-d, n)
  79 takeStep East  d e n = (e+d, n)
  80
  81
  82 -- | a `succ` that wraps
  83 turnCW :: (Bounded a, Enum a, Eq a) => a -> a
  84 turnCW dir | dir == maxBound = minBound
  85          | otherwise = succ dir
  86
  87 -- | a `pred` that wraps
  88 turnACW :: (Bounded a, Enum a, Eq a) => a -> a
  89 turnACW dir | dir == minBound = maxBound
  90             | otherwise = pred dir
  91
  92 -- All the prefixes of a list of items
  93 prefixes = scanl addTerm []
  94     where addTerm ps t = ps ++ [t]
  95
  96 -- The first item that exists in a prefix of the list to that point
  97 firstRepeat positions =
  98     last $ head $ dropWhile (\p -> (last p) `notElem` (tail $ reverse p))
  99                             (tail $ prefixes positions)