Add days 1,2,3-1,4,5,6,7,9

README.md

@@ -1,2 +1,8 @@
 # advent-of-code-2019
  Solutions to Advent Of Code 2019
+
+These are my solutions to AoC 2019. I didn't necessarily go for
+highest-possible-elegance or the leaderboards (in fact, I started late), so
+don't be surprised if my solutions look a little long, have inconsistent
+indentation, have snippets of dead code left in.... I've mostly left these
+submissions looking the way they did when I submitted the correct answer.

day1.hs

@@ -0,0 +1,12 @@
+main = do
+    f <- readFile "day1.txt"
+    let d = read <$> lines f
+    -- pt. 1
+    print $ sum $ (\x -> x `div` 3 + 5) <$> d
+
+    --pt. 2
+    let im x = x `div` 3 - 2 
+    let fuel x f = if (x < 9)
+        then (f)
+        else (fuel (im x) (f + im x))
+    print $ sum $ ((flip fuel) 0) <$> d

day2_1.hs

@@ -0,0 +1,27 @@
+import Data.Array.IO
+import Data.Array.MArray
+main = do
+    f <- readFile "day2.txt"
+    w <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    a <- newListArray (0, length w - 1) w :: IO (IOArray Int Int)
+    writeArray a 1 12
+    writeArray a 2 2
+    res <- performNext a 0
+    putStrLn $ show $ res
+
+performNext arr ind = let 
+    op 1 x y target = writeArray arr target (x + y) 
+    op 2 x y target = writeArray arr target (x * y)
+    op i _ _ _      = error $ "Invalid instruction: " ++ show i
+    in do
+        instruction <- readArray arr ind
+        if instruction == 99 
+        then readArray arr 0
+        else do
+            xp     <- readArray arr (ind + 1)
+            x      <- readArray arr xp
+            yp     <- readArray arr (ind + 2)
+            y      <- readArray arr yp
+            target <- readArray arr (ind + 3)
+            op instruction x y target
+            performNext arr (ind + 4)

day2_2.hs

@@ -0,0 +1,35 @@
+import Data.Array.IO
+import Data.Array.MArray
+import System.Exit
+main = do
+    f <- readFile "day2.txt"
+    w <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    a <- newListArray (0, length w - 1) w :: IO (IOArray Int Int)
+    pairs <- return [(noun, verb) | noun <- [1..99], verb <- [1..99]]
+    sequence $ checkPair a 19690720 <$> pairs
+    exitFailure
+
+performNext arr ind = let 
+    op 1 x y target = writeArray arr target (x + y) 
+    op 2 x y target = writeArray arr target (x * y)
+    op i _ _ _      = error $ "Invalid instruction: " ++ show i
+    in do
+        instruction <- readArray arr ind
+        if instruction == 99 
+        then readArray arr 0
+        else do
+            xp     <- readArray arr (ind + 1)
+            x      <- readArray arr xp
+            yp     <- readArray arr (ind + 2)
+            y      <- readArray arr yp
+            target <- readArray arr (ind + 3)
+            op instruction x y target
+            performNext arr (ind + 4)
+
+checkPair :: IOArray Int Int -> Int -> (Int, Int) -> IO ()
+checkPair arr value (noun, verb) = do
+    copy <- mapArray id arr
+    writeArray copy 1 noun
+    writeArray copy 2 verb
+    res <- performNext copy 0
+    if res == value then (putStrLn $ show (100 * noun + verb)) >>= \_ -> exitSuccess else return ()

day3_1.hs

