pull/2/head
gaedep59197 5 years ago committed by GitHub
parent 84c70f3f43
commit ba6ea0c4d4
Failed to generate hash of commit
  1. 6
      app/Main.hs
  2. 1
      app/input_day7
  3. 49
      src/Day7.hs
  4. 178
      src/IntCode.hs

@ -6,6 +6,7 @@ import Day3
import Day4 import Day4
import Day5 import Day5
import Day6 import Day6
import Day7
import System.IO import System.IO
import Data.List.Split import Data.List.Split
import Data.Set import Data.Set
@ -58,3 +59,8 @@ main = do
print $ countOrbits r_day6 print $ countOrbits r_day6
putStr "[Day 6-2] Result: " putStr "[Day 6-2] Result: "
print $ nOrbits r_day6 print $ nOrbits r_day6
r_day7 <- readFile "./app/input_day7"
putStr "[Day 7-1] Result: "
print $ findMaxAmp r_day7
putStr "[Day 7-2] Result: "
print $ findMaxAmpWithFB r_day7

@ -0,0 +1 @@
3,8,1001,8,10,8,105,1,0,0,21,34,51,68,89,98,179,260,341,422,99999,3,9,1001,9,4,9,102,4,9,9,4,9,99,3,9,1002,9,5,9,1001,9,2,9,1002,9,2,9,4,9,99,3,9,1001,9,3,9,102,3,9,9,101,4,9,9,4,9,99,3,9,102,2,9,9,101,2,9,9,1002,9,5,9,1001,9,2,9,4,9,99,3,9,102,2,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,2,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,99

