Updated Haskell implementation and Day 2 solution.

This commit is contained in:
Jonathan Chan 2019-12-21 13:23:55 -08:00
parent 98e2146c3e
commit 4b23c6f982
4 changed files with 92 additions and 22 deletions

View File

@ -3,4 +3,12 @@ module Main where
import Day02 (day02) import Day02 (day02)
main :: IO () main :: IO ()
main = day02 main = do
putStrLn "Which day's solution would you like to execute?"
day <- readLn
case day of
2 -> day02
n ->
if n >= 1 && n <= 25
then putStrLn "Sorry, there's no implementation for that day."
else putStrLn "That's not even... no!"

View File

@ -1,9 +1,24 @@
module Day02 where module Day02 where
import IntCode (IntCodeState(..), initState, getProgram, execUntilHalt) import Lib
import IntCode (getProgramAfterExec)
import Control.Monad (guard)
input = [1,12,2,3,1,1,2,3,1,3,4,3,1,5,0,3,2,1,9,19,1,10,19,23,2,9,23,27,1,6,27,31,2,31,9,35,1,5,35,39,1,10,39,43,1,10,43,47,2,13,47,51,1,10,51,55,2,55,10,59,1,9,59,63,2,6,63,67,1,5,67,71,1,71,5,75,1,5,75,79,2,79,13,83,1,83,5,87,2,6,87,91,1,5,91,95,1,95,9,99,1,99,6,103,1,103,13,107,1,107,5,111,2,111,13,115,1,115,6,119,1,6,119,123,2,123,13,127,1,10,127,131,1,131,2,135,1,135,5,0,99,2,14,0,0] addNounVerb :: Int -> Int -> [Int] -> [Int]
addNounVerb n v is = head is : n : v : drop 3 is
part1 :: [Int] -> Int
part1 = head . getProgramAfterExec . addNounVerb 12 2
part2 :: [Int] -> [Int]
part2 input = do
noun <- [0..99]
verb <- [0..99]
let result = head . getProgramAfterExec . addNounVerb noun verb $ input
guard $ result == 19690720
return $ 100 * noun + verb
day02 = do day02 = do
putStr "Part 1: " input <- readAsList <$> readFile "../input/02.txt"
print . head . getProgram . execUntilHalt $ initState input printPart1 $ part1 input
printPart2 $ head (part2 input)

View File

@ -3,34 +3,39 @@
module IntCode module IntCode
( IntCodeState(..) ( IntCodeState(..)
, initState , initState
, getProgram
, execUntilHalt , execUntilHalt
, evalWithOutput
, getProgramAfterExec
) where ) where
import Lib ((%), (//))
import Data.List (sort) import Data.List (sort)
import Data.IntMap (IntMap, Key, findWithDefault, insert, fromList, toList) import Data.IntMap (IntMap, Key, findWithDefault, insert, fromList, toList)
import Control.Monad.State (State, get, put, modify, runState) import Control.Monad.State (State, get, put, modify, runState)
type Preprogram = [Int]
type Program = IntMap Int type Program = IntMap Int
type Pointer = Int type Pointer = Int
type Base = Int type Base = Int
type Ins = [Int]
type Outs = [Int]
data IntCodeState = IntCodeState { data IntCodeState = IntCodeState {
program :: Program, program :: Program,
pointer :: Pointer, pointer :: Pointer,
base :: Base, base :: Base,
inputs :: [Int] inputs :: Ins
} }
data Result = Output Int | Continue | Halted data Result = Output Int | Continue | Halt
(%) = mod
(//) = div
(!) :: Program -> Key -> Int (!) :: Program -> Key -> Int
infixl 5 ! -- just below arithmetic infixl 5 ! -- just below arithmetic
(!) = flip $ findWithDefault 0 (!) = flip $ findWithDefault 0
{-- STATE HELPERS --}
noop :: State IntCodeState () noop :: State IntCodeState ()
noop = return () noop = return ()
@ -52,6 +57,9 @@ readInput = do
put st { inputs = tail $ inputs st } put st { inputs = tail $ inputs st }
return . head $ inputs st return . head $ inputs st
{-- INTCODE INTERPRETER --}
exec :: State IntCodeState Result exec :: State IntCodeState Result
exec = do exec = do
IntCodeState program pointer base _ <- get IntCodeState program pointer base _ <- get
@ -79,22 +87,35 @@ exec = do
2 -> updateProgram loc3 (val1 * val2) >> return Continue 2 -> updateProgram loc3 (val1 * val2) >> return Continue
3 -> readInput >>= updateProgram loc1 >> return Continue 3 -> readInput >>= updateProgram loc1 >> return Continue
4 -> return $ Output val1 4 -> return $ Output val1
5 -> (if (val1 /= 0) then updatePointer val2 else noop) >> return Continue 5 -> (if val1 /= 0 then updatePointer val2 else noop) >> return Continue
6 -> (if (val1 == 0) then updatePointer val2 else noop) >> return Continue 6 -> (if val1 == 0 then updatePointer val2 else noop) >> return Continue
7 -> updateProgram loc3 (if (val1 < val2) then 1 else 0) >> return Continue 7 -> updateProgram loc3 (if val1 < val2 then 1 else 0) >> return Continue
8 -> updateProgram loc3 (if (val1 == val2) then 1 else 0) >> return Continue 8 -> updateProgram loc3 (if val1 == val2 then 1 else 0) >> return Continue
9 -> updateBase val1 >> return Continue 9 -> updateBase val1 >> return Continue
99 -> return Halted 99 -> return Halt
initState :: [Int] -> IntCodeState
{-- STATE RUNNERS --}
-- By convention, run* returns (value, state),
-- exec* returns state, and eval* returns value
initState :: Preprogram -> IntCodeState
initState list = IntCodeState (fromList $ zip [0..] list) 0 0 [] initState list = IntCodeState (fromList $ zip [0..] list) 0 0 []
getProgram :: IntCodeState -> [Int]
getProgram = map snd . sort . toList . program
execUntilHalt :: IntCodeState -> IntCodeState execUntilHalt :: IntCodeState -> IntCodeState
execUntilHalt st = execUntilHalt st =
let (result, st') = runState exec st let (result, st') = runState exec st
in case result of in case result of
Halted -> st' Halt -> st'
_ -> execUntilHalt st' _ -> execUntilHalt st'
evalWithOutput :: IntCodeState -> Outs
evalWithOutput st =
let (result, st') = runState exec st
in case result of
Halt -> []
Output out -> out : evalWithOutput st'
Continue -> evalWithOutput st'
getProgramAfterExec :: Preprogram -> Preprogram
getProgramAfterExec = map snd . sort . toList . program . execUntilHalt . initState

26
haskell/src/Lib.hs Normal file
View File

@ -0,0 +1,26 @@
module Lib
( readAsList
, printPart1
, printPart2
, (%), (//)
) where
-- Read a sequence of comma-separated values as a homogenous list
readAsList :: Read a => String -> [a]
readAsList = read . ("[" ++) . (++ "]")
printPart1 :: Show a => a -> IO ()
printPart1 a = do
putStr "Part 1: "
print a
printPart2 :: Show a => a -> IO ()
printPart2 a = do
putStr "Part 1: "
print a
(%) :: Integral a => a -> a -> a
(%) = mod
(//) :: Integral a => a -> a -> a
(//) = div