This commit is contained in:
shu 2019-12-09 10:31:36 +01:00
parent 000d745174
commit 2609de6861
2 changed files with 98 additions and 0 deletions

97
2019/day9/day9.hs Normal file
View File

@ -0,0 +1,97 @@
import Data.List.Split
import qualified Data.List as L
import Data.Vector as V
import Data.Char
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 = do
content <- readFile "input"
let tape = fromList $ L.concatMap (L.map read . splitOn ",") (lines content)
let (tm,_,out,_) = runAmp ((tapePreprocess tape,0,0),[2],[],Continue)
print $ L.reverse out
findMax :: Tape -> [Integer] -> Integer
findMax tape range = L.maximum [runAmps tape xs | xs <- L.permutations range]
runAmps :: Tape -> [Integer] -> Integer
runAmps tape intseq = L.head $ runAmps' tms intseq [0]
where tms = L.replicate 5 (tape,0,0)
runAmps' :: [TuringMachine] -> [Integer] -> [Integer] -> [Integer]
runAmps' ((t,p,rbase):tms) intseq prev =
if halt == Halt then prev else
runAmps' (tms L.++ [tm_new]) tailseq tm_out
where (tm_new,tm_in,tm_out,halt) = execSteps ((t,p,rbase),xprev,[],Continue)
tailseq = if L.null intseq then [] else L.tail intseq
xprev = if L.null intseq then prev else L.head intseq:prev
runAmp :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction)
runAmp (tm,input,output,cond) = case cond_new of
Output -> runAmp (tm_new,input_new,output_new,cond_new)
_ -> (tm_new,input_new,output_new,cond_new)
where (tm_new,input_new,output_new,cond_new) = execSteps (tm,input,output,Continue)
tapePreprocess :: TapeSection -> TapeSection
tapePreprocess t = (V.++) t $ V.replicate 9999 0
opLength :: Integer -> Integer
opLength x
| n`L.elem`"1278"=4
| n`L.elem`"56"=3
| n`L.elem`"349"=2
| otherwise=1
where n = L.last $ show x
parseModes :: String -> [Mode]
parseModes m = L.replicate (3 - L.length l) Position L.++ l
where l = 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) = L.splitAt 2 $ L.reverse $ show $ opvec ! 0
parsed_modes = L.reverse $ parseModes $ L.reverse modes
op_dedup = if L.last op == '0' then [L.head op] else op
step :: TapeSection -> (TuringMachine, [Integer], [Integer]) -> (TuringMachine, OutAction, [Integer], [Integer])
step opvec ((t,p,rbase),input,val) = case op of
"1" -> (tm_binop (+),Continue,input,val)
"2" -> (tm_binop (*),Continue,input,val)
"3" -> (new_tm t $ L.head input,Continue,L.tail input,val)
"4" -> ((t,p,rbase),Output,input,V.last params:val)
"5" -> ((t, if params ! 0/=0 then params ! 1 else p,rbase),Continue,input,val)
"6" -> ((t, if params ! 0==0 then params ! 1 else p,rbase),Continue,input,val)
"7" -> (new_tm t (if (params ! 0)<(params ! 1)
then 1 else 0),Continue,input,val)
"8" -> (new_tm t (if (params ! 0)==(params ! 1)
then 1 else 0),Continue,input,val)
"9" -> ((t,p,rbase + (params ! 0)),Continue,input,val)
"99" -> ((t,p,rbase),Halt,input,val)
where (op,m) = getOpModes opvec
params = paramChange m rbase opvec t
tm_binop x = new_tm t ((params ! 0) `x` (params ! 1))
new_tm t x = (t // [(target, x)],p,rbase)
target = fromInteger $ case m !! (L.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
Continue -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)
_ -> ((t_new,p_new,rbase_new),input_new,output_new,cond)

1
2019/day9/input Normal file
View File

@ -0,0 +1 @@
1102,34463338,34463338,63,1007,63,34463338,63,1005,63,53,1101,0,3,1000,109,988,209,12,9,1000,209,6,209,3,203,0,1008,1000,1,63,1005,63,65,1008,1000,2,63,1005,63,904,1008,1000,0,63,1005,63,58,4,25,104,0,99,4,0,104,0,99,4,17,104,0,99,0,0,1101,0,38,1019,1102,1,37,1008,1101,252,0,1023,1102,24,1,1004,1102,35,1,1017,1101,0,28,1011,1101,0,36,1003,1102,30,1,1013,1101,0,0,1020,1102,1,1,1021,1102,897,1,1028,1101,20,0,1000,1101,0,22,1005,1102,29,1,1007,1101,0,34,1009,1102,1,259,1022,1101,310,0,1025,1102,892,1,1029,1101,21,0,1014,1102,1,315,1024,1101,0,33,1002,1102,31,1,1015,1102,190,1,1027,1102,1,39,1001,1101,26,0,1010,1101,27,0,1016,1102,1,23,1018,1101,0,32,1012,1101,0,25,1006,1102,1,197,1026,109,34,2106,0,-7,1001,64,1,64,1106,0,199,4,187,1002,64,2,64,109,-22,2108,34,-3,63,1005,63,221,4,205,1001,64,1,64,1106,0,221,1002,64,2,64,109,-10,1208,-1,42,63,1005,63,237,1106,0,243,4,227,1001,64,1,64,1002,64,2,64,109,20,2105,1,1,1001,64,1,64,1105,1,261,4,249,1002,64,2,64,109,1,21108,40,40,-6,1005,1017,283,4,267,1001,64,1,64,1105,1,283,1002,64,2,64,109,7,1205,-9,301,4,289,1001,64,1,64,1105,1,301,1002,64,2,64,109,-1,2105,1,-5,4,307,1106,0,319,1001,64,1,64,1002,64,2,64,109,-8,1206,0,331,1105,1,337,4,325,1001,64,1,64,1002,64,2,64,109,-6,21108,41,38,0,1005,1015,353,1105,1,359,4,343,1001,64,1,64,1002,64,2,64,109,11,1206,-6,377,4,365,1001,64,1,64,1106,0,377,1002,64,2,64,109,1,21101,42,0,-8,1008,1019,42,63,1005,63,399,4,383,1105,1,403,1001,64,1,64,1002,64,2,64,109,-29,1202,6,1,63,1008,63,24,63,1005,63,425,4,409,1106,0,429,1001,64,1,64,1002,64,2,64,109,14,1201,-3,0,63,1008,63,34,63,1005,63,451,4,435,1105,1,455,1001,64,1,64,1002,64,2,64,109,10,21101,43,0,-9,1008,1013,41,63,1005,63,475,1106,0,481,4,461,1001,64,1,64,1002,64,2,64,109,-17,2101,0,0,63,1008,63,21,63,1005,63,501,1106,0,507,4,487,1001,64,1,64,1002,64,2,64,109,-5,2107,21,5,63,1005,63,525,4,513,1105,1,529,1001,64,1,64,1002,64,2,64,109,13,1202,-7,1,63,1008,63,26,63,1005,63,553,1001,64,1,64,1106,0,555,4,535,1002,64,2,64,109,5,21107,44,45,-8,1005,1010,573,4,561,1105,1,577,1001,64,1,64,1002,64,2,64,109,-6,21102,45,1,7,1008,1019,45,63,1005,63,603,4,583,1001,64,1,64,1105,1,603,1002,64,2,64,109,-15,1207,10,28,63,1005,63,623,1001,64,1,64,1106,0,625,4,609,1002,64,2,64,109,8,2108,37,-4,63,1005,63,645,1001,64,1,64,1105,1,647,4,631,1002,64,2,64,109,6,21102,46,1,1,1008,1012,44,63,1005,63,671,1001,64,1,64,1106,0,673,4,653,1002,64,2,64,109,4,1207,-6,35,63,1005,63,695,4,679,1001,64,1,64,1106,0,695,1002,64,2,64,109,1,2107,38,-8,63,1005,63,715,1001,64,1,64,1105,1,717,4,701,1002,64,2,64,109,-23,1208,10,36,63,1005,63,739,4,723,1001,64,1,64,1105,1,739,1002,64,2,64,109,4,2102,1,7,63,1008,63,24,63,1005,63,765,4,745,1001,64,1,64,1105,1,765,1002,64,2,64,109,13,2102,1,-4,63,1008,63,22,63,1005,63,789,1001,64,1,64,1105,1,791,4,771,1002,64,2,64,109,-8,1201,5,0,63,1008,63,32,63,1005,63,811,1106,0,817,4,797,1001,64,1,64,1002,64,2,64,109,11,1205,7,829,1105,1,835,4,823,1001,64,1,64,1002,64,2,64,109,-1,2101,0,-6,63,1008,63,25,63,1005,63,857,4,841,1106,0,861,1001,64,1,64,1002,64,2,64,109,8,21107,47,46,-9,1005,1011,877,1106,0,883,4,867,1001,64,1,64,1002,64,2,64,109,9,2106,0,-1,4,889,1106,0,901,1001,64,1,64,4,64,99,21101,0,27,1,21102,915,1,0,1105,1,922,21201,1,59500,1,204,1,99,109,3,1207,-2,3,63,1005,63,964,21201,-2,-1,1,21101,0,942,0,1105,1,922,21201,1,0,-1,21201,-2,-3,1,21101,0,957,0,1105,1,922,22201,1,-1,-2,1105,1,968,21201,-2,0,-2,109,-3,2105,1,0