├── .gitignore ├── Day1.hs ├── Day2.hs ├── Day3.hs ├── Day4.hs ├── Day5.hs ├── Day6.hs └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | .DS_Store 3 | -------------------------------------------------------------------------------- /Day1.hs: -------------------------------------------------------------------------------- 1 | module Day1 where 2 | 3 | readInt :: String -> Int 4 | readInt s = read s 5 | 6 | fuel m = m `div` 3 - 2 7 | 8 | fuelTot m = sum $ takeWhile (> 0) $ iterate fuel (fuel m) 9 | 10 | main = do 11 | text <- readFile "Data1.txt" 12 | let ms = fmap readInt $ lines text 13 | print $ sum $ fmap fuel ms 14 | print $ sum $ fmap fuelTot ms 15 | -------------------------------------------------------------------------------- /Day2.hs: -------------------------------------------------------------------------------- 1 | module Day2 where 2 | 3 | import Data.List.Split 4 | import Data.Maybe 5 | import Data.Map as M 6 | import Control.Applicative 7 | 8 | readInt :: String -> Int 9 | readInt s = read s 10 | 11 | -- This may be an overkill 12 | -- but we worship type safety 13 | newtype Addr = A Int 14 | deriving (Eq, Ord) 15 | 16 | -- We could have derived Num 17 | -- but this is safer 18 | addP :: Addr -> Int -> Addr 19 | addP (A p) off = A $ p + off 20 | 21 | -- Store the program as a map 22 | -- for quick random access 23 | type Prog = M.Map Addr Int 24 | 25 | get :: Addr -> Prog -> Int 26 | get p prog = fromJust $ M.lookup p prog 27 | 28 | getP :: Addr -> Int -> Prog -> Addr 29 | getP p off prog = A $ fromJust $ M.lookup (addP p off) prog 30 | 31 | put :: Addr -> Int -> Prog -> Prog 32 | put p v prog = M.insert p v prog 33 | 34 | mkProgram :: [Int] -> Prog 35 | mkProgram listing = M.fromList (zip addressSpace listing) 36 | where addressSpace = fmap A [0..] 37 | 38 | run :: Prog -> (Int, Int) -> Int 39 | run prog (noun, verb) = runProg (A 0) prog2 40 | where prog1 = put (A 1) noun prog 41 | prog2 = put (A 2) verb prog1 42 | 43 | runProg :: Addr -> Prog -> Int 44 | runProg ip prog = 45 | let opCode = get ip prog 46 | in if opCode == 99 47 | then get (A 0) prog -- we're done! 48 | else 49 | runProg (addP ip 4) (exec opCode p1 p2 pr prog) 50 | where p1 = getP ip 1 prog 51 | p2 = getP ip 2 prog 52 | pr = getP ip 3 prog 53 | 54 | exec :: Int -> Addr -> Addr -> Addr -> Prog -> Prog 55 | exec op p1 p2 pr prog = put pr val prog 56 | where val = if op == 1 57 | then m + n 58 | else m * n 59 | m = get p1 prog 60 | n = get p2 prog 61 | 62 | makeOutput :: Int -> Prog -> Int 63 | makeOutput out prog = 100 * noun + verb 64 | where pairs = (,) <$> [0..99] <*> [0..99] 65 | outputs = zip (fmap (run prog) pairs) pairs 66 | (noun, verb) = fromJust $ Prelude.lookup out outputs 67 | 68 | main = do 69 | text <- readFile "Data2.txt" 70 | let listing = fmap readInt $ splitOn "," text 71 | let prog = mkProgram listing 72 | print $ run prog (12, 2) 73 | print $ makeOutput 19690720 prog 74 | 75 | test = [1,9,10,3,2,3,11,0,99,30,40,50] 76 | -------------------------------------------------------------------------------- /Day3.hs: -------------------------------------------------------------------------------- 1 | module Day3 where 2 | import Data.List.Split 3 | import Data.Maybe 4 | import Data.List 5 | import Control.Applicative 6 | 7 | type Dir = Char 8 | data Move = M Dir Int -- direction, distance 9 | deriving Show 10 | 11 | readMv :: String -> Move 12 | readMv (c:cs) = M c (read cs) 13 | 14 | type Steps = Int -- number of steps in the grid 15 | type Count = Int -- count of segments 16 | 17 | -- A segment may be horizontal or vertical 18 | 19 | data Seg = S { sMin :: Int -- minimum coordinate 20 | , sMax :: Int -- maximum coordinate 21 | , sOth :: Int -- other coordinate 22 | , sDir :: Dir -- direction 23 | , steps :: Steps -- grid steps so far 24 | } deriving Show 25 | 26 | -- It works if their directions are orthogonal 27 | 28 | isCross :: Seg -> Seg -> Bool 29 | isCross s1 s2 = sMin s1 < sOth s2 30 | && sOth s2 < sMax s1 31 | && sMin s2 < sOth s1 32 | && sOth s1 < sMax s2 33 | 34 | type Pos = (Int, Int) -- x, y position 35 | 36 | -- vertical and horizontal segments 37 | 38 | data Segments = Segs { vert :: [Seg], hor :: [Seg] } 39 | deriving Show 40 | 41 | addSeg :: Seg -> Segments -> Segments 42 | addSeg seg (Segs vert hor) = 43 | case sDir seg of 44 | 'U' -> Segs (seg : vert) hor 45 | 'D' -> Segs (seg : vert) hor 46 | 'L' -> Segs vert (seg : hor) 47 | 'R' -> Segs vert (seg : hor) 48 | 49 | -- start position, 50 | -- number of grid steps so far, 51 | -- cumulative vertical and horizontal segment lists 52 | move :: (Pos, Steps, Segments) -> Move -> (Pos, Steps, Segments) 53 | move ((x, y), steps, segs) (M dir dist) = 54 | (pos', steps', addSeg seg' segs) 55 | where 56 | (pos', min, max, other) = 57 | case dir of 58 | 'U' -> ((x, y + dist), y, (y + dist), x) 59 | 'D' -> ((x, y - dist), (y - dist), y, x) 60 | 'L' -> ((x - dist, y), (x - dist), x, y) 61 | 'R' -> ((x + dist, y), x, (x + dist), y) 62 | steps' = steps + dist 63 | seg' = S min max other dir steps 64 | 65 | -- In: vertical segment, horizontal segment 66 | -- Out: if they cross, position and grid steps to crossing 67 | cross :: (Seg, Seg) -> Maybe (Pos, Steps) 68 | cross (vert, hor) = 69 | if isCross vert hor 70 | then Just ( (sOth vert, sOth hor) 71 | , steps vert + steps hor + dx + dy) 72 | else Nothing 73 | where dx = case sDir hor of 74 | 'L' -> sMax hor - sOth vert 75 | 'R' -> sOth vert - sMin hor 76 | _ -> error "Bad cross" 77 | dy = case sDir vert of 78 | 'D' -> sMax vert - sOth hor 79 | 'U' -> sOth hor - sMin vert 80 | _ -> error "Bad cross" 81 | 82 | -- In: vertical segments, horizontal segments 83 | -- Out: list of positions and steps to crossing 84 | crosses :: [Seg] -> [Seg] -> [(Pos, Steps)] 85 | crosses vs hs = catMaybes $ fmap cross pairs 86 | where pairs = (,) <$> vs <*> hs 87 | 88 | manhDist :: Pos -> Int 89 | manhDist (x, y) = abs x + abs y 90 | 91 | main = do 92 | text <- readFile "Data3.txt" 93 | let ls = lines text 94 | let l1 = head ls 95 | let l2 = head (tail ls) 96 | --let l1 = test1 97 | --let l2 = test2 98 | let moves1 = fmap readMv $ splitOn "," l1 99 | let moves2 = fmap readMv $ splitOn "," l2 100 | 101 | let (_, _, segs1) = foldl move ((0, 0), 0, (Segs [] [])) moves1 102 | let (_, _, segs2) = foldl move ((0, 0), 0, (Segs [] [])) moves2 103 | -- we have lists of vertical/horizontal segments for each wire 104 | -- cross them all accordingly 105 | let cs = crosses (vert segs1) (hor segs2) 106 | ++ crosses (vert segs2) (hor segs1) 107 | 108 | let mDists = fmap (manhDist . fst) cs 109 | print $ minimum mDists 110 | 111 | let wireDist = fmap snd cs 112 | print $ minimum wireDist 113 | 114 | test1 = "R8,U5,L5,D3" 115 | test2 = "U7,R6,D4,L4" 116 | -------------------------------------------------------------------------------- /Day4.hs: -------------------------------------------------------------------------------- 1 | module Day4 where 2 | 3 | import Data.List 4 | 5 | -- General purpose reverse digitizer 6 | digitsR :: Integral a => a -> [a] 7 | digitsR = fmap snd 8 | . takeWhile (/= (0, 0)) 9 | . iterate (divMod10 . fst) 10 | . divMod10 11 | where divMod10 = flip divMod 10 12 | 13 | -- We'll work with reverse digit arrays 14 | -- so we check for non-increasing order 15 | 16 | isNonIncr :: [Int] -> Bool 17 | isNonIncr lst = all (\(a, b) -> a >= b) $ zip lst (tail lst) 18 | 19 | hasDouble :: [Int] -> Bool 20 | hasDouble lst = any (\(a, b) -> a == b) $ zip lst (tail lst) 21 | 22 | isGood :: Int -> Bool 23 | isGood n = isNonIncr ds && hasDouble ds 24 | where ds = digitsR n 25 | 26 | -- fromEnum turns False to 0 and True to 1 27 | countPasswds :: Int -> Int -> Int 28 | countPasswds from to = sum $ fmap (fromEnum . isGood) [from .. to] 29 | 30 | -- Chunk digits of a 6-digit number into groups of 4 31 | -- after putting sentinel non-digits on both sides 32 | chunk64 :: Int -> [[Int]] 33 | chunk64 = fmap (take 4) . take 5 . tails . bracket10 34 | where -- put (non-digit) 10 on both sides of the digit array as sentinels 35 | bracket10 n = 10 : digitsR n ++ [10] 36 | 37 | -- Two equal digits surrounded by other digits (or sentinels) 38 | isPureDouble (a:b:c:d:[]) = a /= b && b == c && c /= d 39 | isPureDouble x = error $ show x ++ "is not a four-letter word!" 40 | 41 | hasPureDoubles :: Int -> Bool 42 | hasPureDoubles n = or $ fmap isPureDouble $ chunk64 n 43 | 44 | countPasswds' :: Int -> Int -> Int 45 | countPasswds' from to = sum $ fmap isGood' [from .. to] 46 | where isGood' n = fromEnum (isGood n && hasPureDoubles n) 47 | 48 | main = do 49 | print $ countPasswds 264793 803935 50 | print $ countPasswds' 264793 803935 51 | -------------------------------------------------------------------------------- /Day5.hs: -------------------------------------------------------------------------------- 1 | module Day5 where 2 | 3 | import Data.List.Split 4 | import Data.Maybe 5 | import Data.Map as M 6 | import Control.Applicative 7 | import Control.Monad 8 | import Data.Either 9 | 10 | 11 | readInt :: String -> Int 12 | readInt s = read s 13 | 14 | newtype Addr = A { asValue :: Int } 15 | deriving (Eq, Ord, Show) 16 | 17 | addP :: Addr -> Int -> Addr 18 | addP (A p) off = A (p + off) 19 | 20 | -- Store the program as a map 21 | -- for quick random access 22 | type Prog = M.Map Addr Int 23 | 24 | getV :: Prog -> Addr -> Int 25 | getV prog p = 26 | fromJust $ M.lookup p prog 27 | 28 | getP :: Prog -> Addr -> Int -> Addr 29 | getP prog p off = A $ fromJust $ 30 | M.lookup (addP p off) prog 31 | 32 | putV :: Prog -> Addr -> Int -> Prog 33 | putV prog p v = M.insert p v prog 34 | 35 | mkProgram :: [Int] -> Prog 36 | mkProgram listing = 37 | M.fromList $ zip addressSpace listing 38 | where addressSpace = fmap A [0..] 39 | 40 | data Op = Plus | Times | In | Out | JumpT | JumpF | IsLess | IsEq | Stop 41 | deriving (Eq, Enum, Show) 42 | 43 | data Mode = Ref | Imm 44 | deriving (Enum, Show) 45 | 46 | -- Could use the state monad, but it's an overkill 47 | 48 | data Computer = Comp { output :: [Int] 49 | , ip :: Addr 50 | , program :: Prog 51 | } 52 | 53 | mkComputer :: Prog -> Computer 54 | mkComputer prog = Comp [] (A 0) prog 55 | 56 | 57 | -- The two lists contain offsets (from the IP) of inputs and outputs 58 | -- The lists may be empty, meaning no input or no output 59 | decode :: Int -> (Op, [Mode], [Int], [Int]) 60 | decode n = 61 | let op = opCode n 62 | in (op, modes n, fst (inout op), snd (inout op)) 63 | where 64 | inout :: Op -> ([Int], [Int]) 65 | inout op = case op of 66 | Plus -> ([1, 2], [3]) 67 | Times -> ([1, 2], [3]) 68 | In -> ([], [1]) 69 | Out -> ([1], []) 70 | JumpT -> ([1, 2], []) 71 | JumpF -> ([1, 2], []) 72 | IsLess-> ([1, 2], [3]) 73 | IsEq -> ([1, 2], [3]) 74 | Stop -> ([], []) 75 | opCode :: Int -> Op 76 | opCode 99 = Stop 77 | opCode x = toEnum $ x `mod` 100 - 1 78 | modes :: Int -> [Mode] 79 | modes x = fmap digitToMode [ x `div` 100 80 | , x `div` 1000 81 | , x `div` 10000 ] 82 | digitToMode :: Int -> Mode 83 | digitToMode = toEnum . fromEnum . odd 84 | 85 | -- First argument is external input 86 | exec :: Int -> Computer -> Either [Int] Computer 87 | exec i (Comp o ip prog) = 88 | let (opCode, modes, inOffs, outOffs) = decode $ getV prog ip 89 | ins = fmap (getP prog ip) inOffs 90 | outs = fmap (getP prog ip) outOffs 91 | args = fmap getM $ zip modes ins 92 | (o', mip, prog') = step opCode args outs 93 | -- If no jump, increment IP 94 | newIp = fromMaybe (addP ip (length inOffs + length outOffs + 1)) mip 95 | in if opCode == Stop 96 | then Left o 97 | else Right (Comp o' newIp prog') 98 | where 99 | -- takes opcode, values of inputs, and addresses of outputs (zero or one) 100 | -- returns new external output list, maybe new IP (if jump), and new program 101 | step :: Op -> [Int] -> [Addr] -> ([Int], Maybe Addr, Prog) 102 | step op args outs = 103 | case op of 104 | Plus -> ( o 105 | , Nothing 106 | , putV prog (head outs) (sum $ args)) 107 | Times -> ( o 108 | , Nothing 109 | , putV prog (head outs) (product $ args)) 110 | In -> ( o 111 | , Nothing 112 | , putV prog (head outs) i) 113 | Out -> ( (head args) : o 114 | , Nothing 115 | , prog) 116 | JumpT -> ( o 117 | , if head args /= 0 then Just $ A $ args!!1 else Nothing 118 | , prog) 119 | JumpF -> ( o 120 | , if head args == 0 then Just $ A $ args!!1 else Nothing 121 | , prog) 122 | IsLess-> ( o 123 | , Nothing 124 | , putV prog (head outs) 125 | (if args!!0 < args!!1 then 1 else 0)) 126 | IsEq -> ( o 127 | , Nothing 128 | , putV prog (head outs) 129 | (if args!!0 == args!!1 then 1 else 0)) 130 | getM :: (Mode, Addr) -> Int 131 | getM (Ref, p) = getV prog p 132 | getM (Imm, p) = asValue p 133 | 134 | -- iterate a Kleisli arrow 135 | iterateM_ :: Monad m => (a -> m a) -> a -> m b 136 | iterateM_ f = g 137 | where g = f >=> g 138 | 139 | run :: Prog -> Int -> [Int] 140 | run prog i = fromLeft [] $ iterateM_ (exec i) (mkComputer prog) 141 | 142 | main = do 143 | text <- readFile "Data5.txt" 144 | --let text = test' 145 | let listing = fmap readInt $ splitOn "," text 146 | let prog = mkProgram listing 147 | print $ run prog 5 148 | 149 | test = "1002,4,3,4,33" 150 | test''="3,3,1105,-1,9,1101,0,0,12,4,12,99,1" 151 | test' = "3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31,1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104,999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99" 152 | -------------------------------------------------------------------------------- /Day6.hs: -------------------------------------------------------------------------------- 1 | {-# language DeriveFunctor #-} 2 | {-# language TupleSections #-} 3 | 4 | module Day6 where 5 | 6 | import Data.List as L 7 | import Data.List.Split 8 | import Data.Maybe 9 | import Data.Map as M 10 | 11 | -- The whole recursion-schemes library I need 12 | 13 | newtype Fix f = Fix { unFix :: f (Fix f) } 14 | type Coalgebra f a = a -> f a 15 | ana :: Functor f => Coalgebra f a -> a -> Fix f 16 | ana coalg = Fix . fmap (ana coalg) . coalg 17 | type Algebra f a = f a -> a 18 | cata :: Functor f => Algebra f a -> Fix f -> a 19 | cata alg = alg . fmap (cata alg) . unFix 20 | hylo :: Functor f => Algebra f a -> Coalgebra f b -> b -> a 21 | hylo f g = f . fmap (hylo f g) . g 22 | 23 | -- Functor that generates the rose tree 24 | 25 | data TreeF a = NodeF String [a] 26 | deriving (Functor, Show) 27 | 28 | -- Rose tree 29 | type Tree = Fix TreeF 30 | 31 | -- A mulitmap: Who orbits a given name (directly) 32 | type Pool = M.Map String [String] 33 | 34 | -- Unfolding the tree top down 35 | 36 | mkNode :: Coalgebra TreeF (String, Pool) 37 | mkNode (key, pool) = 38 | case M.lookup key pool of 39 | Nothing -> NodeF key [] -- Leaf 40 | Just lst -> -- list of children 41 | let newPool = M.delete key pool 42 | in NodeF key (fmap ( , newPool) lst) -- tuple section 43 | 44 | -- Folding the tree bottom up 45 | 46 | -- The accumulator accumulates (#of children, # of orbits) 47 | 48 | orbits :: Algebra TreeF (Int, Int) 49 | orbits (NodeF _ lst) = 50 | (childCount, orbitCount + childCount) 51 | where childCount = sum $ fmap ((+1) . fst) lst 52 | orbitCount = sum $ fmap snd lst 53 | 54 | 55 | allOrbits = snd . hylo orbits mkNode . ("COM", ) 56 | 57 | -- Part II 58 | 59 | -- Folding the tree bottom up 60 | 61 | -- The accumulator 62 | data Accum = Acc { seenMe :: Bool 63 | , seenSa :: Bool 64 | , dist :: Int } 65 | deriving Show 66 | 67 | -- Combine info gathered from children 68 | 69 | meAndSanta :: Algebra TreeF Accum 70 | meAndSanta (NodeF name accums) 71 | | name == "YOU" || name == "SAN" 72 | = if name == "YOU" 73 | then if hasSanta accums 74 | then Acc True True (distToSa accums) 75 | else Acc True False 0 76 | else if hasMe accums 77 | then Acc True True (distToMe accums) 78 | else Acc False True 0 79 | where hasMe = or . fmap seenMe 80 | hasSanta = or . fmap seenSa 81 | distToMe = dist . fromJust . find seenMe 82 | distToSa = dist . fromJust . find seenSa 83 | 84 | meAndSanta (NodeF name accums) = -- neither YOU nor SANTA 85 | case (ixMe, ixSa) of 86 | (Nothing, Nothing) -> Acc False False (-1) 87 | (Nothing, Just idx2) -> Acc False True (1 + dist (accums!! idx2)) 88 | (Just idx1, Nothing) -> Acc True False (1 + dist (accums!! idx1)) 89 | (Just idx1, Just idx2) -> -- Both have been seen! 90 | if idx1 == idx2 -- in the same child tree 91 | then Acc True True ( dist (accums!! idx1)) 92 | else Acc True True ((dist (accums!! idx1)) + (dist (accums!! idx2))) 93 | where ixMe = L.findIndex seenMe accums 94 | ixSa = L.findIndex seenSa accums 95 | 96 | meetSanta = dist . hylo meAndSanta mkNode . ("COM", ) 97 | 98 | -- for testing only 99 | allOrbitsFromTree = cata orbits 100 | meetingFromTree = cata meAndSanta 101 | 102 | -- Show tree for debugging 103 | shTree :: Tree -> String 104 | shTree = cata showNode 105 | where 106 | showNode :: Algebra TreeF String 107 | showNode (NodeF s lst) = s ++ "->[" ++ intercalate "," lst ++ "]" 108 | 109 | -- A handy multimap function 110 | appendMulti :: (String, String) -> Pool -> Pool 111 | appendMulti (key, value) pool = 112 | case M.lookup key pool of 113 | Nothing -> M.insert key [value] pool 114 | Just lst -> M.insert key (value:lst) pool 115 | 116 | toPair :: [a] -> (a, a) 117 | toPair (a:b:[]) = (a, b) 118 | 119 | main = do 120 | text <- readFile "Data6.txt" 121 | --let text = unlines $ test2 122 | let pairs = fmap (toPair . splitOn ")") $ lines text 123 | --print pairs 124 | let pool = Prelude.foldl (\m kv -> appendMulti kv m) M.empty pairs 125 | --print pool 126 | --let tree = ana mkNode ("COM", pool) 127 | --putStrLn $ shTree tree 128 | print $ allOrbits pool 129 | print $ meetSanta pool 130 | 131 | test' = ["COM)B"] 132 | test'' = ["COM)B", "B)C", "B)D"] 133 | test = ["COM)B" 134 | , "B)C" 135 | , "C)D" 136 | , "D)E" 137 | , "E)F" 138 | , "B)G" 139 | , "G)H" 140 | , "D)I" 141 | , "E)J" 142 | , "J)K" 143 | , "K)L"] 144 | 145 | test2 = ["COM)B" 146 | ,"B)C" 147 | ,"C)D" 148 | ,"D)E" 149 | ,"E)F" 150 | ,"B)G" 151 | ,"G)H" 152 | ,"D)I" 153 | ,"E)J" 154 | ,"J)K" 155 | ,"K)L" 156 | ,"K)YOU" 157 | ,"I)SAN"] 158 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AoC2019 2 | Solutions to [Advent of Code 2019](https://adventofcode.com/2019) 3 | --------------------------------------------------------------------------------