summaryrefslogtreecommitdiff
path: root/advent.hs
diff options
context:
space:
mode:
Diffstat (limited to 'advent.hs')
-rw-r--r--advent.hs888
1 files changed, 888 insertions, 0 deletions
diff --git a/advent.hs b/advent.hs
new file mode 100644
index 0000000..0fe8404
--- /dev/null
+++ b/advent.hs
@@ -0,0 +1,888 @@
+
+import System.IO.Unsafe (unsafePerformIO)
+import Data.List (sort,nub,isInfixOf,permutations,sortBy,group,groupBy,transpose)
+import Data.List.Split (splitWhen)
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Digest.Pure.MD5 (md5)
+import Data.Char (isDigit)
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import qualified Data.Word as W
+import qualified Data.Vector as V
+import Data.Bits (complement, (.&.), (.|.), shiftL, shiftR)
+import Control.Monad.State.Strict
+import Control.Parallel.Strategies
+import qualified Data.HashMap.Strict as HM
+import Data.Aeson
+import Data.Maybe (fromJust)
+import qualified Data.Text as T
+import Debug.Trace (trace)
+
+
+
+printday :: (Show a, Show b) => Int -> a -> b -> [String]
+printday dayn v1 v2 = ["Day " ++ (show dayn), show v1, show v2]
+
+-- Day 1
+
+day1_input :: String
+day1_input = takeWhile (/= '\n') $ unsafePerformIO (readFile "advent-day-1.input")
+
+day1_1 :: String -> Int
+day1_1 [] = 0
+day1_1 (h:t) = (if h == '(' then 1 else -1) + (day1_1 t)
+
+day1_2 :: Int
+day1_2 = (length (takeWhile (>= (0 :: Int)) (day1_2_l day1_input 0))) + 1
+ where
+ day1_2_l :: String -> Int -> [Int]
+ day1_2_l [] _ = []
+ day1_2_l (h:t) l = loc : (day1_2_l t loc)
+ where
+ loc = (if h == '(' then 1 else -1) + l
+
+printday_1 :: [String]
+printday_1 = printday 1 (day1_1 day1_input) day1_2
+
+-- Day 2
+
+day2_input :: [(Int,Int,Int)]
+day2_input = map s_tuple s_sorted
+ where
+ s_input :: [String]
+ s_input = lines $ unsafePerformIO (readFile "advent-day-2.input")
+ s_entries :: [[String]]
+ s_entries = map (splitWhen (=='x')) s_input
+ s_numbers :: [[Int]]
+ s_numbers = map (map read) s_entries
+ s_sorted :: [[Int]]
+ s_sorted = map sort s_numbers
+ s_tuple :: [Int] -> (Int,Int,Int)
+ s_tuple (a:b:c:_) = (a,b,c)
+ s_tuple _ = undefined
+
+day2_1 :: Int
+day2_1 = sum (map papersize day2_input)
+ where
+ papersize :: (Int,Int,Int) -> Int
+ papersize (a,b,c) = (2*a*b) + (2*a*c) + (2*b*c) + (a*b)
+
+day2_2 :: Int
+day2_2 = sum (map ribbonlength day2_input)
+ where
+ ribbonlength :: (Int,Int,Int) -> Int
+ ribbonlength (a,b,c) = (a+a+b+b) + (a*b*c)
+
+printday_2 :: [String]
+printday_2 = printday 2 day2_1 day2_2
+
+-- Day 3
+
+day3_input :: String
+day3_input = takeWhile (/= '\n') $ unsafePerformIO (readFile "advent-day-3.input")
+
+day3_visits :: String -> [(Int,Int)]
+day3_visits = scanl visit (0 :: Int,0 :: Int)
+ where
+ visit :: (Int,Int) -> Char -> (Int,Int)
+ visit (x,y) '^' = (x,y+1)
+ visit (x,y) 'v' = (x,y-1)
+ visit (x,y) '<' = (x-1,y)
+ visit (x,y) '>' = (x+1,y)
+ visit _ _ = undefined
+
+
+
+day3_1 :: Int
+day3_1 = length $ nub (day3_visits day3_input)
+
+day3_2 :: Int
+day3_2 = length $ nub all_houses
+ where
+ santa_instructions :: String -> String
+ santa_instructions (a:_:t) = a : (santa_instructions t)
+ santa_instructions _ = []
+ robo_instructions :: String -> String
+ robo_instructions (_:b:t) = b : (robo_instructions t)
+ robo_instructions _ = []
+ santa_houses :: [(Int,Int)]
+ santa_houses = day3_visits (santa_instructions day3_input)
+ robo_houses :: [(Int,Int)]
+ robo_houses = day3_visits (robo_instructions day3_input)
+ all_houses = santa_houses ++ robo_houses
+
+printday_3 :: [String]
+printday_3 = printday 3 day3_1 day3_2
+
+-- Day 4
+
+day4_input :: B.ByteString
+day4_input = B.pack $ takeWhile (/= '\n') $ unsafePerformIO (readFile "advent-day-4.input")
+
+day4_1 :: Int
+day4_1 = length $ takeWhile (not . hashgood) hashes
+ where
+ hashgood :: String -> Bool
+ hashgood (a:b:c:d:e:_) = (a == '0') && (b == '0') && (c == '0') && (d == '0') && (e == '0')
+ hashgood _ = False
+ hashes :: [String]
+ hashes = map hash [0..]
+ hash :: Int -> String
+ hash n = show $ md5 (B.append day4_input numbs)
+ where
+ numbs :: B.ByteString
+ numbs = B.pack $ show n
+
+day4_2 :: Int
+day4_2 = length $ takeWhile (not . hashgood) hashes
+ where
+ hashgood :: String -> Bool
+ hashgood (a:b:c:d:e:f:_) = (a == '0') && (b == '0') && (c == '0') && (d == '0') && (e == '0') && (f == '0')
+ hashgood _ = False
+ hashes :: [String]
+ hashes = map hash [0..]
+ hash :: Int -> String
+ hash n = show $ md5 (B.append day4_input numbs)
+ where
+ numbs :: B.ByteString
+ numbs = B.pack $ show n
+
+printday_4 :: [String]
+printday_4 = printday 4 day4_1 day4_2
+
+-- Day 5
+
+day5_input :: [String]
+day5_input = lines $ unsafePerformIO (readFile "advent-day-5.input")
+
+day5_1 :: Int
+day5_1 = length $ filter nice_1 day5_input
+ where
+ nice_1 :: String -> Bool
+ nice_1 s = (vowelcount_3 s) && (doubleletter s) && (not $ has_naughty s)
+ vowels :: String
+ vowels = "aeiou"
+ vowelcount_3 :: String -> Bool
+ vowelcount_3 = not . (< 3) . length . (filter (`elem` vowels))
+ doubleletter :: String -> Bool
+ doubleletter (a:b:t) = (a == b) || (doubleletter (b:t))
+ doubleletter _ = False
+ naughty_pairs :: [String]
+ naughty_pairs = ["ab","cd","pq","xy"]
+ has_naughty :: String -> Bool
+ has_naughty s' = (any id) $ (map (`isInfixOf` s') naughty_pairs)
+
+
+day5_2 :: Int
+day5_2 = length $ filter nice_2 day5_input
+ where
+ nice_2 :: String -> Bool
+ nice_2 s = (doublepair s) && (repeat_letter s)
+ doublepair :: String -> Bool
+ doublepair (a:b:t) = ((a:[b]) `isInfixOf` t) || (doublepair (b:t))
+ doublepair _ = False
+ repeat_letter :: String -> Bool
+ repeat_letter (a:b:c:t) = (a == c) || (repeat_letter (b:c:t))
+ repeat_letter _ = False
+
+printday_5 :: [String]
+printday_5 = printday 5 day5_1 day5_2
+
+-- Day 6
+
+data Day6InsnCode = TurnOn | Toggle | TurnOff deriving (Eq,Show)
+data Day6Insn = Day6Insn Day6InsnCode [(Int,Int)] deriving (Show)
+
+day6_input :: [Day6Insn]
+day6_input = map insn textlines
+ where
+ textlines :: [String]
+ textlines = lines $ unsafePerformIO (readFile "advent-day-6.input")
+ textinsn :: String -> String
+ textinsn = takeWhile (not . isDigit)
+ insncode :: String -> Day6InsnCode
+ insncode s
+ | s == "turn on " = TurnOn
+ | s == "turn off " = TurnOff
+ | otherwise = Toggle
+ textcoord1 :: String -> String
+ textcoord1 = takeWhile (/= ' ') . dropWhile (not . isDigit)
+ textcoord2 :: String -> String
+ textcoord2 = tail . dropWhile (/= ' ') . dropWhile (/= 'h')
+ coord :: String -> (Int,Int)
+ coord s = (read textx, read texty)
+ where
+ textx = takeWhile (/= ',') s
+ texty = tail . dropWhile (/= ',') $ s
+ coordset :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
+ coordset (x1,y1) (x2,y2) = coordlist
+ where
+ coordlist = [(x,y) | x <- [x1..x2], y <- [y1..y2]]
+ insn :: String -> Day6Insn
+ insn s = Day6Insn ((insncode . textinsn) s) (coordset ((coord . textcoord1) s) ((coord . textcoord2) s))
+
+
+day6_1 :: Int
+day6_1 = length . S.toList $ result
+ where
+ followinsn :: S.Set (Int,Int) -> Day6Insn -> S.Set (Int,Int)
+ followinsn cur (Day6Insn code mid')
+ | code == TurnOn = S.union cur mid
+ | code == TurnOff = S.difference cur mid
+ | otherwise = S.union (S.difference cur mid) (S.difference mid cur)
+ where
+ mid = S.fromList mid'
+ result = foldl followinsn (S.fromList []) day6_input
+
+-- ttotd, compile this with optimisation or it'll fail awfully slowly indeed
+-- and you want threads enabled so gc can happen in parallel.
+
+day6_2 :: Int
+day6_2 = sum $ map snd $ M.toList result
+ where
+ result :: M.Map (Int,Int) Int
+ result = foldl followinsn (M.fromList []) day6_input
+ followinsn :: M.Map (Int,Int) Int -> Day6Insn -> M.Map (Int,Int) Int
+ followinsn cur (Day6Insn code mid)
+ | code == TurnOn = foldl inc cur mid
+ | code == TurnOff = foldl dec cur mid
+ | otherwise = foldl tog cur mid
+ inc m coord = M.insert coord v m
+ where
+ v' = maybe 0 id (M.lookup coord m)
+ v = v' + 1
+ dec m coord = M.insert coord v m
+ where
+ v' = maybe 0 id (M.lookup coord m)
+ v = if v' == 0 then 0 else (v' - 1)
+ tog m coord = M.insert coord v m
+ where
+ v' = maybe 0 id (M.lookup coord m)
+ v = v' + 2
+
+printday_6 :: [String]
+printday_6 = printday 6 day6_1 day6_2
+
+-- Day 7
+
+data Day7WireOrValue = Wire String | Value W.Word16 deriving (Show)
+data Day7Op = OpSet | OpAnd | OpOr | OpLShift | OpRShift | OpNot deriving (Eq, Show)
+data Day7Rule = Day7Rule Day7Op Day7WireOrValue Day7WireOrValue deriving (Show)
+
+day7_input :: M.Map String Day7Rule
+day7_input = M.fromList $ map rulefromline textlines
+ where
+ textlines :: [String]
+ textlines = lines $ unsafePerformIO (readFile "advent-day-7.input")
+ rulefromline :: String -> (String,Day7Rule)
+ rulefromline s = case op of
+ OpSet -> (target, Day7Rule op (wv 0) (wv 0))
+ OpNot -> (target, Day7Rule op (wv 1) (wv 1))
+ _ -> (target, Day7Rule op (wv 0) (wv 2))
+ where
+ lineelems = words s
+ target = last lineelems
+ op
+ | length lineelems == 3 = OpSet
+ | length lineelems == 4 = OpNot
+ | otherwise = op'
+ where
+ opstr = lineelems !! 1
+ op'
+ | opstr == "AND" = OpAnd
+ | opstr == "OR" = OpOr
+ | opstr == "LSHIFT" = OpLShift
+ | opstr == "RSHIFT" = OpRShift
+ | otherwise = undefined
+ wv n = if isnum then Value num else Wire wordn
+ where
+ wordn = lineelems !! n
+ num = (read wordn) :: W.Word16
+ isnum = (head wordn) `elem` "0123456789"
+
+
+day7_runrule :: String -> State (M.Map String W.Word16) W.Word16
+day7_runrule s = do
+ m <- get
+ if (M.member s m)
+ then return (m M.! s)
+ else do
+ v <- runrule' (day7_input M.! s)
+ m' <- get
+ let m'' = M.insert s v m'
+ put m''
+ return v
+ where
+ valueof :: Day7WireOrValue -> State (M.Map String W.Word16) W.Word16
+ valueof (Wire q) = day7_runrule q
+ valueof (Value v) = return v
+ runrule' :: Day7Rule -> State (M.Map String W.Word16) W.Word16
+ runrule' (Day7Rule op left right)
+ | op == OpSet = lvalue
+ | op == OpNot = lvalue >>= return . complement
+ | op == OpAnd = (liftM2 (.&.)) lvalue rvalue
+ | op == OpOr = (liftM2 (.|.)) lvalue rvalue
+ | op == OpLShift = (liftM2 shiftL) lvalue (rvalue >>= return . fromIntegral)
+ | op == OpRShift = (liftM2 shiftR) lvalue (rvalue >>= return . fromIntegral)
+ | otherwise = undefined
+ where
+ lvalue = valueof left
+ rvalue = valueof right
+
+
+day7_1 :: W.Word16
+day7_1 = evalState (day7_runrule "a") (M.empty)
+
+day7_2 :: W.Word16
+day7_2 = evalState (day7_runrule "a") (M.fromList [("b",956 :: W.Word16)])
+
+printday_7 :: [String]
+printday_7 = printday 7 day7_1 day7_2
+
+-- Day 8
+
+day8_input :: [String]
+day8_input = lines $ unsafePerformIO (readFile "advent-day-8.input")
+
+day8_1 :: Int
+day8_1 = codesize - memsize
+ where
+ codesize = sum . (map length) $ day8_input
+ memsize = sum . (map (memsize' . stripq)) $ day8_input
+ stripq = tail . init
+ memsize' (a:b:t)
+ | a == '\\' && b == '\\' = 1 + memsize' t
+ | a == '\\' && b == '"' = 1 + memsize' t
+ | a == '\\' && b == 'x' = 1 + memsize' (tail . tail $ t)
+ | b == '\\' = 1 + memsize' (b:t)
+ | otherwise = 2 + memsize' t
+ memsize' (_:[]) = 1
+ memsize' [] = 0
+
+day8_2 :: Int
+day8_2 = encsize - codesize
+ where
+ codesize = sum . (map length) $ day8_input
+ encsize = sum . (map encsize') $ day8_input
+ encsize' (a:t)
+ | a == '\\' = 2 + encsize' t
+ | a == '"' = 2 + encsize' t
+ | otherwise = 1 + encsize' t
+ encsize' [] = 2
+
+printday_8 :: [String]
+printday_8 = printday 8 day8_1 day8_2
+
+-- Day 9
+
+day9_input :: [((String,String),Int)]
+day9_input = map mapper rawinput
+ where
+ rawinput = lines $ unsafePerformIO (readFile "advent-day-9.input")
+ mapper s = ((p1,p2),d)
+ where
+ w = words s
+ p1 = w !! 0
+ p2 = w !! 2
+ d = read $ (w !! 4)
+
+day9_places :: [String]
+day9_places = S.toList pset
+ where
+ pset1 = S.fromList (map (fst.fst) day9_input)
+ pset2 = S.fromList (map (snd.fst) day9_input)
+ pset = S.union pset1 pset2
+
+day9_distances :: M.Map (String,String) Int
+day9_distances = M.fromList pmap
+ where
+ pmap1 = day9_input
+ pmap2 = map flipplaces day9_input
+ where
+ flipplaces ((p1,p2),d) = ((p2,p1),d)
+ pmap = pmap1 ++ pmap2
+
+day9_routes :: [[String]]
+day9_routes = filter hasRoute (permutations day9_places)
+ where
+ hasRoute :: [String] -> Bool
+ hasRoute (a:b:t)
+ | M.member (a,b) day9_distances = hasRoute (b:t)
+ | otherwise = False
+ hasRoute (_:[]) = True
+ hasRoute [] = False
+
+day9_routelen :: [String] -> Int
+day9_routelen (a:b:t) = day9_routelen (b:t) + (day9_distances M.! (a,b))
+day9_routelen _ = 0
+
+day9_1 :: Int
+day9_1 = day9_routelen (head sorted)
+ where
+ sorted = sortBy routecmp day9_routes
+ routecmp :: [String] -> [String] -> Ordering
+ routecmp a b = (day9_routelen a) `compare` (day9_routelen b)
+
+day9_2 :: Int
+day9_2 = day9_routelen (last sorted)
+ where
+ sorted = sortBy routecmp day9_routes
+ routecmp :: [String] -> [String] -> Ordering
+ routecmp a b = (day9_routelen a) `compare` (day9_routelen b)
+
+printday_9 :: [String]
+printday_9 = printday 9 day9_1 day9_2
+
+-- Day 10
+
+day10_input :: String
+day10_input = head . lines $ unsafePerformIO (readFile "advent-day-10.input")
+
+day10_readstep :: String -> String
+day10_readstep s = readout
+ where
+ dgs = group s
+ readout = concatMap readout' dgs
+ readout' :: String -> String
+ readout' dg = (show . length $ dg) ++ ((head dg):[])
+
+day10_1 :: Int
+day10_1 = length result
+ where
+ result :: String
+ result = foldl (\s _ -> day10_readstep s) day10_input ([1..40] :: [Int])
+
+day10_2 :: Int
+day10_2 = length result
+ where
+ result :: String
+ result = foldl (\s _ -> day10_readstep s) day10_input ([1..50] :: [Int])
+
+printday_10 :: [String]
+printday_10 = printday 10 day10_1 day10_2
+
+-- Day 11
+
+day11_input :: String
+day11_input = head . lines $ unsafePerformIO (readFile "advent-day-11.input")
+
+day11_incword :: String -> String
+day11_incword = reverse . nextstr . reverse
+ where
+ nextch :: Char -> Char
+ nextch a
+ | a == 'z' = 'a'
+ | a == 'h' = 'j'
+ | a == 'n' = 'p'
+ | a == 'k' = 'm'
+ | otherwise = succ a
+ nextstr :: String -> String
+ nextstr (a:t)
+ | na == 'a' = 'a' : (nextstr t)
+ | otherwise = na : t
+ where
+ na = nextch a
+ nextstr [] = []
+
+day11_wordok1 :: String -> Bool
+day11_wordok1 s
+ | 'i' `elem` s = False
+ | 'o' `elem` s = False
+ | 'l' `elem` s = False
+ | otherwise = (hastriple s) && (haspairs s)
+ where
+ hastriple (a:b:c:t)
+ | (c == (succ b)) && (b == (succ a)) = True
+ | otherwise = hastriple (b:c:t)
+ hastriple _ = False
+ haspairs (a:b:t)
+ | a == b = haspair t
+ | otherwise = haspairs (b:t)
+ where
+ haspair (a:b:t)
+ | a == b = True
+ | otherwise = haspair (b:t)
+ haspair _ = False
+ haspairs _ = False
+
+day11_nextpw :: String -> String
+day11_nextpw in' = head . (filter day11_wordok1) $ (possibles in')
+ where
+ possibles s = ns : (possibles ns)
+ where
+ ns = day11_incword s
+
+day11_1 :: String
+day11_1 = day11_nextpw day11_input
+
+
+day11_2 :: String
+day11_2 = day11_nextpw day11_1
+
+printday_11 :: [String]
+printday_11 = printday 11 day11_1 day11_2
+
+-- Day 12
+
+day12_input :: Maybe Object
+day12_input = decode $ unsafePerformIO (B.readFile "advent-day-12.input")
+
+day12_1 :: Int
+day12_1 = sumVal $ Object (fromJust day12_input)
+ where
+ sumVal :: Value -> Int
+ sumVal (Array a) = sum . (map sumVal) $ V.toList a
+ sumVal (Object o) = sum . (map sumVal) $ HM.elems o
+ sumVal (Number n) = floor $ read (show n)
+ sumVal _ = 0
+
+day12_2 :: Int
+day12_2 = sumVal $ Object (fromJust day12_input)
+ where
+ sumVal :: Value -> Int
+ sumVal (Array a) = sum . (map sumVal) $ V.toList a
+ sumVal (Object o)
+ | (String (T.pack "red")) `elem` (HM.elems o) = 0
+ | otherwise = sum . (map sumVal) $ HM.elems o
+ sumVal (Number n) = floor $ read (show n)
+ sumVal _ = 0
+
+
+printday_12 :: [String]
+printday_12 = printday 12 day12_1 day12_2
+
+-- Day 13
+
+day13_input :: M.Map String (M.Map String Int)
+day13_input = M.fromList entries
+ where
+ textlines = lines $ unsafePerformIO (readFile "advent-day-13.input")
+ entries :: [(String,M.Map String Int)]
+ entries = map (\(a,b) -> (a,M.fromList b)) entries'
+ entries' :: [(String,[(String,Int)])]
+ entries' = map splitoff rawentries'
+ splitoff :: [(String,String,Int)] -> (String,[(String,Int)])
+ splitoff xs = (fst' . head $ xs, map (\(_,a,b) -> (a,b)) xs)
+ fst' (a,_,_) = a
+ rawentries' :: [[(String,String,Int)]]
+ rawentries' = groupBy cmpfst rawentries
+ cmpfst (a,_,_) (b,_,_) = a == b
+ rawentries :: [(String,String,Int)]
+ rawentries = map linetoentry textlines
+ linetoentry :: String -> (String,String,Int)
+ linetoentry s = (from,to,net)
+ where
+ s' = words s
+ from = s' !! 0
+ to = init (s' !! 10)
+ net = sign * (read $ s' !! 3)
+ sign
+ | (s' !! 2) == "gain" = 1
+ | otherwise = -1
+
+day13_people :: [String]
+day13_people = M.keys day13_input
+
+day13_1 :: Int
+day13_1 = last $ sort . (map layoutcost) $ layouts
+ where
+ layouts = permutations day13_people
+ layoutcost l@(f:_) = layoutcost' f l
+ layoutcost' f (a:r@(b:_)) = (paircost' a b) + layoutcost' f r
+ layoutcost' f (b:[]) = paircost' f b
+ paircost' a b = (a' M.! b) + (b' M.! a)
+ where
+ a' = day13_input M.! a
+ b' = day13_input M.! b
+
+
+day13_2 :: Int
+day13_2 = last $ sort . (map layoutcost) $ layouts
+ where
+ layouts = permutations ("Player":day13_people)
+ layoutcost l@(f:_) = layoutcost' f l
+ layoutcost' f (a:r@(b:_)) = (paircost' a b) + layoutcost' f r
+ layoutcost' f (b:[]) = paircost' f b
+ paircost' a b = (a' M.! b) + (b' M.! a)
+ where
+ a' = day13_input' M.! a
+ b' = day13_input' M.! b
+ day13_input' :: M.Map String (M.Map String Int)
+ day13_input' = M.fromList (day13_extra:(map day13_change day13_ser))
+ where
+ day13_ser = M.toList day13_input
+ day13_extra = ("Player", M.fromList $ map (\s -> (s, 0)) $ day13_people)
+ day13_change (s,ma) = (s,M.insert "Player" 0 ma)
+
+printday_13 :: [String]
+printday_13 = printday 13 day13_1 day13_2
+
+-- Day 14
+
+day14_input :: [(String,Int,Int,Int)]
+day14_input = map extract textlines
+ where
+ textlines = lines $ unsafePerformIO (readFile "advent-day-14.input")
+ extract s' = (s !! 0, read (s !! 3), read (s !! 6), read (s !! 13))
+ where
+ s = words s'
+
+deerpos :: (String,Int,Int,Int) -> Int -> Int
+deerpos (_,speed,for,rest) t' = deerpos' 0 t'
+ where
+ deerpos' cur t
+ | t == 0 = cur
+ | t <= for = cur + (speed * t)
+ | otherwise = deerpos'' (cur + (speed * for)) (t - for)
+ deerpos'' cur t
+ | t == 0 = cur
+ | t <= rest = cur
+ | otherwise = deerpos' cur (t - rest)
+
+day14_1 :: Int
+day14_1 = last . sort $ map deerpos' day14_input
+ where
+ deerpos' d = deerpos d 2503
+
+day14_2 :: Int
+day14_2 = last . sort $ scorers'
+ where
+ scoresat n = sortBy (\(_,b) (_,d) -> d `compare` b) $ map (\d -> (d,deerpos d n)) day14_input
+ topscoreat = snd . head . scoresat
+ scorersat n = map (\(name,_,_,_) -> name) leadingdeer
+ where
+ leadingdeer = map fst $ takeWhile (\(_,s) -> s == topscoreat n) $ scoresat n
+ scorers' = map (length) . group . sort $ concatMap scorersat [1..2503]
+
+printday_14 :: [String]
+printday_14 = printday 14 day14_1 day14_2
+
+-- Day 15
+
+day15_input :: [(String,Int,Int,Int,Int,Int)]
+day15_input = map mapl rawtextlines
+ where
+ rawtextlines = lines $ unsafePerformIO (readFile "advent-day-15.input")
+ name = takeWhile (/= ':')
+ capa s = read $ takeWhile (/= ',') $ (words s) !! 2
+ dura s = read $ takeWhile (/= ',') $ (words s) !! 4
+ flav s = read $ takeWhile (/= ',') $ (words s) !! 6
+ texr s = read $ takeWhile (/= ',') $ (words s) !! 8
+ cals s = read $ (words s) !! 10
+ mapl s = (name s, capa s, dura s, flav s, texr s, cals s)
+
+day15_spoons :: [[Int]]
+day15_spoons = possibles [] (length day15_input)
+ where
+ possibles pfx left
+ | left == 1 = [ pfx ++ [lim] ]
+ | otherwise = concatMap (uncurry possibles) [ (res',left - 1) | res' <- res ]
+ where
+ tot = sum pfx
+ lim
+ | tot < 100 = 100 - tot
+ | otherwise = 0
+ res = [ pfx ++ [v] | v <- [0..lim] ]
+
+day15_recipescore :: [Int] -> Int
+day15_recipescore = satprod . transpose . rawscores
+ where
+ rawscores :: [Int] -> [[Int]]
+ rawscores recipe = map ingrscore $ zip recipe day15_input
+ ingrscore :: (Int,(String,Int,Int,Int,Int,Int)) -> [Int]
+ ingrscore (sval,(_,c,d,f,t,_)) = [sval * c, sval * d, sval * f, sval * t]
+ satprod :: [[Int]] -> Int
+ satprod = product . (map (\v -> if (v < 0) then 0 else v)) . (map sum)
+
+day15_calories :: [Int] -> Int
+day15_calories = calcount
+ where
+ calcount recipe = sum . (map caltot) $ zip recipe day15_input
+ caltot (sval,(_,_,_,_,_,cal)) = sval * cal
+
+day15_1 :: Int
+day15_1 = last . sort $ allscores
+ where
+ allscores = map day15_recipescore day15_spoons
+
+day15_2 :: Int
+day15_2 = last . sort $ okayscores
+ where
+ okayscores = map day15_recipescore okayspoons
+ okayspoons = filter (\a -> (day15_calories a) == 500) day15_spoons
+
+printday_15 :: [String]
+printday_15 = printday 15 day15_1 day15_2
+
+-- Day 16
+
+day16_input :: M.Map String (M.Map String Int)
+day16_input = M.fromList $ map facts rawlines
+ where
+ rawlines = lines $ unsafePerformIO (readFile "advent-day-16.input")
+ suenr :: [String] -> String
+ suenr ws = takeWhile (/= ':') (ws !! 1)
+ fact ws n = (key,read val)
+ where
+ key = takeWhile (/= ':') (ws !! (2 * n))
+ val = takeWhile (/= ',') (ws !! ((2 * n) + 1))
+ facts' ws = [fact ws n | n <- [1,2,3]]
+ facts s = (suenr ws, M.fromList (facts' ws))
+ where
+ ws = words s
+
+day16_facts1 :: M.Map String Int
+day16_facts1 = M.fromList [ ("children", 3)
+ , ("cats", 7)
+ , ("samoyeds", 2)
+ , ("pomeranians", 3)
+ , ("akitas", 0)
+ , ("vizslas", 0)
+ , ("goldfish", 5)
+ , ("trees", 3)
+ , ("cars", 2)
+ , ("perfumes", 1)
+ ]
+
+day16_suematch1 :: M.Map String Int -> M.Map String Int -> Bool
+day16_suematch1 sue facts = all id matches
+ where
+ knownkeys = M.keys sue
+ suematch k = (facts M.! k) == (sue M.! k)
+ matches = map suematch knownkeys
+
+day16_1 :: String
+day16_1 = fst . head $ matchingsues
+ where
+ sues = M.toList day16_input
+ suematches (_,facts) = day16_suematch1 facts day16_facts1
+ matchingsues = filter suematches sues
+
+day16_suematch2 :: M.Map String Int -> M.Map String Int -> Bool
+day16_suematch2 sue facts = all id matches
+ where
+ knownkeys = M.keys sue
+ suematch k = factcompare k (facts M.! k) (sue M.! k)
+ matches = map suematch knownkeys
+ factcompare k val sueval
+ | (k == "cats") = val < sueval
+ | (k == "trees") = val < sueval
+ | (k == "pomeranians") = sueval < val
+ | (k == "goldfish") = sueval < val
+ | otherwise = val == sueval
+
+day16_2 :: String
+day16_2 = fst . head $ matchingsues
+ where
+ sues = M.toList day16_input
+ suematches (_,facts) = day16_suematch2 facts day16_facts1
+ matchingsues = filter suematches sues
+
+printday_16 :: [String]
+printday_16 = printday 16 day16_1 day16_2
+
+-- Day 17
+
+day17_input :: [Int]
+day17_input = (map read) . lines $ unsafePerformIO (readFile "advent-day-17.input")
+
+day17_possible_combos :: [[Int]]
+day17_possible_combos = filterM (\_ -> [True,False]) day17_input
+
+day17_1 :: Int
+day17_1 = length $ filter (== 150) combosizes
+ where
+ combosizes = map sum day17_possible_combos
+
+day17_2 :: Int
+day17_2 = length allsmall
+ where
+ combosizes = map (\x -> (sum x, length x)) day17_possible_combos
+ okaycombos = filter (\(s,_) -> s == 150) combosizes
+ smallest = minimum . (map snd) $ okaycombos
+ allsmall = filter (\(_,s) -> s == smallest) okaycombos
+
+printday_17 :: [String]
+printday_17 = printday 17 day17_1 day17_2
+
+-- Day 18
+
+day18_input :: S.Set (Int,Int)
+day18_input = S.fromList . (concatMap linetotoks) $ numblines
+ where
+ rawlines = lines $ unsafePerformIO (readFile "advent-day-18.input")
+ numblines = zip rawlines [1..]
+ linetotoks (l,ln) = map (\(_,v) -> (ln,v)) filled
+ where
+ ln' = zip l [1..]
+ filled = filter (\(a,_) -> a == '#') ln'
+
+day18_rule1 :: S.Set (Int,Int) -> Int -> Int -> Bool
+day18_rule1 grid x y
+ | current && (around == 2) = True
+ | current && (around == 3) = True
+ | (not current) && (around == 3) = True
+ | otherwise = False
+ where
+ ingrid v = v `S.member` grid
+ current = ingrid (x,y)
+ around' = [(x-1,y-1),(x-1,y),(x-1,y+1)
+ ,(x,y-1),(x,y+1)
+ ,(x+1,y-1),(x+1,y),(x+1,y+1)]
+ around = length $ filter id $ map ingrid around'
+
+day18_runstep1 :: S.Set (Int,Int) -> S.Set (Int,Int)
+day18_runstep1 curgrid = S.fromList . (filter inclcoord) $ allcoords
+ where
+ allcoords = [(x,y) | x <- [1..100], y <- [1..100]]
+ inclcoord (x,y) = day18_rule1 curgrid x y
+
+day18_1 :: Int
+day18_1 = length $ S.toList grid
+ where
+ grid = foldl (\s _ -> day18_runstep1 s) day18_input ([1..100] :: [Int])
+
+day18_corners :: S.Set (Int,Int)
+day18_corners = S.fromList [(1,1),(1,100),(100,1),(100,100)]
+
+day18_runstep2 :: S.Set (Int,Int) -> S.Set (Int,Int)
+day18_runstep2 curgrid = (day18_runstep1 curgrid) `S.union` day18_corners
+
+day18_2 :: Int
+day18_2 = length $ S.toList grid
+ where
+ grid = foldl (\s _ -> day18_runstep2 s) (day18_input `S.union` day18_corners) ([1..100] :: [Int])
+
+printday_18 :: [String]
+printday_18 = printday 18 day18_1 day18_2
+
+-- Outputs
+
+alldays :: [String]
+alldays =
+ printday_1 ++
+ printday_2 ++
+ printday_3 ++
+ printday_4 ++
+ printday_5 ++
+ printday_6 ++
+ printday_7 ++
+ printday_8 ++
+ printday_9 ++
+ printday_10 ++
+ printday_11 ++
+ printday_12 ++
+ printday_13 ++
+ printday_14 ++
+ printday_15 ++
+ printday_16 ++
+ printday_17 ++
+ printday_18
+
+alldayspar :: [String]
+alldayspar = alldays `using` parList rdeepseq
+
+allmain :: IO ()
+allmain = forM_ alldayspar putStrLn
+
+main = allmain