@@ -0,0 +1,38 @@
+import Data.Set (Set, toList, fromList, intersection)
+import Data.List (sortOn)
+import Control.Monad.Writer.Lazy
+import Text.Show.Functions
+
+data Direction = DUp Int | DDown Int | DLeft Int | DRight Int
+    deriving (Show)
+dir ('U':xs) = DUp    $ read xs
+dir ('D':xs) = DDown  $ read xs
+dir ('L':xs) = DLeft  $ read xs
+dir ('R':xs) = DRight $ read xs
+dir _      = error "Failed to parse direction"
+
+points (DUp n)    (x, y) = [(x, y+i) | i <- [1..n]]
+points (DDown n)  (x, y) = [(x, y-i) | i <- [1..n]]
+points (DLeft n)  (x, y) = [(x-i, y) | i <- [1..n]]
+points (DRight n) (x, y) = [(x+i, y) | i <- [1..n]]
+
+manhattan (p, p') (q, q') = (abs $ p - q) + (abs $ p' - q')
+
+step :: (Int, Int) -> Direction -> Writer (Set (Int, Int)) (Int, Int) 
+step (x, y) dir = let p = points dir (x, y) in do
+    tell $ fromList p
+    return $ last p
+
+turnsToSet :: [Direction] -> Set (Int, Int)
+turnsToSet = execWriter . foldM step (0, 0)
+main = do
+    f     <- readFile "day3.txt"
+    --turnses <- undefined -- return $ fmap (dir $ words (fmap (\x -> if x == ',' then ' ' else x))) (lines f)
+    ls <- return $ lines f
+    turnses <- return $ do
+        l <- ls
+        return $ dir <$> (words $ (\x -> if x == ',' then ' ' else  x )<$>l)
+    sets <- return $ turnsToSet <$> turnses
+    i <- return $ foldl1 intersection sets
+    j <- return $ sortOn (manhattan (0,0)) $ toList i
+    putStrLn $ show $ manhattan (0,0) (head j)

day4.hs

@@ -0,0 +1,15 @@
+import Data.List
+-- left as it was in my dir, since pt 1 should be obvious given this
+input = show <$> [146810..612563] 
+
+getpairs (x:y:xs) = (x,y) : getpairs (y:xs)
+getpairs _ = []
+
+check i = let
+        pairs = getpairs i
+    in
+        if (any (==2) (length <$> group i)) && (all (uncurry (<=)) pairs) 
+        then 1
+        else 0
+
+main = putStrLn $ show $ sum $ check <$> input 

day5_1.hs

