{-# LANGUAGE LambdaCase #-}
import qualified Data.Map as M
import System.Environment (getArgs)
grid = M.fromList $ zip [(x, y) | y <- [1, 0, -1], x <- [-1, 0, 1]] [1 .. 9]
grid2 =
M.fromList $
concat
[ [((0, 2), '1')],
[((-1, 1), '2'), ((0, 1), '3'), ((1, 1), '4')],
[((-2, 0), '5'), ((-1, 0), '6'), ((0, 0), '7'), ((1, 0), '8'), ((2, 0), '9')],
[((-1, -1), 'A'), ((0, -1), 'B'), ((1, -1), 'C')],
[((0, -2), 'D')]
]
move = \case
'L' -> (-1, 0)
'R' -> (1, 0)
'U' -> (0, 1)
'D' -> (0, -1)
mmove g pos d = if M.member npos g then npos else pos
where
delta = move d
npos = (fst pos + fst delta, snd pos + snd delta)
p1 ns = tail $ map (grid M.!) $ scanl (foldl' (mmove grid)) (0, 0) ns
p2 ns = tail $ map (grid2 M.!) $ scanl (foldl' (mmove grid2)) (-2, 0) ns
main = do
args <- getArgs
n <- case args of
["-"] -> getContents
[file] -> readFile file
let f = lines n
print $ p1 f
print $ p2 fimport qualified Data.List as L import Data.List.Split (chunksOf, splitOn) import qualified Data.Text as T import System.Environment (getArgs)
strip = T.unpack . T.strip . T.pack
parse i = map read $ filter (not . null) $ map strip $ splitOn ” ” i
possible l = all test $ L.permutations l where test [a, b, c] = a + b > c
p1 = length . filter possible
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map parse $ lines n let f2 = chunksOf 3 $ concat $ L.transpose f print $ p1 f print $ p1 f2
import Data.Char import qualified Data.List as L import Data.List.Split (splitOn) import qualified Data.Map as M import qualified Data.Text as T import System.Environment (getArgs)
parse i = (ls, read r, init c) where parts = splitOn “-” i ls = concat $ init parts [r, c] = splitOn “[” (L.last parts)
freqs = M.fromListWith (+) . map (,1)
cksum m = take 5 $ map fst $ L.sortBy f $ M.toList m where f (a, f1) (b, f2) = compare f2 f1 <> compare a b
p1 it = sum $ map ((, b, ) -> b) $ filter solve it where solve (ls, room, c) = cksum (freqs ls) == c
decrypt n = map (chr . (+ 97) . (mod 26) . (+ n) .
flip (-) 97 . ord)
p2 it = L.find ((== “northpoleobjectstorage”) . fst) $ map ((a, b, _) -> (decrypt b a, b)) $ filter solve it where solve (ls, room, c) = cksum (freqs ls) == c
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map parse $ lines n print $ p1 f print $ p2 f
import qualified Crypto.Hash.MD5 as MD5 import qualified Data.ByteString.Base16 as B16 import Data.ByteString.Char8 (pack) import qualified Data.ByteString.Char8 as BS import qualified Data.List as L import qualified Data.Map as M import System.Environment (getArgs)
validHashes inp = [ h | f <- [0 ..], let h = BS.unpack $
B16.encode $ MD5.hash $ BS.pack $ inp ++ show f, “00000”
L.isPrefixOf h ]
p1 = take 8 . map (!! 5) . validHashes
p2 inp = M.elems $ go M.empty [ (pos, val) | h <-
validHashes inp, let pos = h !! 5, let val = h !! 6, pos
elem “01234567” ] where go seen ((p, v) : rest) |
length seen == 8 = seen | M.member p seen = go seen rest |
otherwise = go (M.insert p v seen) rest
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = init n print $ p1 f print $ p2 f
import qualified Data.List as L import qualified Data.Map as M import Data.Ord (comparing) import System.Environment (getArgs)
freqs = M.fromListWith (+) . map (,1)
highest = L.maximumBy (comparing snd) . M.toList
lowest = L.minimumBy (comparing snd) . M.toList
p1 = map (fst . highest . freqs)
p2 = map (fst . lowest . freqs)
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = L.transpose $ lines n putStrLn $ p1 f putStrLn $ p2 f
import qualified Data.Char as C import System.Environment (getArgs)
main = do args <- getArgs n <- case args of [“-”] ->
getContents [file] -> readFile file let f = map C.digitToInt $
init n l = length f print $ sum $ map fst $ filter (uncurry (==))
$ zip f (tail f ++ [head f]) print $ sum $ map fst $ filter
(uncurry (==)) $ zip f (drop (l div 2) (cycle f))
import Control.Arrow ((&&&)) import Data.List (maximum, minimum) import Data.List.Split (splitOn) import System.Environment (getArgs)
parse = map read . splitOn “
checksum = uncurry (-) . (maximum &&& minimum)
divisible ls = sum [x div y | x <- ls, y <-
ls, x rem y == 0, x /= y]
p1 = sum . map checksum
p2 = sum . map divisible
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map parse $ lines n print $ p1 f print $ p2 f
import Data.List (maximum, minimum) import Data.List.Split (splitOn) import System.Environment (getArgs)
ring = toInteger . ceiling . (/ 2) . subtract 1 . sqrt . fromInteger
p1 n = curr + mid where curr = ring n prev = (2 * curr - 1) ^ 2 mid = minimum $ map (abs . subtract n . (+ prev) . (* curr)) [1, 3, 5, 7]
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = read $ init n print $ p1 f
{-# LANGUAGE LambdaCase #-}
import qualified Data.Set as S import System.Environment (getArgs)
parse :: String -> Int parse (‘+’ : f) = read f parse f = read f
p1 = sum
p2 n = firstDup $ scanl1 (+) (cycle n)
firstDup = go S.empty where go seen (x : xs) = if S.member x seen then x else go (S.insert x seen) xs
main = do n <- fmap (map parse . lines) $ getArgs >>= -> getContents [file] -> readFile file print $ p1 n print $ p2 n
{-# LANGUAGE LambdaCase #-}
import qualified Data.Map as M import System.Environment (getArgs)
freqs = M.fromListWith (+) . map (,1)
p1 n = occurs 2 fqs * occurs 3 fqs where fqs = map freqs n occurs n = length . filter (not . M.null . M.filter (== n))
lev x y = sum [1 | (a, b) <- zip x y, a /= b]
p2 n = [(a, b) | a <- n, b <- n, a /= b, lev a b == 1]
main = do n <- fmap lines $ getArgs >>= -> getContents [file] -> readFile file print $ p1 n print $ p2 n
{-# LANGUAGE LambdaCase #-}
import Data.List.Split (splitOn) import qualified Data.Map as M import qualified Data.Set as S import System.Environment (getArgs)
parse :: String -> (Int, (Int, Int), (Int, Int)) parse l = (read (tail a), (read x, read y), (read w, read h)) where [a, b, c, d] = splitOn ” ” l [x, y] = splitOn “,” (init c) [w, h] = splitOn “x” d
grid = M.fromList [ ((x, y), []) | x <- [0 .. 999], y <- [0 .. 999] ]
claim grid (id, (x, y), (w, h)) = foldl conv grid subgrid where subgrid = [(x’, y’) | x’ <- [x .. x + w - 1], y’ <- [y .. y + h - 1]] conv g (x’, y’) = M.adjust (id :) (x’, y’) g
p1 n = M.size $ M.filter ((> 1) . length) $ foldl claim grid n
(-|-) x y = (x S.\ y) S.union (y S.\ x)
p2 n = a -|- seen where a = S.fromList $ map ((a, , ) -> a) n seen = foldl1 S.union $ map S.fromList $ M.elems $ M.filter ((> 1) . length) $ foldl claim grid n
main = do n <- fmap (map parse . lines) $ getArgs >>= -> getContents [file] -> readFile file print $ p1 n print $ p2 n
import System.Environment (getArgs)
p1 l = head [a * b | a <- l, b <- l, a + b == 2020]
p2 l = head [a * b * c | a <- l, b <- l, c <- l, a + b + c == 2020]
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map read $ lines n print $ p1 f print $ p2 f
import Data.Bits (xor) import Data.List.Split (splitOn) import System.Environment (getArgs)
parse i = (read l, read h, c’, p) where [r, c, p] = splitOn ” ” i [l, h] = splitOn “-” r c’ = head c
p1 = length . filter id . map solve where solve (l, u, c, p) = all ($ length $ filter (== c) p) [(>= l), (<= u)]
p2 = length . filter id . map solve where solve (l, u, c, p) = foldl1 xor $ map ((== c) . (p !!) . subtract 1) [l, u]
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map parse $ lines n print $ p1 f print $ p2 f
import System.Environment (getArgs)
countTrees right down ls = go (map cycle ls) where go [] = 0 go remaining@(r : rs) = fromEnum (head r == ‘#’) + go (map (drop right) (drop down remaining))
p1 = countTrees 3 1
p2 n = product [ countTrees 1 1 n, countTrees 3 1 n, countTrees 5 1 n, countTrees 7 1 n, countTrees 1 2 n ]
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = lines n print $ p1 f print $ p2 f
module Main where
import Data.Char (isDigit, isHexDigit) import Data.Map.Strict (Map, (!)) import qualified Data.Map.Strict as Map import System.Environment (getArgs) import Text.ParserCombinators.Parsec
bet k (l, u) = k >= l && k <= u
right (Right b) = b
requiredFields = [“byr”, “iyr”, “eyr”, “hgt”, “hcl”, “ecl”, “pid”]
eyeColors = [“amb”, “blu”, “brn”, “gry”, “grn”, “hzl”, “oth”]
block = cell sepBy oneOf ” ”
cell = do tag <- many lower char ‘:’ rest <- many (alphaNum <|> char ‘#’) return (tag, rest)
parseInput :: String -> Either ParseError (Map String String) parseInput s = Map.fromList <$> parse block “input” s
doCheck :: Map String String -> Bool doCheck ls = all
(Map.member ls) requiredFields
validByr s = bet (read s :: Int) (1920, 2002)
validIyr s = bet (read s :: Int) (2010, 2020)
validEyr s = bet (read s :: Int) (2020, 2030)
validEcl = flip elem eyeColors
validPid s = length s == 9 && all isDigit s
validHcl (‘#’ : rest) = length rest == 6 && all isHexDigit rest validHcl _ = False
validHgt s = let value = takeWhile isDigit s unit = dropWhile isDigit s height = (read value :: Int, unit) in case height of (v, “cm”) -> bet v (150, 193) (v, “in”) -> bet v (59, 76) _ -> False
doValidate :: Map String String -> Bool doValidate map = all ((s, v) -> v $ map ! s) ls where ls = [ (“byr”, validByr), (“iyr”, validIyr), (“eyr”, validEyr), (“hgt”, validHgt), (“hcl”, validHcl), (“ecl”, validEcl), (“pid”, validPid) ]
parseLines :: [String] -> [String] parseLines allLines = unwords first : next where (first, rest) = break null allLines next = if null rest then [] else parseLines (tail rest)
p1 = length . filter doCheck
p2 = length . filter doValidate . filter doCheck
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = parseLines $ lines n let blocks = map (right . parseInput) f print $ p1 blocks print $ p2 blocks
module Main where
import Data.Char (digitToInt) import Data.List (sort) import System.Environment (getArgs)
binaryToInt = foldl (x -> a * 2 + digitToInt x) 0
doValidate = binaryToInt . map readBin
readBin s | s elem “FL” = ‘0’ | otherwise =
‘1’
p1 = maximum . sort . map doValidate
p2 = (+ 1) . fst . head . dropWhile ((== 1) . uncurry subtract) . (zip <*> tail) . sort . map doValidate
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = lines n print $ p1 f print $ p2 f
import Data.List.Split (splitOn) import Data.Set (Set) import qualified Data.Set as Set import System.Environment (getArgs)
p1 = sum . map (Set.size . Set.fromList . filter (/= ‘’))
p2 = sum . map (Set.size . foldl1 Set.intersection . map Set.fromList . words)
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = splitOn “” n print $ p1 f print $ p2 f
import Data.Map (Map) import qualified Data.Map as Map import System.Environment (getArgs)
myBag = “shiny gold”
parseContained [] = [] parseContained (“no” : ) = [] parseContained (count : b : c : : rest) = (read count, unwords [b, c]) : parseContained rest
parseLine s = (leadingBag, parseContained trailingBags) where leadingBag = unwords (take 2 s) trailingBags = drop 4 s
canContain m outer = myBag elem inners || any
(canContain m) inners where inners = map snd $ m Map.! outer
countNested s m = foldl ((c, b) -> acc + c * (1 + countNested b m)) 0 $ m Map.! s
p1 q = length $ filter (canContain q . fst) $ Map.toList q
p2 = countNested myBag
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map (parseLine . words) $ lines n let q = Map.fromList f print $ p1 q print $ p2 q
module Main where
import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import System.Environment (getArgs)
type Op = (String, Int)
parseLine :: [String] -> Op parseLine [s, j] = (s, read (dropWhile (== ‘+’) j))
run :: Int -> Int -> Set Int -> Map Int Op -> Int run acc pc visited operations = if Set.member pc visited then acc else handleCase where visited’ = Set.insert pc visited handleCase = case Map.lookup pc operations of Just (“acc”, v) -> run (acc + v) (pc + 1) visited’ operations Just (“nop”, ) -> run acc (pc + 1) visited’ operations Just (“jmp”, j) -> run acc (pc + j) visited’ operations -> acc
doesEnd :: Int -> Int -> Set Int -> Map Int Op -> Bool doesEnd acc pc visited operations = not (Set.member pc visited) && handleCase where visited’ = Set.insert pc visited handleCase = case Map.lookup pc operations of Just (“acc”, v) -> doesEnd (acc + v) (pc + 1) visited’ operations Just (“nop”, ) -> doesEnd acc (pc + 1) visited’ operations Just (“jmp”, j) -> doesEnd acc (pc + j) visited’ operations -> True – pc has crossed the end!
genAll :: [Op] -> [[Op]] genAll [] = [] genAll (n@(“nop”, v) : rest) = ((“jmp”, v) : rest) : map (n :) (genAll rest) genAll (j@(“jmp”, v) : rest) = ((“nop”, v) : rest) : map (j :) (genAll rest) genAll (acc : rest) = map (acc :) $ genAll rest
p1 = run 0 0 mempty . Map.fromList . zip [0 ..]
p2 = p1 . head . filter (doesEnd 0 0 mempty . Map.fromList . zip [0 ..]) . genAll
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let f = map (parseLine . words) $ lines n print $ p1 f print $ p2 f
import Data.Bifunctor import Data.List (find, inits, sort, tails) import System.Environment (getArgs)
sublists = concatMap inits . tails
windows m = foldr (zipWith (:)) (repeat []) . take m . tails
doCheck preamble target = target elem [x + y | x
<- preamble, y <- preamble, x /= y]
checkAll = zipWith (t -> (t, doCheck p t))
findWeakness subs target = minimum t + maximum t where Just t = find ((== target) . sum) subs
p1 f = find (not . snd) $ checkAll (windows 25 f) (drop 25 f)
p2 f = findWeakness (sublists f) target where Just (target, _) = p1 f
main = do args <- getArgs n <- map read . lines <$> case args of [“-”] -> getContents [file] -> readFile file print $ p1 n print $ p2 n
import Control.Monad.Memo import Data.List (sort) import System.Environment (getArgs)
p1 s = product $ ($ q s) <$> [length . filter (== 1), length . filter (== 3)] where q = zipWith subtract <*> tail
p2 top s = startEvalMemo $ go 0 where go c | c == top = return
1 | otherwise = sum <$> mapM (memo go) (filter
(elem s) $ map (+ c) [1, 2, 3])
main = do args <- getArgs n <- map read . lines <$> case args of [“-”] -> getContents [file] -> readFile file let top = maximum n + 3 ls = sort (0 : top : n) print $ p1 ls print $ p2 top ls
import Data.List (sortOn) import Data.Map (Map, (!)) import qualified Data.Map as Map import Data.Maybe import System.Environment (getArgs)
dirs = [ (-1, -1), (0, -1), (1, -1), (-1, 0), (1, 0), (-1, 1), (0, 1), (1, 1) ]
makeGrid s = (grid, width, height) where rows = lines s grid = Map.fromList [((x, y), a) | (y, row) <- zip [0 ..] rows, (x, a) <- zip [0 ..] row] width = length (head rows) height = length rows
adjs1 m pt = length $ filter (== ‘#’) $ mapMaybe
((Map.lookup m) . add pt) dirs
inGrid (x, y) w h = x < w && x >= 0 && y < h && y >= 0
add (x, y) (a, b) = (x + a, y + b)
– [f, f.f, f.f.f, …] repeatF f = f : map (f .) (repeatF f)
bet k (l, u) = k >= l && k <= u
inside (p, q) (r, s) (a, b) = bet a (p, r) && bet b (q, s)
adjs2 grid pt w h = length $ filter ((== ‘#’) . head) $ filter (not . null) $ map ( dropWhile (== ‘.’) . map (grid !) . takeWhile (inside (0, 0) (w - 1, h - 1)) . map ($ pt) . repeatF . add ) dirs
rule1 w h m pt@(x, y) = if as == 0 then ‘#’ else ‘L’ where as = adjs2 m pt w h
rule2 w h m pt@(x, y) = if as >= 5 then ‘L’ else ‘#’ where as = adjs2 m pt w h
doStep w h m = Map.mapWithKey fn m where fn k ‘L’ = rule1 w h m k fn k ‘#’ = rule2 w h m k fn k ‘.’ = ‘.’
stepWhile prev w h | prev == next = next | otherwise = stepWhile next w h where next = doStep w h prev
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let (grid, width, height) = makeGrid n let solve1 = stepWhile grid width height print $ length $ filter ((== ‘#’) . snd) $ Map.toList solve1
import System.Environment (getArgs)
parseLine s = (head s, read (tail s) :: Float)
rotate (x, y) t = (nx, ny) where nx = x * cos (pi * t / 180) - y * sin (pi * t / 180) ny = x * sin (pi * t / 180) + y * cos (pi * t / 180)
p1 ls = sum $ map (round . abs) [fx, fy] where (fx, fy, _) = foldl fn (0.0, 0.0, 0.0) ls fn (x, y, rot) (‘N’, v) = (x, y + v, rot) fn (x, y, rot) (‘E’, v) = (x + v, y, rot) fn (x, y, rot) (‘W’, v) = (x - v, y, rot) fn (x, y, rot) (‘S’, v) = (x, y - v, rot) fn (x, y, rot) (‘R’, v) = (x, y, rot - v) fn (x, y, rot) (‘L’, v) = (x, y, rot + v) fn (x, y, rot) (‘F’, v) = (nx, ny, rot) where nx = x + v * cos (pi * rot / 180) ny = y + v * sin (pi * rot / 180)
p2 (sx, sy) ls = sum $ map (round . abs) [fx, fy] where (fx, fy, , ) = foldl fn (0.0, 0.0, sx, sy) ls fn (x, y, wx, wy) (‘N’, v) = (x, y, wx, wy + v) fn (x, y, wx, wy) (‘E’, v) = (x, y, wx + v, wy) fn (x, y, wx, wy) (‘W’, v) = (x, y, wx - v, wy) fn (x, y, wx, wy) (‘S’, v) = (x, y, wx, wy - v) fn (x, y, wx, wy) (‘R’, v) = (x, y, nwx, nwy) where (nwx, nwy) = rotate (wx, wy) (negate v) fn (x, y, wx, wy) (‘L’, v) = (x, y, nwx, nwy) where (nwx, nwy) = rotate (wx, wy) v fn (x, y, wx, wy) (‘F’, v) = (x + v * wx, y + v * wy, wx, wy)
main = do args <- getArgs n <- map parseLine . lines <$> case args of [“-”] -> getContents [file] -> readFile file print $ p1 n print $ p2 (10.0, 1.0) n
import Control.Monad (ap, zipWithM) import Data.Bifunctor import Data.List (sortOn) import Data.List.Split import Data.Tuple import System.Environment (getArgs)
egcd _ 0 = (1, 0) egcd a b = (t, s - q * t) where (s, t) = egcd
b r (q, r) = a quotRem b
modInv a b = case egcd a b of (x, y) | a * x + b * y == 1 -> Just x | otherwise -> Nothing
– from rosetta code chineseRemainder ls = zipWithM modInv
crtModulii modulii >>= (Just . (mod modPI) .
sum . zipWith () crtModulii . zipWith () residues) where
residues = map fst ls modulii = map snd ls modPI = product modulii
crtModulii = (modPI div) <$> modulii
earliest start ls = t * b where (t, b) = minimum $ map swap $
zip ap map (mod start) $ ls
p1 n = earliest (negate start) departs where start = read (head n) :: Int departs = map read $ filter (/= “x”) $ splitOn “,” (last n)
p2 n = chineseRemainder offs where offs = map (bimap negate read) $ filter ((/= “x”) . snd) $ zip [0 ..] $ splitOn “,” (last n)
main = do args <- getArgs n <- lines <$> case args of [“-”] -> getContents [file] -> readFile file print $ p1 n print $ p2 n
module Main where
import Data.Bifunctor (bimap) import Data.Char import Data.Either import Data.Map (Map) import qualified Data.Map as Map import Data.Strings import Numeric (readInt, showIntAtBase) import System.Environment (getArgs) import Text.Parsec.Char import Text.ParserCombinators.Parsec
data Stmt = Mask String | Mem Int Int deriving (Show)
parseMask :: Parser Stmt parseMask = string “mask =” >> Mask <$> many anyChar
parseNumber :: Parser Int parseNumber = read <$> many1 digit
parseMem :: Parser Stmt parseMem = Mem <$ string “mem[” <> parseNumber < string ”] =” <*> parseNumber
parseLine :: Parser Stmt parseLine = try parseMask <|> parseMem
applyMask :: Int -> String -> Int applyMask v m = fst $
head $ readInt 2 (elem “01”) digitToInt wm where bv =
strPadLeft ‘0’ 36 $ showIntAtBase 2 intToDigit v “” wm = zipWith
fn bv m fn o ‘X’ = o fn _ ‘1’ = ‘1’ fn _ ‘0’ = ‘0’
runProgram :: [Stmt] -> Int runProgram ls = sum regs where (mask, regs) = foldl fn (““, Map.empty) ls fn (_, regs) (Mask s) = (s, regs) fn (m, regs) (Mem idx val) = (m, Map.insert idx nval regs) where nval = applyMask val m
floatings :: String -> [String] floatings [] = [[]] floatings (‘X’ : xs) = floatings xs >>= (> [‘0’ : b, ‘1’ : b]) floatings (x : xs) = map (x :) $ floatings xs
genIdxs :: Int -> String -> [Int] genIdxs v m = map (fst
. head . readInt 2 (elem “01”) digitToInt) (floatings
wm) where bv = strPadLeft ‘0’ 36 $ showIntAtBase 2 intToDigit v “”
wm = zipWith fn bv m fn o ‘0’ = o fn _ ‘1’ = ‘1’ fn _ ‘X’ =
‘X’
v2chip :: [Stmt] -> Int v2chip ls = sum regs where (mask, regs) = foldl fn (““, Map.empty) ls fn (_, regs) (Mask s) = (s, regs) fn (m, regs) (Mem idx val) = (m, nmap) where idxs = genIdxs idx m nmap = flip Map.union regs $ Map.fromList $ map (,val) idxs
main = do args <- getArgs n <- rights . map (parse parseLine “main”) . lines <$> case args of [“-”] -> getContents [file] -> readFile file print $ runProgram n print $ v2chip n
module Main where
import Data.List.Split import qualified Data.Map as M import Data.Maybe import System.Environment (getArgs)
run ls start input = fst $ foldl fn (start, startMap) ls where startMap = M.fromList $ zip input [1 ..] fn (last, seen) i = (i - last’, seen’) where last’ = fromMaybe i (M.lookup last seen) seen’ = M.insert last i seen
main = do args <- getArgs n <- map read . splitOn “,” <$> case args of [“-”] -> getContents [file] -> readFile file
– holy off-by-one errors print $ run [8 .. 2020 - 1] 0 n print $ run [8 .. 30000000 - 1] 0 n
module Main where
import Control.Monad (liftM2) import Data.Function (on) import Data.List (sortBy) import Data.List.Split (splitOn) import Data.Map (Map, (!)) import qualified Data.Map as Map import Data.Set (Set, (\)) import qualified Data.Set as Set import System.Environment (getArgs) import Text.Parsec.Char import Text.ParserCombinators.Parsec
type Constraint = ((Int, Int), (Int, Int))
parseNumber = read <$> many1 digit
parseBound = (,) <$> parseNumber <* char ‘-’ <*> parseNumber
parseConstraint = (,) <$> parseBound <* string ” or ” <*> parseBound
parseConstraints = (manyTill anyChar (string “:”) *>
parseConstraint) sepBy newline
parseTicket = parseNumber sepBy char ‘,’
parseNears = string “nearby tickets:” > newline
> parseTicket sepBy newline
parseMine = string “your ticket:” > newline > parseTicket
parseInput s = do let (p : q : r : _) = splitOn “” s (,,) <$> parse parseConstraints “cs” p <> parse parseMine “mine” q <> parse parseNears “nears” r
bet k (l, u) = k >= l && k <= u
(|+) = liftM2 (||)
within (a, b) = flip bet a |+ flip bet b
findInvalid cs = filter (> not $ any (within t)
cs)
isValid cs = all (> any (within t) cs)
validFor :: [Constraint] -> [Int] -> Set Int validFor cs
items = foldl1 Set.intersection (map vcf items) where vcf i =
Set.fromList [idx | (cons, idx) <- zip cs [0 ..], cons
within i]
main = do args <- getArgs n <- parseInput <$> case
args of [“-”] -> getContents [file] -> readFile file let
Right (cs, mine, nears) = n validTickets = filter (isValid cs)
nears cols = map (-> map (!! i) validTickets) [0 .. length cs -
1] possibleCons = sortBy (compare on (Set.size .
snd)) $ zip [0 ..] $ map (validFor cs) cols corresp = Map.fromList
$ map ((i, v) -> (head $ Set.toList v, i)) $ (head possibleCons
:) $ zipWith fn <*> tail $ possibleCons where fn (i, s) (i’,
s’) = (i’, s’ \ s) print $ sum $ concatMap (findInvalid cs) nears
print $ product $ map ((mine !!) . (corresp !)) [0 .. 5]
module Main where
import Control.Monad import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import System.Environment (getArgs)
toBool ‘#’ = True toBool ‘.’ = False
gridMap s = M.fromList [ ((x, y, 0, 0), toBool a) | (y, row) <- zip [0 ..] rows, (x, a) <- zip [0 ..] row ] where rows = lines s
around (x, y, z, w) = [ (x + x’, y + y’, z + z’, w + w’) | x’ <- [-1 .. 1], y’ <- [-1 .. 1], z’ <- [-1 .. 1], w’ <- [-1 .. 1], (x’, y’, z’, w’) /= (0, 0, 0, 0) ]
convert True 2 = True convert True 3 = True convert False 3 = True convert _ _ = False
doStep m = M.mapWithKey fn $ m <> M.fromList [(p, False) | p <- concatMap around (M.keys m)] where fn pos v = convert v n where n = length $ filter id $ map (fromMaybe False . flip M.lookup m) $ around pos
p1 grid = M.size $ M.filter id (iterate doStep grid !! 6)
p2 grid = M.size $ M.filter id (iterate doStep grid !! 6)
main = do args <- getArgs n <- case args of [“-”] -> getContents [file] -> readFile file let grid = gridMap n print $ p1 grid print $ p2 grid
{-# LANGUAGE LambdaCase #-}
import Data.List (tails) import System.Environment (getArgs)
main = do n <- fmap (map read . lines) $ getArgs >>= -> getContents [file] -> readFile file print $ p1 n print $ p2 n
p1 = length . filter (uncurry (<)) . (zip <*> tail)
p2 = p1 . map (sum . take 3) . tails
{-# LANGUAGE LambdaCase #-}
import System.Environment (getArgs)
ans1 = foldl mv (0, 0) where mv (f, d) [“forward”, i] = (f + read i, d) mv (f, d) [“up”, i] = (f, d - read i) mv (f, d) [“down”, i] = (f, d + read i) mv x _ = x
ans2 = foldl mv (0, 0, 0) where mv (f, d, a) [“forward”, i] = (f + read i, d + a * read i, a) mv (f, d, a) [“up”, i] = (f, d, a - read i) mv (f, d, a) [“down”, i] = (f, d, a + read i) mv x _ = x
main = do n <- fmap (map words . lines) $ getArgs >>= -> getContents [file] -> readFile file print $ uncurry (*) $ ans1 n print $ ((f, d, _) -> f * d) $ ans2 n
{-# LANGUAGE LambdaCase #-}
import Data.Char (digitToInt) import Data.List (transpose) import Data.Map (Map) import qualified Data.Map as M import System.Environment (getArgs)
bitsOfString = map (== ‘1’)
intOfBits = foldl (x -> a * 2 + if x then 1 else 0) 0
binaryToInt = foldl (x -> a * 2 + digitToInt x) 0
freqs = M.fromListWith (+) . map (,1)
mostCommon l = ones m >= zeroes m where ones = (M.! True) zeroes = (M.! False) m = freqs l
leastCommon = not . mostCommon
type Stepper = [Bool] -> Bool
step :: Stepper -> [String] -> Int -> [String] step stepper ls n = filter (-> bitsOfString l !! n == filterFn n) ls where filterFn n = stepper . bitsOfString $ map (!! n) ls
oxygen ls = head $ head $ dropWhile ((/= 1) . length) $ scanl (step mostCommon) ls [0 ..]
co2 ls = head $ head $ dropWhile ((/= 1) . length) $ scanl (step leastCommon) ls [0 ..]
ans1 = map (mostCommon . bitsOfString) . transpose
main = do n <- fmap lines $ getArgs >>= -> getContents [file] -> readFile file let one = ans1 n γ = intOfBits one ε = intOfBits $ map not one o = binaryToInt $ oxygen n co = binaryToInt $ co2 n print $ γ * ε print $ o * co
{-# LANGUAGE LambdaCase #-}
import Control.Monad (join) import Data.List (find, transpose) import Data.List.Split (splitOn) import Data.Maybe (isJust) import System.Environment (getArgs) import Text.Parsec.Char import Text.ParserCombinators.Parsec
parseInt :: Parser Int parseInt = read <$> (spaces *> many1 digit)
parseNums :: Parser [Int] parseNums = parseInt
sepBy char ‘,’
parseBoardLine :: Parser [Int] parseBoardLine = parseInt
sepBy many1 (char ’ ’)
type Board = [[Int]]
parseBoard :: Parser Board parseBoard = parseBoardLine
sepBy newline
parseInput :: Parser ([Int], [Board]) parseInput = do nums
<- parseNums <* newline boards <- parseBoard
sepBy newline return (nums, boards)
doParse :: Parser a -> String -> a doParse parser input = v where Right v = parse parser “input” input
isVictor board = any row board || any row (transpose board) where row = all (== -1)
score :: Board -> Int score = sum . concatMap (filter (> 0))
stepBoard call = map squish where squish = map (-> if x == call then -1 else x)
doRound boards call = map (stepBoard call) boards
doRound2 boards call = filter (not . isVictor) $ doRound boards call
victor :: Int -> [Board] -> Maybe Int victor call boards = (* call) . score <$> find isVictor boards
ans1 boards calls = join $ find isJust $ map (uncurry victor) $ zip (0 : calls) (scanl doRound boards calls)
ans2 boards calls = head $ dropWhile (null . snd) $ reverse $ zip calls (scanl doRound2 boards calls)
main = do n <- fmap (splitOn “”) $ getArgs >>= -> getContents [file] -> readFile file let calls = doParse parseNums $ head n boards = map (filter (not . null) . doParse parseBoard) (tail n) print $ ans1 boards calls print $ ((call, boards) -> (* call) $ score $ stepBoard call (head boards)) $ ans2 boards calls
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad (liftM2) import Data.Functor ((<&>)) import Data.List.Split (splitOn) import Data.Map (Map) import qualified Data.Map as M import System.Environment (getArgs)
parse n = ((a, b), (c, d)) where [a, b, c, d] = map read $ concatMap (splitOn “,”) $ splitOn ” -> ” n
doRange ((a, b), (c, d)) | a == c = map (a,) r2 | b == d = map (,b) r1 | otherwise = zip r1 r2 where r1 = if a < c then [a .. c] else [a, a - 1 .. c] r2 = if b < d then [b .. d] else [b, b - 1 .. d]
freqs = M.fromListWith (+) . map (,1)
solve = M.size . M.filter (> 1) . freqs . concatMap doRange
p1 = solve . filter (isHor |+ isVer) where isVer ((a, ), (c, )) = a == c isHor ((, b), (, d)) = b == d
p2 = solve
(|+) = liftM2 (||)
main = do n <- fmap (map parse . lines) $ getArgs >>= -> getContents [file] -> readFile file print $ p1 n print $ p2 n
{-# LANGUAGE LambdaCase #-}
import Data.List.Split (splitOn) import qualified Data.Map as M import Data.Maybe (fromMaybe) import System.Environment (getArgs)
grow m = M.insertWith (+) 6 new . M.insertWith (+) 8 new . M.mapKeys pred . M.delete 0 $ m where new = fromMaybe 0 $ M.lookup 0 m
main = do n <- fmap (map read . splitOn “,”) $ getArgs >>= -> getContents [file] -> readFile file let fish = M.fromListWith (+) $ map (,1) n print $ sum $ iterate grow fish !! 80 print $ sum $ iterate grow fish !! 256
{-# LANGUAGE LambdaCase #-}
import Data.List.Split (splitOn) import qualified Data.Map as M import Data.Maybe (fromMaybe) import System.Environment (getArgs)
cost1 = abs
cost2 d = (d * d + abs d) div 2
solve cost n = minimum [sum (map (cost . subtract p) n) | p <- [minimum n .. maximum n]]
main = do n <- fmap (map read . splitOn “,”) $ getArgs >>= -> getContents [file] -> readFile file print $ solve cost1 n print $ solve cost2 n
{-# LANGUAGE LambdaCase #-}
import Data.Char (digitToInt) import Data.List (sortBy) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import Data.Ord (Down (Down), comparing) import qualified Data.Ord import qualified Data.Set as S import System.Environment (getArgs)
grid lines = M.fromList [ ((x, y), digitToInt d) | (y, l) <- zip [0 ..] lines, (x, d) <- zip [0 ..] l ]
around (x, y) = [(x + dx, y + dy) | (dx, dy) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]]
minimas g = M.filterWithKey minima g where minima k a = a < minimum (mapMaybe (g M.!?) (around k))
– generic bfs bfs :: (Num n, Ord a) => (a -> [a]) ->
[a] -> [(a, n)] bfs next s = go S.empty (map (,0) s) where go _
[] = [] go seen ((x, dist) : xs) | x S.member seen =
go seen xs | otherwise = (x, dist) : go (S.insert x seen) (xs ++
map (,dist + 1) (next x))
basin g m = bfs search [m] where search k = [a | a <- around k, Just v <- [M.lookup a g], v /= 9]
main = do n <- fmap lines $ getArgs >>= -> getContents [file] -> readFile file let g = grid n let m = minimas g print $ sum m + length m print $ product $ take 3 $ sortBy (comparing Down) $ length . basin g <$> M.keys m
{-# LANGUAGE LambdaCase #-}
import System.Environment (getArgs)
main = do n <- fmap lines $ getArgs >>= -> getContents [file] -> readFile file print n