Day 13 Part 1 + game print
This commit is contained in:
shu
parent
3cf5c0179d
commit
e6280785b3
|
|
@ -0,0 +1,40 @@
|
|||
module Helpers
|
||||
( v2x
|
||||
, v2y
|
||||
, drawMap
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
import Data.List.Split
|
||||
import qualified Data.Map as M
|
||||
import Linear.V2
|
||||
|
||||
v2x :: V2 a -> a
|
||||
v2x (V2 x _) = x
|
||||
|
||||
v2y :: V2 a -> a
|
||||
v2y (V2 _ y) = y
|
||||
|
||||
getBounds :: M.Map (V2 Int) Integer -> (Int, Int, Int, Int)
|
||||
getBounds m = (getMinX, getMinY, getMaxX, getMaxY)
|
||||
where
|
||||
getMaxX = getFromMap maximum v2x
|
||||
getMaxY = getFromMap maximum v2y
|
||||
getMinX = getFromMap minimum v2x
|
||||
getMinY = getFromMap minimum v2y
|
||||
f f1 f2 k a result = f1 [f2 k, result]
|
||||
getFromMap f1 f2 = M.foldrWithKey (f f1 f2) 0 m
|
||||
|
||||
drawMap :: M.Map Integer Char -> M.Map (V2 Int) Integer -> String
|
||||
drawMap dict m =
|
||||
intercalate "\n" $
|
||||
transpose $
|
||||
chunksOf
|
||||
(abs (abs y1 - abs y2) + 1)
|
||||
[ let c = M.findWithDefault (-99) (V2 x y) m
|
||||
in M.findWithDefault ' ' c dict
|
||||
| x <- [x1 .. x2]
|
||||
, y <- [y1 .. y2]
|
||||
]
|
||||
where
|
||||
(x1, y1, x2, y2) = getBounds m
|
||||
|
|
@ -0,0 +1,151 @@
|
|||
module Intcode
|
||||
( TuringMachine(TM, tape, pointer, pointerOffset, output, input,
|
||||
state)
|
||||
, step
|
||||
, tapePreprocess
|
||||
, TMOutState(Continue, AwaitInput, Halt)
|
||||
, execSteps
|
||||
) where
|
||||
|
||||
import Control.DeepSeq as DeepSeq
|
||||
import Data.Char
|
||||
import Data.List as L
|
||||
import Data.Maybe
|
||||
import Data.Vector as V hiding
|
||||
( (++)
|
||||
, concatMap
|
||||
, elem
|
||||
, head
|
||||
, last
|
||||
, length
|
||||
, map
|
||||
, reverse
|
||||
, splitAt
|
||||
)
|
||||
import qualified Data.Vector as V ((++), last)
|
||||
|
||||
data TMOutState
|
||||
= Continue
|
||||
| AwaitInput
|
||||
| Halt
|
||||
deriving (Enum, Eq, Show)
|
||||
|
||||
data Mode
|
||||
= Position
|
||||
| Immediate
|
||||
| Relative
|
||||
deriving (Enum, Eq, Show)
|
||||
|
||||
data TuringMachine =
|
||||
TM
|
||||
{ tape :: Vector Integer
|
||||
, pointer :: Integer
|
||||
, pointerOffset :: Integer
|
||||
, output :: [Integer]
|
||||
, input :: Maybe Integer
|
||||
, state :: TMOutState
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
tapePreprocess :: Vector Integer -> (Int,Integer) -> Vector Integer
|
||||
tapePreprocess t (target,repl) = flip (//) [(target, repl)] $ (V.++) t $ V.replicate 500 0
|
||||
|
||||
opLength :: Integer -> Integer
|
||||
opLength x
|
||||
| n `elem` "1278" = 4
|
||||
| n `elem` "56" = 3
|
||||
| n `elem` "349" = 2
|
||||
| otherwise = 1
|
||||
where
|
||||
n = last $ show x
|
||||
|
||||
parseModes :: String -> [Mode]
|
||||
parseModes m = L.replicate (3 - length l) Position ++ l
|
||||
where
|
||||
l = map (toEnum . digitToInt) m
|
||||
|
||||
paramChange ::
|
||||
[Mode] -> Integer -> Vector Integer -> Vector Integer -> Vector Integer
|
||||
paramChange m rbase opvec t = imap f (V.tail opvec)
|
||||
where
|
||||
f i a =
|
||||
case m !! i of
|
||||
Immediate -> a
|
||||
Position -> t ! fromInteger a
|
||||
Relative -> t ! fromInteger (a + rbase)
|
||||
|
||||
getOpModes :: Vector Integer -> (String, [Mode])
|
||||
getOpModes opvec = (op_dedup, parsed_modes)
|
||||
where
|
||||
(op, modes) = splitAt 2 $ reverse $ show $ opvec ! 0
|
||||
parsed_modes = reverse $ parseModes $ reverse modes
|
||||
op_dedup =
|
||||
if last op == '0'
|
||||
then [head op]
|
||||
else op
|
||||
|
||||
step :: TuringMachine -> TuringMachine
|
||||
step tm =
|
||||
case op of
|
||||
"1" -> tmBinop (+)
|
||||
"2" -> tmBinop (*)
|
||||
"3" -> if isJust (input tm) then (getNewTM (fromJust $ input tm)){input = Nothing} else tm {state = AwaitInput}
|
||||
"4" -> tmn {output = V.last params : output tm}
|
||||
"5" ->
|
||||
tm
|
||||
{ pointer =
|
||||
if params ! 0 /= 0
|
||||
then params ! 1
|
||||
else pNew
|
||||
}
|
||||
"6" ->
|
||||
tm
|
||||
{ pointer =
|
||||
if params ! 0 == 0
|
||||
then params ! 1
|
||||
else pNew
|
||||
}
|
||||
"7" ->
|
||||
tmBinop
|
||||
(\x y ->
|
||||
if x < y
|
||||
then 1
|
||||
else 0)
|
||||
"8" ->
|
||||
tmBinop
|
||||
(\x y ->
|
||||
if x == y
|
||||
then 1
|
||||
else 0)
|
||||
"9" -> tmn {pointerOffset = pointerOffset tm + (params ! 0)}
|
||||
"99" -> tm {state = Halt}
|
||||
_ -> error "Illegal Opcode."
|
||||
where
|
||||
pNew = pointer tm + opLength (tape tm ! fromInteger (pointer tm))
|
||||
tmn = tm {pointer = pNew}
|
||||
opvec =
|
||||
slice
|
||||
(fromInteger (pointer tm))
|
||||
(fromInteger (pNew - pointer tm))
|
||||
(tape tm)
|
||||
(op, m) = getOpModes opvec
|
||||
params = paramChange m (pointerOffset tm) opvec (tape tm)
|
||||
tmBinop x = getNewTM ((params ! 0) `x` (params ! 1))
|
||||
{-without the following DeepSeq call, thunks build up eternally and
|
||||
the vectors won’t be garbage collected: >4GB RAM usage, god knows
|
||||
how much with larger tapes (my laptop crashed), now it’s a cozy ~20mB-}
|
||||
getNewTM x =
|
||||
tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue}
|
||||
target =
|
||||
fromInteger $
|
||||
case m !! (length params - 1) of
|
||||
Relative -> V.last opvec + pointerOffset tm
|
||||
_ -> V.last opvec
|
||||
|
||||
execSteps :: TuringMachine -> TuringMachine
|
||||
execSteps tm =
|
||||
case state tmNew of
|
||||
Continue -> execSteps tmNew
|
||||
_ -> tmNew
|
||||
where
|
||||
tmNew = step tm
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
module Main where
|
||||
|
||||
import Data.List.Split
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Vector as V
|
||||
import Helpers
|
||||
import Intcode
|
||||
import Linear.V2
|
||||
|
||||
data GameState =
|
||||
GameState
|
||||
{ board :: M.Map (V2 Int) Integer
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
content <- readFile "input"
|
||||
let program = V.fromList $ concatMap (map read . splitOn ",") (lines content)
|
||||
let run x y =
|
||||
runIntcode
|
||||
( TM
|
||||
{ tape = tapePreprocess program (0, y)
|
||||
, pointer = 0
|
||||
, pointerOffset = 0
|
||||
, output = []
|
||||
, input = Just x
|
||||
, state = Continue
|
||||
}
|
||||
, GameState {board = M.empty})
|
||||
print $ countBlocks $ run 0 1
|
||||
putStrLn $ drawBoard $ run 0 1
|
||||
|
||||
runIntcode :: (TuringMachine, GameState) -> (TuringMachine, GameState)
|
||||
runIntcode (tm, gb) =
|
||||
case state tmNew of
|
||||
Continue -> runIntcode (tmNew, gb)
|
||||
AwaitInput -> runIntcode (tmNew, gb)
|
||||
_ -> (tmNew, gb)
|
||||
where
|
||||
tmNew = execSteps tm
|
||||
|
||||
parseBoard :: [Integer] -> M.Map (V2 Int) Integer
|
||||
parseBoard xs = foldr pttrans M.empty $ chunksOf 3 xs
|
||||
where
|
||||
pttrans (x:y:n:xs) board =
|
||||
M.insert (V2 (fromIntegral x) (fromIntegral y)) n board
|
||||
|
||||
countBlocks :: (TuringMachine, GameState) -> Int
|
||||
countBlocks =
|
||||
length . M.filter (== 2) . parseBoard . reverse . output . fst
|
||||
|
||||
drawBoard :: (TuringMachine, GameState) -> String
|
||||
drawBoard =
|
||||
drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')]) .
|
||||
parseBoard . reverse . output . fst
|
||||
Loading…
Reference in New Issue
Block a user