@ -0,0 +1,49 @@
module Day7
(
module Day7
) where
import IntCode
import Data.List
import Debug.Trace
import Data.Maybe
findMaxAmp :: String -> Integer
findMaxAmp p = maximum (fmap (`calculateAmpForPhases` p) (permutations [0..4]))
calculateAmpForPhases :: [Integer] -> String -> Integer
calculateAmpForPhases phases p = foldr f 0 $ reverse phases
where f a b = calculateAmp a b p
calculateAmp :: Integer -> Integer -> String -> Integer
calculateAmp phase input = fromJust
. snd
. getOutput
. flip runProgram (Just input)
. flip runProgram (Just phase)
. parseProgram
findMaxAmpWithFB :: String -> Integer
findMaxAmpWithFB s =
let p = parseProgram s
allInits = fmap (\a -> feedPhases (zip a (replicate 5 p)))
(permutations [5..9])
allRuns = fmap (runRest 0) allInits
in
maximum allRuns
feedPhases :: [(Input, Program)] -> [Program]
feedPhases = fmap (\(a, p) -> runProgram p (Just a))
runRest :: Input -> [Program] -> Output
runRest i ps =
if isHalted (last ps)
then i
else let (ps', o) = runLoop i ps in runRest o ps'
runLoop :: Input -> [Program] -> ([Program], Output)
runLoop i [] = ([],i)
runLoop i (x:xs) =
let (p, mo) = getOutput $ runProgram x (Just i)
(ps, o) = runLoop (fromJust mo) xs in
(p : ps, o)

@ -0,0 +1,178 @@
{-# LANGUAGE OverloadedStrings #-}
module IntCode
(
Input
, Output
, Program(..)
, parseProgram
, runProgram
, getOutput
, isHalted
) where
import Data.Char
import Data.Maybe
import Control.Applicative
import qualified Data.Text as T
import qualified Data.Attoparsec.Text as P
import qualified Data.Vector as V
data ADDR = POSITION Int
| IMMEDIATE Integer
deriving (Show)
type Input = Integer
type Output = Integer
data Instruction = ADD ADDR ADDR Int
| MUL ADDR ADDR Int
| STORE Int
| LOAD Int
| JMPT ADDR ADDR
| JMPF ADDR ADDR
| LT' ADDR ADDR Int
| EQ' ADDR ADDR Int
| HALT
deriving (Show)
type Memory = V.Vector Integer
type PC = Int
-- type RunningProg = ([Input], Memory, PC, [Output])
data Program = RUNNING { memory :: Memory
, pc ::PC
, output :: Maybe Output }
| WAITING { memory :: Memory
, pc ::PC
, output :: Maybe Output }
| HALTED { outputs :: Output }
deriving (Show)
parseProgram :: String -> Program
parseProgram s = WAITING (parseMemory (T.pack s)) 0 Nothing
parseMemory :: T.Text -> Memory
parseMemory t =
let parsed = P.parse (P.sepBy1 (P.signed P.decimal) (P.char ',')) t in
case parsed of
P.Done _ r -> V.fromList r
P.Partial f -> V.fromList $
fromMaybe []
(P.maybeResult (P.feed parsed ""))
_ -> V.empty
getOutput :: Program -> (Program, Maybe Output)
getOutput (HALTED o) = (HALTED o, Just o)
getOutput (RUNNING m c o) = (RUNNING m c Nothing, o)
getOutput (WAITING m c o) = (WAITING m c Nothing, o)
isHalted :: Program -> Bool
isHalted HALTED{} = True
isHalted _ = False
runProgram :: Program -> Maybe Input -> Program
runProgram p@HALTED{} _ = p
runProgram p@(WAITING m c o) Nothing = p
runProgram (WAITING m c o) mi = runProgram (RUNNING m c o) mi
runProgram p@(RUNNING m' pc _) i =
let inst = parseInstruction m' pc
(p', input) = executeInstruction i p inst in
runProgram p' input
parseInstruction :: Memory -> PC -> Instruction
parseInstruction p i =
let inst = p V.! i
a = (inst `div` 10000) /= 0
b = (inst `mod` 10000) `div` 1000 /= 0
c = (inst `mod` 1000) `div` 100 /= 0
de = (inst `mod` 100)
addr b a = if b then IMMEDIATE a else POSITION (fromInteger a)
in
case de of
1 -> ADD (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
2 -> MUL (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
3 -> STORE $ fromInteger (p V.! (i+1))
4 -> LOAD $ fromInteger (p V.! (i+1))
5 -> JMPT (addr c (p V.! (i+1))) (addr b (p V.! (i+2)))
6 -> JMPF (addr c (p V.! (i+1))) (addr b (p V.! (i+2)))
7 -> LT' (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
8 -> EQ' (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
99 -> HALT
_ -> error $ "unknown instruction " ++ show ((a,b,c), de)
executeInstruction :: Maybe Input
-> Program
-> Instruction
-> (Program, Maybe Input)
executeInstruction mi p@(HALTED _) _ = (p, mi)
executeInstruction Nothing p@WAITING{} _ = (p, Nothing)
executeInstruction (Just input) p@(WAITING m pc o) i =
executeInstruction (Just input) (RUNNING m pc o) i -- try running again
executeInstruction mi (RUNNING p pc outputs) i =
case i of
ADD (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, (p V.! a) + (p V.! b))]) (pc + 4) outputs, mi)
ADD (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, (p V.! a) + b)]) (pc + 4) outputs, mi)
ADD (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, a + (p V.! b))]) (pc + 4) outputs, mi)
ADD (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, a + b)]) (pc + 4) outputs, mi)
MUL (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, (p V.! a) * (p V.! b))]) (pc + 4) outputs, mi)
MUL (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, (p V.! a) * b)]) (pc + 4) outputs, mi)
MUL (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, a * (p V.! b))]) (pc + 4) outputs, mi)
MUL (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, a * b)]) (pc + 4) outputs, mi)
STORE a -> case mi of
Nothing -> (WAITING p pc outputs, mi)
Just b -> (RUNNING (p V.// [(a, b)]) (pc + 2) outputs, Nothing)
LOAD a -> (RUNNING p (pc + 2) (Just $ p V.! a), mi)
JMPT (POSITION a) (POSITION b) ->
(RUNNING p (if (p V.! a) /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPT (POSITION a) (IMMEDIATE b) ->
(RUNNING p (if (p V.! a) /= 0 then fromInteger b else pc + 3) outputs, mi)
JMPT (IMMEDIATE a) (POSITION b) ->
(RUNNING p (if a /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPT (IMMEDIATE a) (IMMEDIATE b) ->
(RUNNING p (if a /= 0 then fromInteger b else pc + 3) outputs, mi)
JMPF (POSITION a) (POSITION b) ->
(RUNNING p (if (p V.! a) == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPF (POSITION a) (IMMEDIATE b) ->
(RUNNING p (if (p V.! a) == 0 then fromInteger b else pc + 3) outputs, mi)
JMPF (IMMEDIATE a) (POSITION b) ->
(RUNNING p (if a == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPF (IMMEDIATE a) (IMMEDIATE b) ->
(RUNNING p (if a == 0 then fromInteger b else pc + 3) outputs, mi)
LT' (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, if (p V.! a) < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
LT' (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if (p V.! a) < b then 1 else 0)]) (pc + 4) outputs, mi)
LT' (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, if a < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
LT' (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if a < b then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, if (p V.! a) == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if (p V.! a) == b then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, if a == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if a == b then 1 else 0)]) (pc + 4) outputs, mi)
HALT -> (HALTED (fromJust outputs), mi)
extractHead :: [a] -> Maybe (a, [a])
extractHead [] = Nothing
extractHead (x:xs) = Just (x, xs)
Loading…
Cancel
Save