parent
6522ad7018
commit
345d628347
|
@ -0,0 +1,147 @@
|
||||||
|
module Intcode
|
||||||
|
( TuringMachine(TM, tape, pointer, pointerOffset, output, input,
|
||||||
|
state)
|
||||||
|
, step
|
||||||
|
, tapePreprocess
|
||||||
|
, TMAction(Continue, Output, Halt)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.DeepSeq as DeepSeq
|
||||||
|
import Control.Exception
|
||||||
|
import Data.Char
|
||||||
|
import Data.List as L
|
||||||
|
import Data.Vector as V hiding
|
||||||
|
( (++)
|
||||||
|
, concatMap
|
||||||
|
, elem
|
||||||
|
, head
|
||||||
|
, last
|
||||||
|
, length
|
||||||
|
, map
|
||||||
|
, reverse
|
||||||
|
, splitAt
|
||||||
|
)
|
||||||
|
import qualified Data.Vector as V ((++), last)
|
||||||
|
|
||||||
|
data TMAction
|
||||||
|
= Continue
|
||||||
|
| Output
|
||||||
|
| 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 :: [Integer]
|
||||||
|
, state :: TMAction
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
data IntcodeExcept =
|
||||||
|
UnknownOpCodeException
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
instance Exception IntcodeExcept
|
||||||
|
|
||||||
|
tapePreprocess :: Vector Integer -> Vector Integer
|
||||||
|
tapePreprocess t = (V.++) t $ V.replicate 105 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" -> (getNewTM $ head $ input tm) {input = L.tail $ input tm}
|
||||||
|
"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}
|
||||||
|
_ -> throw UnknownOpCodeException
|
||||||
|
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)])}
|
||||||
|
target =
|
||||||
|
fromInteger $
|
||||||
|
case m !! (length params - 1) of
|
||||||
|
Relative -> V.last opvec + pointerOffset tm
|
||||||
|
_ -> V.last opvec
|
|
@ -1,82 +1,33 @@
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Intcode
|
||||||
import Data.List.Split
|
import Data.List.Split
|
||||||
import Data.List as L
|
import qualified Data.Vector as V
|
||||||
import Data.Vector as V hiding ((++), concatMap, map, elem, last, head, length, splitAt, reverse)
|
|
||||||
import qualified Data.Vector as V ((++), last)
|
|
||||||
import Data.Char
|
|
||||||
import Control.DeepSeq as DeepSeq
|
|
||||||
|
|
||||||
data OutAction = Continue | Output | Halt deriving (Enum, Eq, Show)
|
|
||||||
data Mode = Position | Immediate | Relative deriving (Enum, Eq, Show)
|
|
||||||
type Tape = Vector Integer
|
|
||||||
type TapeSection = Vector Integer
|
|
||||||
type TuringMachine = (Tape,Integer,Integer)
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
content <- readFile "input"
|
content <- readFile "input"
|
||||||
let tape = fromList $ concatMap (map read . splitOn ",") (lines content)
|
let program = V.fromList $ concatMap (map read . splitOn ",") (lines content)
|
||||||
let run x = execSteps ((tapePreprocess tape,0,0),[x],[],Continue)
|
let run x =
|
||||||
let (_,_,out1,_) = run 1
|
runIntcode
|
||||||
let (_,_,out2,_) = run 2
|
(TM
|
||||||
print $ L.concat ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a<-out1,b<-out2]
|
{ tape = tapePreprocess program
|
||||||
|
, pointer = 0
|
||||||
|
, pointerOffset = 0
|
||||||
|
, output = []
|
||||||
|
, input = [x]
|
||||||
|
, state = Continue
|
||||||
|
})
|
||||||
|
let out1 = output $ run 1
|
||||||
|
let out2 = output $ run 2
|
||||||
|
print $
|
||||||
|
concat
|
||||||
|
["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a <- out1, b <- out2]
|
||||||
|
|
||||||
tapePreprocess :: TapeSection -> TapeSection
|
runIntcode :: TuringMachine -> TuringMachine
|
||||||
tapePreprocess t = (V.++) t $ V.replicate 105 0
|
runIntcode tm =
|
||||||
|
case state tmNew of
|
||||||
|
Continue -> runIntcode tmNew
|
||||||
opLength :: Integer -> Integer
|
_ -> tmNew
|
||||||
opLength x
|
where
|
||||||
| n`elem`"1278"=4
|
tmNew = step tm
|
||||||
| 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 -> TapeSection -> Tape -> TapeSection
|
|
||||||
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 :: TapeSection -> (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 :: TapeSection -> (TuringMachine, [Integer], [Integer]) -> (TuringMachine, OutAction, [Integer], [Integer])
|
|
||||||
step opvec ((t,p,rbase),input,output) = case op of
|
|
||||||
"1" -> (tm_binop (+),Continue,input,output)
|
|
||||||
"2" -> (tm_binop (*),Continue,input,output)
|
|
||||||
"3" -> (new_tm t $ head input,Continue,L.tail input,output)
|
|
||||||
"4" -> ((t,p,rbase),Output,input,V.last params:output)
|
|
||||||
"5" -> ((t, if params ! 0/=0 then params ! 1 else p,rbase),Continue,input,output)
|
|
||||||
"6" -> ((t, if params ! 0==0 then params ! 1 else p,rbase),Continue,input,output)
|
|
||||||
"7" -> (tm_binop (\x y->if x<y then 1 else 0),Continue,input,output)
|
|
||||||
"8" -> (tm_binop (\x y->if x==y then 1 else 0),Continue,input,output)
|
|
||||||
"9" -> ((t,p,rbase + (params ! 0)),Continue,input,output)
|
|
||||||
"99" -> ((t,p,rbase),Halt,input,output)
|
|
||||||
where (op,m) = getOpModes opvec
|
|
||||||
params = paramChange m rbase opvec t
|
|
||||||
tm_binop x = new_tm t ((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-}
|
|
||||||
new_tm t x = DeepSeq.force (t // [(target, x)],p,rbase)
|
|
||||||
target = fromInteger $ case m !! (length params -1) of
|
|
||||||
Relative -> V.last opvec + rbase
|
|
||||||
_ -> V.last opvec
|
|
||||||
|
|
||||||
execSteps :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction)
|
|
||||||
execSteps ((t,p,rbase),input,output,halt) =
|
|
||||||
let command_length = opLength $! t ! fromInteger p
|
|
||||||
opvec = slice (fromInteger p) (fromInteger command_length) t
|
|
||||||
((t_new,p_new,rbase_new),cond,input_new,output_new) =
|
|
||||||
step opvec ((t,p+command_length,rbase),input,output) in
|
|
||||||
case cond of
|
|
||||||
Halt -> ((t_new,p_new,rbase_new),input_new,output_new,cond)
|
|
||||||
_ -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user