src/advent19/advent19.hs

   1 {-# LANGUAGE NegativeLiterals #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5
   6 import Prelude hiding (Left, Right)
   7 import Data.List
   8 import Data.Char
   9
  10 type Maze = [String]
  11 type Position = (Int, Int)
  12
  13
  14 data Direction = Up | Down | Left | Right deriving (Show, Eq)
  15
  16 data Progress = Progress { position :: Position
  17                          , direction :: Direction
  18                          , letters :: String
  19                          , stepCount :: Int
  20                          } deriving (Show, Eq)
  21
  22
  23 -- Note: assumes the maze comes with a padding border of spaces
  24 -- all around it. Makes the "next location" checking much easier!
  25
  26 main :: IO ()
  27 main = do
  28         text <- readFile "data/advent19.txt"
  29         let maze = lines text
  30         let progress = navigate maze
  31         print $ letters progress
  32         print $ stepCount progress
  33
  34
  35 startProgress :: Maze -> Progress
  36 startProgress maze = Progress { position = (0, startCol)
  37                               , direction = Down
  38                               , letters = "", stepCount = 0}
  39     where startCol = head $ elemIndices '|' (maze!!0)
  40
  41 (!:) :: Maze -> Position -> Char
  42 (!:) m (r, c) = (m!!r)!!c
  43
  44 (+:) :: Position -> Position -> Position
  45 (+:) (r, c) (dr, dc) = (r + dr, c + dc)
  46
  47
  48 delta :: Direction -> (Int, Int)
  49 delta Up    = (-1,  0)
  50 delta Down  = ( 1,  0)
  51 delta Left  = ( 0, -1)
  52 delta Right = ( 0,  1)
  53
  54 isJunction :: Char -> Bool
  55 isJunction '+' = True
  56 isJunction  _  = False
  57
  58 isFinished :: Maze -> Progress -> Bool
  59 isFinished maze progress = isSpace $ maze!:(position progress)
  60
  61 -- location :: Maze -> Int -> Int -> Char
  62 -- location maze r c = (maze!!r)!!c
  63
  64
  65 navigate :: Maze -> Progress
  66 navigate maze = navigate' maze progress
  67     where progress = startProgress maze
  68
  69 navigate' :: Maze -> Progress -> Progress
  70 navigate' maze progress =
  71     if isFinished maze progress
  72         then progress
  73         else navigate' maze (step maze progress)
  74
  75
  76 step :: Maze -> Progress -> Progress
  77 step maze progress = progress {position = p', direction = d', letters = l', stepCount = sc'}
  78     where p = position progress
  79           thisChar = maze!:p
  80           l' = if isAlpha thisChar then (letters progress) ++ [thisChar] else letters progress
  81           d' = if isJunction thisChar then newDirection maze progress else direction progress
  82           p' = p +: delta d'
  83           sc' = stepCount progress + 1
  84
  85 newDirection :: Maze -> Progress -> Direction
  86 newDirection maze progress =
  87     if d == Up || d == Down
  88     then if isSpace leftChar then Right else Left
  89     else if isSpace upChar then Down else Up
  90     where d = direction progress
  91           p = position progress
  92           upChar = maze!:(p +: (delta Up))
  93           leftChar = maze!:(p +: (delta Left))