advent17/src/advent17.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 qualified Data.Set as S
  11 -- import Data.Char
  12 import Data.List
  13
  14 type Position = (Integer, Integer) -- x, y
  15 type Boundary = [Position]
  16 data Direction = North | East | South | West deriving (Show, Eq, Ord)
  17 data ReturnValue = Static | Moved | Goal deriving (Show, Eq, Ord)
  18
  19 data Droid = Droid
  20     { _machine :: Machine
  21     , _executionState :: ExecutionState
  22     , _currentInput :: [Integer]
  23     , _machineOutput :: [Integer]
  24     } deriving (Eq)
  25
  26 instance Show Droid where
  27   show d = "Droid {<m>, _executionState = " ++ show (_executionState d) ++
  28            ", _currentInput = " ++ show (_currentInput d) ++
  29            ", _machineOutput = " ++ show (_machineOutput d) ++
  30            " }"
  31
  32 type Scaffold = S.Set Position
  33
  34 data ScaffoldBuilder = ScaffoldBuilder { _scaffold :: Scaffold
  35                      , _r :: Integer
  36                      , _c :: Integer
  37                      , _droidPos :: Position
  38                      , _droidDirection :: Direction
  39                      } deriving (Show, Eq)
  40
  41
  42 main :: IO ()
  43 main = do
  44         text <- TIO.readFile "data/advent17.txt"
  45         let mem = parseMachineMemory text
  46         -- print mem
  47         let sb = buildScaffold mem
  48         print $ part1 sb
  49         -- print $ part2 mem
  50
  51
  52 part1 sb = S.foldl (+) 0 $ S.map alignmentParam intersections
  53     where scaffold = _scaffold sb
  54           intersections = S.filter (isIntersection scaffold) scaffold
  55
  56
  57 buildScaffold mem = foldl' addGridChar emptyScaffoldBuilder output
  58     where (_, _, output) = runProgram [] mem
  59           emptyScaffoldBuilder = ScaffoldBuilder {_scaffold = S.empty, _r = 0, _c = 0,
  60                     _droidPos = (0, 0), _droidDirection = North }
  61
  62
  63 addGridChar sb 10  = sb { _r = _r sb + 1, _c = 0 }
  64 addGridChar sb 46  = sb { _c = _c sb + 1 }
  65 addGridChar sb 35  = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
  66                             _c = _c sb + 1 }
  67 addGridChar sb 94  = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
  68                             _c = _c sb + 1,
  69                             _droidPos = (_r sb, _c sb), _droidDirection = North }
  70 addGridChar sb 118 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
  71                             _c = _c sb + 1,
  72                             _droidPos = (_r sb, _c sb), _droidDirection = South }
  73 addGridChar sb 60  = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
  74                             _c = _c sb + 1,
  75                             _droidPos = (_r sb, _c sb), _droidDirection = West }
  76 addGridChar sb 61  = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
  77                             _c = _c sb + 1,
  78                             _droidPos = (_r sb, _c sb), _droidDirection = East }
  79
  80
  81 isIntersection :: Scaffold -> Position -> Bool
  82 isIntersection scaffold (r, c) = neighbours `S.isSubsetOf` scaffold
  83     where  neighbours = [(r - 1, c), (r + 1, c), (r, c - 1), (r, c + 1)]
  84
  85 alignmentParam :: Position -> Integer
  86 alignmentParam (r, c) = r * c
  87
  88
  89 -- runDroid :: Droid -> Direction -> (Droid, ReturnValue)
  90 -- runDroid droid direction = (droid', found)
  91 --     where   ci = _currentInput droid
  92 --             droid' = runDroidMachine (droid {_currentInput = ci ++ [commandOf direction]})
  93 --             found = returnValue $ last $ _machineOutput droid'
  94
  95
  96 -- runDroidMachine :: Droid -> Droid
  97 -- runDroidMachine d = d { _machine = machine'
  98 --                       , _executionState = halted
  99 --                       , _machineOutput = output
 100 --                       }
 101 --     where   machine = _machine d
 102 --             input = _currentInput d
 103 --             (halted, machine', output) = runMachine input machine
 104
 105
 106 showHull :: Hull -> String
 107 showHull screen = unlines rows
 108     where   minX = minimum $ map fst $ M.keys screen
 109             minY = minimum $ map snd $ M.keys screen
 110             maxX = maximum $ map fst $ M.keys screen
 111             maxY = maximum $ map snd $ M.keys screen
 112             rows = [showHullRow screen minX maxX y | y <- [minY..maxY]]
 113
 114 showHullRow :: Hull -> Integer -> Integer -> Integer -> String
 115 showHullRow screen minX maxX y = [showHullCell screen x y | x <- [minX..maxX]]
 116
 117 showHullCell :: Hull -> Integer -> Integer -> Char
 118 showHullCell screen x y =
 119     case (M.findWithDefault Unknown (x, y) screen) of
 120         Empty _ _ True -> 'O'
 121         Empty _ _ _ -> '.'
 122         Wall -> '\x2588'
 123         Unknown -> ' '