src/task1/task1-mpc.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List (foldl')        -- import the strict fold
   4
   5 import Data.Text (Text)
   6 -- import qualified Data.Text as T
   7 import qualified Data.Text.IO as TIO
   8
   9 import Data.Void (Void)
  10
  11 import Text.Megaparsec -- hiding (State)
  12 import Text.Megaparsec.Char
  13 import qualified Text.Megaparsec.Char.Lexer as L
  14 import qualified Control.Applicative as CA
  15
  16
  17 -- number of steps
  18 type Distance = Int
  19
  20 -- easting, northing
  21 type Position = (Int, Int)
  22
  23 -- the directions. See below for functions for turning
  24 data Direction = North | East | South | West
  25     deriving (Enum, Show, Bounded, Eq)
  26
  27 -- The currenct state of a Mowmaster
  28 data Mowmaster = Mowmaster { direction :: Direction
  29                            , position :: Position
  30                            } deriving (Show, Eq)
  31
  32 -- one instruction for the mowmaster
  33 data Instruction =   Forward Distance
  34                    | Clockwise
  35                    | Anticlockwise
  36                    | Comment String
  37     deriving (Show, Eq)
  38
  39
  40 main :: IO ()
  41 main = do
  42         instruction_text <- TIO.readFile "data/01-mowmaster.txt"
  43         let instructions = successfulParse instruction_text
  44         print $ part1 instructions
  45         print $ part2 instructions
  46
  47 part1 :: [Instruction] -> Int
  48 part1 = length
  49
  50 part2 :: [Instruction] -> Int
  51 part2 instructions = finalDistance $ executeAll instructions
  52     where executeAll = foldl' execute initialMowmaster
  53
  54 initialMowmaster = Mowmaster North (0, 0)
  55
  56
  57 -- Calculate manhattan distance from start to this state
  58 finalDistance :: Mowmaster -> Int
  59 finalDistance m = (abs e) + (abs n)
  60     where (e, n) = position m
  61
  62
  63 -- Make one move
  64 execute :: Mowmaster -> Instruction -> Mowmaster
  65 execute m (Forward s)    = m {position  = forward s (direction m) (position m)}
  66 execute m  Clockwise     = m {direction = turnCW (direction m)}
  67 execute m  Anticlockwise = m {direction = turnACW (direction m)}
  68 execute m  _ = m
  69
  70 -- Move in the current direction
  71 forward :: Int -> Direction -> Position -> Position
  72 forward s North (e, n) = (e, n+s)
  73 forward s South (e, n) = (e, n-s)
  74 forward s West  (e, n) = (e-s, n)
  75 forward s East  (e, n) = (e+s, n)
  76
  77
  78 -- | a `succ` that wraps
  79 turnCW :: (Bounded a, Enum a, Eq a) => a -> a
  80 turnCW dir | dir == maxBound = minBound
  81            | otherwise       = succ dir
  82
  83 -- | a `pred` that wraps
  84 turnACW :: (Bounded a, Enum a, Eq a) => a -> a
  85 turnACW dir | dir == minBound = maxBound
  86             | otherwise       = pred dir
  87
  88
  89 -- Parse the input file
  90
  91 type Parser = Parsec Void Text
  92
  93 -- treat comment lines as whitespace
  94 sc :: Parser ()
  95 sc = L.space space1 lineComment CA.empty
  96     where lineComment = L.skipLineComment "#"
  97
  98 lexeme  = L.lexeme sc
  99 integer = lexeme L.decimal
 100 symb = L.symbol sc
 101
 102 -- instructions is some optional space followed by many instructions
 103 instrsP = optional sc *> many instrP
 104
 105 -- an instruction is either F, C, or A
 106 instrP = forwardP <|> cwP <|> acwP
 107
 108 -- parse each instruction
 109 forwardP = Forward <$> (symb "F" *> integer)
 110 cwP = Clockwise <$ symb "C"
 111 acwP = Anticlockwise <$ symb "A"
 112
 113 successfulParse :: Text -> [Instruction]
 114 successfulParse input =
 115         case parse instrsP "input" input of
 116                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 117                 Right instrs  -> instrs