advent11/src/advent11.hs

   1 import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6
   7 import qualified Data.Map.Strict as M
   8 -- import Data.Map.Strict ((!))
   9 -- import Data.List
  10 -- import Data.Function (on)
  11
  12 type Position = (Int, Int) -- x, y
  13 data Colour = Black | White deriving (Show, Eq, Ord)
  14 data Direction = North | East | South | West deriving (Show, Eq, Ord, Enum, Bounded)
  15
  16 data Ant = Ant
  17     { _machine :: Machine
  18     , _executionState :: ExecutionState
  19     , _currentInput :: [Integer]
  20     , _machineOutput :: [Integer]
  21     , _currentPosition :: Position
  22     , _currentDirection :: Direction
  23     } deriving (Show, Eq)
  24
  25 type Hull = M.Map Position Colour
  26
  27
  28 main :: IO ()
  29 main = do
  30         text <- TIO.readFile "data/advent11.txt"
  31         let mem = parseMachineMemory text
  32         -- print mem
  33         print $ part1 mem
  34         putStrLn $ part2 mem
  35
  36
  37 part1 mem = M.size hull
  38     where ant = encapsulate mem []
  39           hull = runAnt ant M.empty
  40
  41 part2 mem = showHull hull
  42     where ant = encapsulate mem []
  43           hull = runAnt ant (M.singleton (0, 0) White)
  44
  45 encapsulate :: [Integer] -> [Integer] -> Ant
  46 encapsulate mem input = Ant
  47     { _machine = makeMachine mem
  48     , _executionState = Runnable
  49     , _machineOutput = []
  50     , _currentInput = input
  51     , _currentPosition = (0, 0)
  52     , _currentDirection = North
  53     }
  54
  55
  56 runAnt :: Ant -> Hull -> Hull
  57 -- runAnt ant hull | trace (show ant ++ " -> " ++ (show (runAntStep ant)) ++ " -- " ++ show hull) False = undefined
  58 runAnt ant hull = hull''
  59     where ant' = runAntStep ant
  60           output = _machineOutput ant'
  61           hull' = if (null output) then hull else paint hull ant' (output!!0)
  62           ant'' = if (null output) then ant' else move ant' (output!!1)
  63           ant''' = camera ant'' hull
  64           hull'' =  if (_executionState ant' == Terminated)
  65                     then hull'
  66                     else runAnt ant''' hull'
  67
  68
  69 paint :: Hull -> Ant -> Integer -> Hull
  70 paint hull ant 0 = M.insert (_currentPosition ant) Black hull
  71 paint hull ant 1 = M.insert (_currentPosition ant) White hull
  72
  73 move :: Ant -> Integer -> Ant
  74 move ant angle = ant { _currentDirection = direction', _currentPosition = position' }
  75     where direction' = turn (_currentDirection ant) angle
  76           delta = directionDelta direction'
  77           position' = sumPos delta $ _currentPosition ant
  78
  79 camera :: Ant -> Hull -> Ant
  80 camera ant hull = ant { _currentInput = input' }
  81     where colour = M.findWithDefault Black (_currentPosition ant) hull
  82           input = _currentInput ant
  83           input' = input ++ [colourNum colour]
  84
  85 colourNum :: Colour -> Integer
  86 colourNum Black = 0
  87 colourNum White = 1
  88
  89 turn :: Direction -> Integer -> Direction
  90 turn direction 0 = predW direction
  91 turn direction 1 = succW direction
  92
  93 directionDelta :: Direction -> Position
  94 directionDelta North = ( 0 ,  1)
  95 directionDelta East  = ( 1 ,  0)
  96 directionDelta South = ( 0 , -1)
  97 directionDelta West  = (-1 ,  0)
  98
  99 sumPos :: Position -> Position -> Position
 100 sumPos (a, b) (c, d) = (a + c, b + d)
 101
 102
 103 runAntStep :: Ant -> Ant
 104 runAntStep a = a { _machine = machine'
 105                  , _executionState = halted
 106                  , _machineOutput = output
 107                  }
 108     where   machine = _machine a
 109             input = _currentInput a
 110             (halted, machine', output) = runMachine input machine
 111
 112
 113 showHull :: Hull -> String
 114 showHull hull = unlines rows
 115     where   minX = minimum $ map fst $ M.keys hull
 116             minY = minimum $ map snd $ M.keys hull
 117             maxX = maximum $ map fst $ M.keys hull
 118             maxY = maximum $ map snd $ M.keys hull
 119             rows = [showHullRow hull minX maxX y | y <- reverse [minY..maxY]]
 120
 121 showHullRow :: Hull -> Int -> Int -> Int -> String
 122 showHullRow hull minX maxX y = [showHullCell hull x y | x <- [minX..maxX]]
 123
 124 showHullCell :: Hull -> Int -> Int -> Char
 125 showHullCell hull x y
 126     | colour == White = '\x2588'
 127     | colour == Black = ' '
 128     where colour = M.findWithDefault Black (x, y) hull
 129
 130
 131 -- | a `succ` that wraps
 132 succW :: (Bounded a, Enum a, Eq a) => a -> a
 133 succW dir | dir == maxBound = minBound
 134           | otherwise = succ dir
 135
 136 -- | a `pred` that wraps
 137 predW :: (Bounded a, Enum a, Eq a) => a -> a
 138 predW dir | dir == minBound = maxBound
 139           | otherwise = pred dir
 140