@@ -0,0 +1,112 @@
+import Data.Array.IO
+import Data.Array.MArray
+import Text.Show.Functions -- to prettyprint errors
+
+type Address = Int
+type Memory  = IOArray Int Int
+type Value   = Int
+type Input   = Int
+data Opcode  = ADD | MUL | INP | OUT | HAL
+    deriving Show
+
+opcode 1  = ADD
+opcode 2  = MUL
+opcode 3  = INP
+opcode 4  = OUT
+opcode 99 = HAL
+opcode e  = error $ "Unknown opcode " ++ (show e)
+
+nParams ADD = 3
+nParams MUL = 3
+nParams INP = 1
+nParams OUT = 1
+nParams HAL = 0
+
+data Mode = POS | IMM
+    deriving Show
+mode 0 = POS
+mode 1 = IMM
+mode e = error $ "Unknown mode " ++ (show e)
+
+takeLast n = reverse . take n . reverse 
+
+--assumes infinite args; just use an appropriate bound
+getModes :: Int -> [Mode]
+getModes l = let j = show l
+    in reverse ((mode . read . (\x -> [x])) <$>
+    take ((length j) - 2) j) ++ (repeat POS)
+
+getOpcode :: Int -> Opcode 
+getOpcode = opcode . read . takeLast 2 . show
+
+getInstruction :: Memory -> Address -> IO (Opcode, Int, [(Mode, Int)])
+getInstruction mem a = do
+    val  <- readArray mem a
+    op   <- return $ getOpcode val
+    ps   <- return $ nParams op
+    m    <- return $ getModes val
+    args <- forwardArraySlice mem (a + 1) (a + ps + 1) 
+    return (op, ps, zip m args)
+
+forwardArraySlice arr i j = sequence $ readArray arr <$> [i..(j-1)]
+
+-- take a mode and an argument, and yield the value
+unpackArg :: Memory -> (Mode, Int) -> IO Value 
+unpackArg mem (POS, i) = readArray mem i
+unpackArg _   (IMM, i) = return i
+--currently unneeded
+--unpackArg _   (e  , _) = error $ "Unimplemented mode " ++ (show e)
+
+-- (remaining inputs, halted?)
+runInstruction :: Memory -> [Input] -> Opcode -> [Value] -> IO ([Input], Bool) 
+runInstruction mem is ADD vals = do 
+    writeArray mem 
+        (vals !! 2) 
+        ((vals !! 0) + (vals !! 1))
+    return (is, False)
+runInstruction mem is MUL vals = do
+    writeArray mem 
+        (vals !! 2) 
+        ((vals !! 0) * (vals !! 1))
+    return (is, False)
+runInstruction mem (i:is) INP vals = do
+    writeArray mem (vals !! 0) i
+    return (is, False) 
+runInstruction _ _ INP _ = error "Tried to read input; none found"
+runInstruction mem is OUT vals = do
+    putStrLn $ show $ vals !! 0
+    return (is, False)
+runInstruction _ is HAL _ = return (is, True)
+
+--change the ops used in writes to immediate mode to defer lookup
+filterWrites :: Opcode -> [(Mode, Int)] -> [(Mode, Int)]
+filterWrites ADD (a:b:(_, i):xs) = a:b:(IMM,i):xs 
+filterWrites MUL (a:b:(_, i):xs) = a:b:(IMM,i):xs 
+filterWrites INP ((_,i):xs) = (IMM,i):xs
+filterWrites _ l = l
+
+performNext :: Memory -> Address -> [Input] -> IO Int
+performNext mem ip input = do
+    (op, ps, argms) <- getInstruction mem ip
+    argms' <- return $ filterWrites op argms
+    --putStrLn $ "DEBUG :" ++ (show (ip, op, ps, argms))
+    vals <- sequence $ (unpackArg mem) <$> argms'
+    --putStrLn $ "DEBUG vals:" ++ (show (ip, op, ps, argms, vals))
+    (input', halted) <- runInstruction mem input op vals
+    if halted
+    then do
+        readArray mem 0
+    else
+        performNext mem (ip + ps + 1) input'
+
+main = do
+    f  <- readFile "day5.txt"
+    w  <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    a  <- newListArray (0, length w - 1) w :: IO (IOArray Int Int)
+    --i  <- readFile "day5_1input.txt" 
+    --i' <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    i' <- return [1]
+    res <- performNext a 0 i'
+    putStrLn $ "Halted: " ++ (show res)
+
+

day5_2.hs

@@ -0,0 +1,143 @@
+import Data.Array.IO
+import Data.Array.MArray
+import Text.Show.Functions -- to prettyprint errors
+
+type Address = Int
+type Memory  = IOArray Int Int
+type Value   = Int
+type Input   = Int
+data Opcode  = ADD | MUL | INP | OUT | JNZ | JZ | SLT | SEQ | HAL
+    deriving Show
+
+opcode 1  = ADD
+opcode 2  = MUL
+opcode 3  = INP
+opcode 4  = OUT
+opcode 5  = JNZ
+opcode 6  = JZ
+opcode 7  = SLT
+opcode 8  = SEQ
+opcode 99 = HAL
+opcode e  = error $ "Unknown opcode " ++ (show e)
+
+nParams ADD = 3 --writes on 3
+nParams MUL = 3 --writes on 3
+nParams INP = 1 --writes on 1
+nParams OUT = 1 
+nParams JNZ = 2 
+nParams JZ  = 2 
+nParams SLT = 3 --writes on 3
+nParams SEQ = 3 --writes on 3
+nParams HAL = 0
+
+data Mode = POS | IMM
+    deriving Show
+mode 0 = POS
+mode 1 = IMM
+mode e = error $ "Unknown mode " ++ (show e)
+
+takeLast n = reverse . take n . reverse 
+
+--assumes infinite args; just use an appropriate bound
+getModes :: Int -> [Mode]
+getModes l = let j = show l
+    in reverse ((mode . read . (\x -> [x])) <$>
+    take ((length j) - 2) j) ++ (repeat POS)
+
+getOpcode :: Int -> Opcode 
+getOpcode = opcode . read . takeLast 2 . show
+
+getInstruction :: Memory -> Address -> IO (Opcode, Int, [(Mode, Int)])
+getInstruction mem a = do
+    val  <- readArray mem a
+    op   <- return $ getOpcode val
+    ps   <- return $ nParams op
+    m    <- return $ getModes val
+    args <- forwardArraySlice mem (a + 1) (a + ps + 1) 
+    return (op, ps, zip m args)
+
+forwardArraySlice arr i j = sequence $ readArray arr <$> [i..(j-1)]
+
+-- take a mode and an argument, and yield the value
+unpackArg :: Memory -> (Mode, Int) -> IO Value 
+unpackArg mem (POS, i) = readArray mem i
+unpackArg _   (IMM, i) = return i
+--currently unneeded
+--unpackArg _   (e  , _) = error $ "Unimplemented mode " ++ (show e)
+
+-- (remaining inputs, halted?)
+runInstruction :: Memory -> Address -> [Input] -> Opcode -> [Value] -> IO ([Input], Bool, Address) 
+runInstruction mem ip is ADD vals = do 
+    writeArray mem 
+        (vals !! 2) 
+        ((vals !! 0) + (vals !! 1))
+    return (is, False, ip + 4)
+runInstruction mem ip is MUL vals = do
+    writeArray mem 
+        (vals !! 2) 
+        ((vals !! 0) * (vals !! 1))
+    return (is, False, ip + 4)
+runInstruction mem ip (i:is) INP vals = do
+    writeArray mem (vals !! 0) i
+    return (is, False, ip + 2) 
+runInstruction _ _ _ INP _= error "Tried to read input; none found"
+runInstruction mem ip is OUT vals = do
+    putStrLn $ show $ vals !! 0
+    return (is, False, ip + 2)
+runInstruction mem ip is JNZ vals = 
+    if (vals !! 0) /= 0
+    then return (is, False, vals !! 1)
+    else return (is, False, ip + 3)
+runInstruction mem ip is JZ vals = 
+    if (vals !! 0) == 0
+    then return (is, False, vals !! 1)
+    else return (is, False, ip + 3)
+runInstruction mem ip is SLT vals = do
+    if (vals !! 0) < (vals !! 1)
+    then writeArray mem (vals !! 2) 1
+    else writeArray mem (vals !! 2) 0
+    return (is, False, ip + 4)
+runInstruction mem ip is SEQ vals = do
+    if (vals !! 0) == (vals !! 1)
+    then writeArray mem (vals !! 2) 1
+    else writeArray mem (vals !! 2) 0
+    return (is, False, ip + 4)
+runInstruction _ _ is HAL _ = return (is, True, error "Forced ip on halted machine")
+
+--change the ops used in writes to immediate mode to defer lookup
+demoteWrites :: Opcode -> [(Mode, Int)] -> [(Mode, Int)]
+demoteWrites ADD (a:b:(m, i):xs) = a:b:(demote m, i):xs 
+demoteWrites MUL (a:b:(m, i):xs) = a:b:(demote m, i):xs 
+demoteWrites INP ((m,i):xs) = (demote m, i):xs
+demoteWrites SEQ (a:b:(m, i):xs) = a:b:(demote m, i):xs 
+demoteWrites SLT (a:b:(m, i):xs) = a:b:(demote m, i):xs 
+demoteWrites _ l = l
+
+demote POS = IMM
+demote _   = error "Failed to demote mode"
+
+performNext :: Memory -> Address -> [Input] -> IO Int
+performNext mem ip input = do
+    (op, ps, argms) <- getInstruction mem ip
+    argms' <- return $ demoteWrites op argms
+    putStrLn $ "DEBUG :" ++ (show (ip, op, ps, argms, argms'))
+    vals <- sequence $ (unpackArg mem) <$> argms'
+    putStrLn $ "DEBUG vals:" ++ (show vals)
+    (input', halted, ip') <- runInstruction mem ip input op vals
+    if halted
+    then 
+        readArray mem 0
+    else
+        performNext mem ip' input'
+
+main = do
+    f  <- readFile "day5.txt"
+    --f  <- return "3,3,1107,-1,8,3,4,3,99"
+    w  <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    a  <- newListArray (0, length w - 1) w :: IO (IOArray Int Int)
+    --i  <- readFile "day5_1input.txt" 
+    --i' <- return $ (read :: String -> Int) <$> (words $ (\x -> if x == ',' then ' ' else x) <$> f)
+    i' <- return [5]
+    res <- performNext a 0 i'
+    putStrLn $ "Halted: " ++ (show res)
+