eldridge.cam
Advent of Code solutions
Add '2020/' from commit 'bc02824b94de54a209bc688e0acbb5497c66c4c0'
git-subtree-dir: 2020
git-subtree-mainline: e369e6ebeffd88172dada5d12ad1556e55c62a85
git-subtree-split: bc02824b94de54a209bc688e0acbb5497c66c4c0
+13
2020/.gitignore
+13
2020/.gitignore
+9
2020/1/p1.hs
+9
2020/1/p1.hs
+6
2020/1/p2.hs
+6
2020/1/p2.hs
+15
2020/10/p1.hs
+15
2020/10/p1.hs
···
1
+
import Data.List
2
+
3
+
differences :: [Int] -> [Int]
4
+
differences (x : y : xs) = (y - x) : differences (y : xs)
5
+
differences _ = []
6
+
7
+
onesandthrees :: (Int, Int) -> Int -> (Int, Int)
8
+
onesandthrees (o, t) 1 = (o + 1, t)
9
+
onesandthrees (o, t) 3 = (o, t + 1)
10
+
onesandthrees (o, t) _ = (o, t)
11
+
12
+
main :: IO ()
13
+
main = do
14
+
adaptors <- sort . fmap read . lines <$> getContents
15
+
print $ uncurry (*) $ foldl onesandthrees (0, 1) (differences (0 : adaptors))
+20
2020/10/p2.hs
+20
2020/10/p2.hs
···
1
+
import Data.List
2
+
import Data.Maybe
3
+
4
+
compute :: [Int] -> [(Int, Int)]
5
+
compute adaptors = computeInner [(0, 1)] adaptors
6
+
where
7
+
prev n p = fromMaybe 0 $ lookup n p
8
+
computeInner :: [(Int, Int)] -> [Int] -> [(Int, Int)]
9
+
computeInner p [] = p
10
+
computeInner p (a : as) =
11
+
let next = prev (a - 1) p + prev (a - 2) p + prev (a - 3) p in
12
+
computeInner ((a, next) : p) as
13
+
14
+
main :: IO ()
15
+
main = do
16
+
adaptors <- sort . fmap read . lines <$> getContents
17
+
let
18
+
device = maximum adaptors + 3
19
+
levels = compute (adaptors ++ [device])
20
+
in print $ fromJust $ lookup device levels
+31
2020/11/p1.hs
+31
2020/11/p1.hs
···
1
+
import Control.Monad
2
+
3
+
data Seat = Occupied | Unoccupied deriving (Eq)
4
+
5
+
seat '.' = Nothing
6
+
seat 'L' = Just Unoccupied
7
+
seat '#' = Just Occupied
8
+
seat _ = error "invalid seat"
9
+
10
+
isOccupied :: Maybe Seat -> Bool
11
+
isOccupied (Just Occupied) = True
12
+
isOccupied _ = False
13
+
14
+
compute :: [[Maybe Seat]] -> Int
15
+
compute seats = if seats == nextSeats
16
+
then length $ filter isOccupied (join seats)
17
+
else compute nextSeats
18
+
where
19
+
nextSeats = fmap (uncurry updateRow) ([0..] `zip` seats)
20
+
updateRow i row = fmap (uncurry (updateSeat i)) ([0..] `zip` row)
21
+
updateSeat _ _ Nothing = Nothing
22
+
updateSeat i j (Just seat) = case length $ filter isOccupied $ adjacent i j of
23
+
0 -> Just Occupied
24
+
l | l >= 4 -> Just Unoccupied
25
+
_ -> Just seat
26
+
adjacent i j = [seats !! y !! x | y <- [i-1..i+1], x <- [j-1..j+1], x >= 0, y >= 0, y < length seats, x < length (seats !! y), (y, x) /= (i, j)]
27
+
28
+
main :: IO ()
29
+
main = do
30
+
seats <- fmap (fmap seat) . lines <$> getContents
31
+
print $ compute seats
+43
2020/11/p2.hs
+43
2020/11/p2.hs
···
1
+
import Control.Monad
2
+
import Data.Functor
3
+
import Data.List
4
+
import Data.Maybe
5
+
6
+
data Seat = Occupied | Unoccupied deriving (Eq, Show)
7
+
8
+
seat '.' = Nothing
9
+
seat 'L' = Just Unoccupied
10
+
seat '#' = Just Occupied
11
+
seat _ = error "invalid seat"
12
+
13
+
isOccupied :: Maybe Seat -> Bool
14
+
isOccupied (Just Occupied) = True
15
+
isOccupied _ = False
16
+
17
+
(!?) :: [a] -> Int -> Maybe a
18
+
(!?) ls i | i >= 0 && i < length ls = Just (ls !! i)
19
+
(!?) _ _ = Nothing
20
+
21
+
compute :: [[Maybe Seat]] -> Int
22
+
compute seats = if seats == nextSeats
23
+
then length $ filter isOccupied (join seats)
24
+
else compute nextSeats
25
+
where
26
+
nextSeats = fmap (uncurry updateRow) ([0..] `zip` seats)
27
+
updateRow i row = fmap (uncurry (updateSeat i)) ([0..] `zip` row)
28
+
updateSeat _ _ Nothing = Nothing
29
+
updateSeat i j (Just seat) = case length $ filter isOccupied $ visible i j of
30
+
0 -> Just Occupied
31
+
l | l >= 5 -> Just Unoccupied
32
+
_ -> Just seat
33
+
visible i j = join . find isJust <$> takeRay i j <$> directions
34
+
directions = [(dy, dx) | dy <- [-1..1], dx <- [-1..1], (dx, dy) /= (0, 0)]
35
+
takeRay :: Int -> Int -> (Int, Int) -> [Maybe Seat]
36
+
takeRay y x (dy, dx) = fromMaybe [] (seats !? ny >>= (!? nx) <&> (: takeRay ny nx (dy, dx)))
37
+
where ny = y + dy
38
+
nx = x + dx
39
+
40
+
main :: IO ()
41
+
main = do
42
+
seats <- fmap (fmap seat) . lines <$> getContents
43
+
print $ compute seats
+57
2020/12/p1.hs
+57
2020/12/p1.hs
···
1
+
data Direction = DN | DE | DS | DW deriving (Show, Eq)
2
+
3
+
l :: Direction -> Direction
4
+
l DN = DW
5
+
l DW = DS
6
+
l DS = DE
7
+
l DE = DN
8
+
9
+
r :: Direction -> Direction
10
+
r DW = DN
11
+
r DS = DW
12
+
r DE = DS
13
+
r DN = DE
14
+
15
+
data Instruction
16
+
= N Int
17
+
| E Int
18
+
| S Int
19
+
| W Int
20
+
| R Int
21
+
| L Int
22
+
| F Int
23
+
deriving (Show, Eq)
24
+
25
+
parse :: String -> Instruction
26
+
parse ('N' : rest) = N (read rest)
27
+
parse ('E' : rest) = E (read rest)
28
+
parse ('S' : rest) = S (read rest)
29
+
parse ('W' : rest) = W (read rest)
30
+
parse ('R' : rest) = R (read rest `div` 90)
31
+
parse ('L' : rest) = L (read rest `div` 90)
32
+
parse ('F' : rest) = F (read rest)
33
+
parse _ = error "Invalid instruction"
34
+
35
+
run :: [Instruction] -> (Direction, Int, Int) -> (Direction, Int, Int)
36
+
run [] = id
37
+
run (i : is) = run is . apply i
38
+
39
+
apply :: Instruction -> (Direction, Int, Int) -> (Direction, Int, Int)
40
+
apply (N n) (d, x, y) = (d, x, y + n)
41
+
apply (F n) (DN, x, y) = (DN, x, y + n)
42
+
apply (S n) (d, x, y) = (d, x, y - n)
43
+
apply (F n) (DS, x, y) = (DS, x, y - n)
44
+
apply (E n) (d, x, y) = (d, x + n, y)
45
+
apply (F n) (DE, x, y) = (DE, x + n, y)
46
+
apply (W n) (d, x, y) = (d, x - n, y)
47
+
apply (F n) (DW, x, y) = (DW, x - n, y)
48
+
apply (L 0) h = h
49
+
apply (L n) (d, x, y) = apply (L $ n - 1) (l d, x, y)
50
+
apply (R 0) h = h
51
+
apply (R n) (d, x, y) = apply (R $ n - 1) (r d, x, y)
52
+
53
+
main :: IO ()
54
+
main = do
55
+
instructions <- fmap parse . lines <$> getContents
56
+
let (_, x, y) = run instructions (DE, 0, 0) in
57
+
print $ abs x + abs y
+48
2020/12/p2.hs
+48
2020/12/p2.hs
···
1
+
data Instruction
2
+
= N Int
3
+
| E Int
4
+
| S Int
5
+
| W Int
6
+
| R Int
7
+
| L Int
8
+
| F Int
9
+
deriving (Show, Eq)
10
+
11
+
l :: Pos -> Pos
12
+
l (x, y) = (-y, x)
13
+
14
+
r :: Pos -> Pos
15
+
r (x, y) = (y, -x)
16
+
17
+
parse :: String -> Instruction
18
+
parse ('N' : rest) = N (read rest)
19
+
parse ('E' : rest) = E (read rest)
20
+
parse ('S' : rest) = S (read rest)
21
+
parse ('W' : rest) = W (read rest)
22
+
parse ('R' : rest) = R (read rest `div` 90)
23
+
parse ('L' : rest) = L (read rest `div` 90)
24
+
parse ('F' : rest) = F (read rest)
25
+
parse _ = error "Invalid instruction"
26
+
27
+
type Pos = (Int, Int)
28
+
29
+
run :: [Instruction] -> (Pos, Pos) -> (Pos, Pos)
30
+
run [] = id
31
+
run (i : is) = run is . apply i
32
+
33
+
apply :: Instruction -> (Pos, Pos) -> (Pos, Pos)
34
+
apply (N n) ((x, y), p) = ((x, y + n), p)
35
+
apply (S n) ((x, y), p) = ((x, y - n), p)
36
+
apply (E n) ((x, y), p) = ((x + n, y), p)
37
+
apply (W n) ((x, y), p) = ((x - n, y), p)
38
+
apply (L 0) h = h
39
+
apply (L n) (w, p) = apply (L $ n - 1) (l w, p)
40
+
apply (R 0) h = h
41
+
apply (R n) (w, p) = apply (R $ n - 1) (r w, p)
42
+
apply (F n) ((dx, dy), (x, y)) = ((dx, dy), (x + dx * n, y + dy * n))
43
+
44
+
main :: IO ()
45
+
main = do
46
+
instructions <- fmap parse . lines <$> getContents
47
+
let (_, (x, y)) = run instructions ((10, 1), (0, 0)) in
48
+
print $ abs x + abs y
+20
2020/13/p1.hs
+20
2020/13/p1.hs
···
1
+
import Data.List
2
+
import Data.Ord
3
+
4
+
split :: Eq a => a -> [a] -> [[a]]
5
+
split x ys = splitInner x [] ys
6
+
where
7
+
splitInner _ [] [] = []
8
+
splitInner _ r [] = [reverse r]
9
+
splitInner x r (y : ys)
10
+
| x == y = reverse r : splitInner x [] ys
11
+
| otherwise = splitInner x (y : r) ys
12
+
13
+
main :: IO ()
14
+
main = do
15
+
[arrival, buses] <- lines <$> getContents
16
+
let
17
+
start = read arrival
18
+
intervals = [read n | n <- split ',' buses, n /= "x"] :: [Int]
19
+
waits = [(n, n - start `mod` n) | n <- intervals]
20
+
in print . uncurry (*) $ minimumBy (comparing snd) waits
+26
2020/13/p2.hs
+26
2020/13/p2.hs
···
1
+
import Data.Function
2
+
import Data.List
3
+
import Data.Maybe
4
+
import Text.Parsec
5
+
6
+
int :: Parsec String u Int
7
+
int = read <$> many1 digit
8
+
9
+
parseBuses = ((Just <$> int) <|> (char 'x' >> return Nothing)) `sepBy` char ','
10
+
11
+
answer :: [Maybe Int] -> Int
12
+
answer buses = answer_ offset distance $ tail toFind
13
+
where
14
+
toFind = catMaybes $ zipWith (\i b -> (i,) <$> b) [0 :: Int ..] buses
15
+
(offset, distance) = head toFind
16
+
17
+
answer_ n m [] = m - n
18
+
answer_ n d all@((i, m) : rest)
19
+
| n `mod` m == i `mod` m = answer_ n (d * m) rest
20
+
| otherwise = answer_ (n + d) d all
21
+
22
+
main :: IO ()
23
+
main = do
24
+
[_, busstr] <- lines <$> getContents
25
+
let Right buses = parse parseBuses "" busstr
26
+
in print $ answer buses
+49
2020/14/p1.hs
+49
2020/14/p1.hs
···
1
+
{-# LANGUAGE ViewPatterns #-}
2
+
import Data.List
3
+
import Data.Bits
4
+
5
+
split :: Eq a => [a] -> [a] -> [[a]]
6
+
split x ys = splitInner x [] ys
7
+
where
8
+
splitInner _ [] [] = []
9
+
splitInner _ r [] = [reverse r]
10
+
splitInner x r (stripPrefix x -> Just ys) = reverse r : splitInner x [] ys
11
+
splitInner x r (y : ys) = splitInner x (y : r) ys
12
+
13
+
data Instruction
14
+
= Mask [Maybe Int]
15
+
| Set Int Int
16
+
17
+
parsebit :: Char -> Maybe Int
18
+
parsebit '1' = Just 1
19
+
parsebit '0' = Just 0
20
+
parsebit _ = Nothing
21
+
22
+
parse :: String -> Instruction
23
+
parse (stripPrefix "mask = " -> Just mask) = Mask (parsebit <$> mask)
24
+
parse (stripPrefix "mem[" -> Just rest) = Set loc val
25
+
where [loc, val] = read <$> split "] = " rest
26
+
27
+
set :: Int -> Int -> [(Int, Int)] -> [(Int, Int)]
28
+
set loc val map = case findIndex ((==) loc . fst) map of
29
+
Nothing -> (loc, val) : map
30
+
Just n -> (loc, val) : take n map ++ drop (n + 1) map
31
+
32
+
apply :: [Maybe Int] -> Int -> Int
33
+
apply mask val = foldl' applyBit val ([0..] `zip` reverse mask)
34
+
where applyBit :: Int -> (Int, Maybe Int) -> Int
35
+
applyBit val (i, Nothing) = val
36
+
applyBit val (i, Just 0) = val .&. complement (bit i)
37
+
applyBit val (i, Just 1) = val .|. bit i
38
+
39
+
run :: [Instruction] -> [(Int, Int)]
40
+
run = run_ [] (replicate 36 Nothing)
41
+
where
42
+
run_ mem _ [] = mem
43
+
run_ mem _ (Mask mask : is) = run_ mem mask is
44
+
run_ mem mask (Set loc val : is) = run_ (set loc (apply mask val) mem) mask is
45
+
46
+
main :: IO ()
47
+
main = do
48
+
instructions <- fmap parse . lines <$> getContents
49
+
print $ sum $ snd <$> run instructions
+49
2020/14/p2.hs
+49
2020/14/p2.hs
···
1
+
{-# LANGUAGE ViewPatterns #-}
2
+
import Data.Map (Map, insert, empty, elems)
3
+
import Data.List (stripPrefix, foldl', replicate)
4
+
import Data.Bits
5
+
6
+
split :: Eq a => [a] -> [a] -> [[a]]
7
+
split x ys = splitInner x [] ys
8
+
where
9
+
splitInner _ [] [] = []
10
+
splitInner _ r [] = [reverse r]
11
+
splitInner x r (stripPrefix x -> Just ys) = reverse r : splitInner x [] ys
12
+
splitInner x r (y : ys) = splitInner x (y : r) ys
13
+
14
+
data Instruction
15
+
= Mask [Maybe Int]
16
+
| Set Int Int
17
+
18
+
parsebit :: Char -> Maybe Int
19
+
parsebit '1' = Just 1
20
+
parsebit '0' = Just 0
21
+
parsebit _ = Nothing
22
+
23
+
parse :: String -> Instruction
24
+
parse (stripPrefix "mask = " -> Just mask) = Mask (parsebit <$> mask)
25
+
parse (stripPrefix "mem[" -> Just rest) = Set loc val
26
+
where [loc, val] = read <$> split "] = " rest
27
+
28
+
setAll :: [Int] -> Int -> Map Int Int -> Map Int Int
29
+
setAll locs val map = foldl' (flip (`insert` val)) map locs
30
+
31
+
apply :: [Maybe Int] -> Int -> [Int]
32
+
apply mask = applyBits 0 (reverse mask)
33
+
where applyBits :: Int -> [Maybe Int] -> Int -> [Int]
34
+
applyBits _ [] x = [x]
35
+
applyBits i (Just 0 : ms) x = applyBits (i + 1) ms x
36
+
applyBits i (Just 1 : ms) x = flip setBit i <$> applyBits (i + 1) ms x
37
+
applyBits i (Nothing : ms) x = [flip setBit i, flip clearBit i] <*> applyBits (i + 1) ms x
38
+
39
+
run :: [Instruction] -> Map Int Int
40
+
run = run_ empty (replicate 36 Nothing)
41
+
where
42
+
run_ mem _ [] = mem
43
+
run_ mem _ (Mask mask : is) = run_ mem mask is
44
+
run_ mem mask (Set loc val : is) = run_ (setAll (apply mask loc) val mem) mask is
45
+
46
+
main :: IO ()
47
+
main = do
48
+
instructions <- fmap parse . lines <$> getContents
49
+
print $ sum $ elems $ run instructions
+29
2020/15/p1.hs
+29
2020/15/p1.hs
···
1
+
import Control.Monad.State
2
+
import Data.Map (Map)
3
+
import Data.Map qualified as Map
4
+
import Text.Parsec
5
+
6
+
int :: Parsec String u Int
7
+
int = read <$> many digit
8
+
9
+
parseInput = int `sepBy` char ','
10
+
11
+
run :: Int -> [Int] -> Int
12
+
run n st = evalState (run_ n) (Map.fromList $ zip (init st) [1 ..])
13
+
where
14
+
run_ :: Int -> Control.Monad.State.State (Map Int Int) Int
15
+
run_ n | n <= length st = return $ st !! (n - 1)
16
+
run_ i = do
17
+
prev <- run_ $ i - 1
18
+
before <- gets (Map.lookup prev)
19
+
let next = maybe 0 (i - 1 -) before
20
+
in do
21
+
modify (Map.insert prev (i - 1))
22
+
return next
23
+
24
+
answer contents = run 2020 input
25
+
where
26
+
Right input = parse parseInput "" contents
27
+
28
+
main :: IO ()
29
+
main = getContents >>= print . answer
+28
2020/15/p2.hs
+28
2020/15/p2.hs
···
1
+
import Control.Monad.State
2
+
import Data.IntMap.Strict (IntMap, (!?))
3
+
import Data.IntMap.Strict qualified as IntMap
4
+
import Text.Parsec
5
+
6
+
int :: Parsec String u Int
7
+
int = read <$> many digit
8
+
9
+
parseInput = int `sepBy` char ','
10
+
11
+
run :: Int -> [Int] -> Int
12
+
run target st = run_ (length st + 1) 0 (IntMap.fromList $ zip st [1 ..])
13
+
where
14
+
run_ :: Int -> Int -> IntMap Int -> Int
15
+
run_ i n _ | i == target = n
16
+
run_ i n map =
17
+
let prev = map !? n
18
+
map' = IntMap.insert n i map
19
+
in case prev of
20
+
Nothing -> run_ (i + 1) 0 map'
21
+
Just time -> run_ (i + 1) (i - time) map'
22
+
23
+
answer contents = run 30000000 input
24
+
where
25
+
Right input = parse parseInput "" contents
26
+
27
+
main :: IO ()
28
+
main = getContents >>= print . answer
+43
2020/16/p1.hs
+43
2020/16/p1.hs
···
1
+
{-# LANGUAGE ViewPatterns, OverloadedStrings #-}
2
+
import Data.List
3
+
import qualified Data.Text as T
4
+
import Data.Text (Text)
5
+
6
+
split :: Eq a => [a] -> [a] -> [[a]]
7
+
split x ys = splitInner x [] ys
8
+
where
9
+
splitInner _ [] [] = []
10
+
splitInner _ r [] = [reverse r]
11
+
splitInner x r (stripPrefix x -> Just ys) = reverse r : splitInner x [] ys
12
+
splitInner x r (y : ys) = splitInner x (y : r) ys
13
+
14
+
data Field = Field Text [[Int]]
15
+
fieldRanges (Field _ ranges) = ranges
16
+
17
+
newtype Ticket = Ticket [Int]
18
+
ticketFields (Ticket fields) = fields
19
+
20
+
range :: Text -> [Int]
21
+
range = containing . fmap (read . T.unpack) . T.splitOn "-"
22
+
where containing [low, hi] = [low..hi]
23
+
24
+
field :: Text -> Field
25
+
field = makeField . T.splitOn ":"
26
+
where makeField [name, ranges] = Field name (range . T.strip <$> T.splitOn "or" ranges)
27
+
28
+
ticket :: Text -> Ticket
29
+
ticket = Ticket . fmap (read . T.unpack) . T.splitOn ","
30
+
31
+
tickets :: [Text] -> [Ticket]
32
+
tickets = fmap ticket . tail
33
+
34
+
parse :: Text -> ([Field], Ticket, [Ticket])
35
+
parse input = (fmap field f, head $ tickets $ tail t, tickets $ tail ts)
36
+
where [f, t, ts] = split [""] $ T.lines input
37
+
38
+
main :: IO ()
39
+
main = do
40
+
(fields, _, nearbyTickets) <- parse . T.pack <$> getContents
41
+
let ranges = fields >>= fieldRanges
42
+
values = nearbyTickets >>= ticketFields
43
+
in print $ sum $ filter (not . flip any (flip elem <$> ranges) . flip ($)) values
+77
2020/16/p2.hs
+77
2020/16/p2.hs
···
1
+
{-# LANGUAGE ViewPatterns, OverloadedStrings #-}
2
+
import Control.Monad
3
+
import Data.List
4
+
import qualified Data.Map as Map
5
+
import Data.Map (Map)
6
+
import Data.Maybe
7
+
import qualified Data.Text as T
8
+
import Data.Text (Text)
9
+
10
+
split :: Eq a => [a] -> [a] -> [[a]]
11
+
split x ys = splitInner x [] ys
12
+
where
13
+
splitInner _ [] [] = []
14
+
splitInner _ r [] = [reverse r]
15
+
splitInner x r (stripPrefix x -> Just ys) = reverse r : splitInner x [] ys
16
+
splitInner x r (y : ys) = splitInner x (y : r) ys
17
+
18
+
data Field = Field Text [Int] deriving (Eq, Show)
19
+
fieldRange (Field _ ranges) = ranges
20
+
fieldName (Field name _) = name
21
+
22
+
newtype Ticket = Ticket [Int]
23
+
ticketFields (Ticket fields) = fields
24
+
25
+
range :: Text -> [Int]
26
+
range = containing . fmap (read . T.unpack) . T.splitOn "-"
27
+
where containing [low, hi] = [low..hi]
28
+
29
+
field :: Text -> Field
30
+
field = makeField . T.splitOn ":"
31
+
where makeField [name, ranges] = Field name (range . T.strip =<< T.splitOn "or" ranges)
32
+
33
+
ticket :: Text -> Ticket
34
+
ticket = Ticket . fmap (read . T.unpack) . T.splitOn ","
35
+
36
+
tickets :: [Text] -> [Ticket]
37
+
tickets = fmap ticket
38
+
39
+
parse :: Text -> ([Field], Ticket, [Ticket])
40
+
parse input = (fmap field f, head $ tickets $ tail t, tickets $ tail ts)
41
+
where [f, t, ts] = split [""] $ T.lines input
42
+
43
+
elemOf :: Eq a => [a] -> a -> Bool
44
+
elemOf = flip elem
45
+
46
+
removeInvalid :: [Field] -> [Ticket] -> [Ticket]
47
+
removeInvalid fields = filter (all (`elem` (fields >>= fieldRange)) . ticketFields)
48
+
49
+
findCandidates :: [Field] -> [Int] -> [Field]
50
+
findCandidates fields xs = filter (\f -> all (`elem` fieldRange f) xs) fields
51
+
52
+
mapSnd :: (b -> c) -> (a, b) -> (a, c)
53
+
mapSnd f (a, b) = (a, f b)
54
+
55
+
only :: [a] -> a
56
+
only [a] = a
57
+
only _ = error "Not the only one"
58
+
59
+
assignFields :: [(Int, [Field])] -> Map Int Field
60
+
assignFields = only . assignFields_ Map.empty
61
+
where removeField f = sortOn (length . snd) . fmap (mapSnd (delete f))
62
+
63
+
assignFields_ :: Map Int Field -> [(Int, [Field])] -> [Map Int Field]
64
+
assignFields_ m [] = [m]
65
+
assignFields_ m ((_, []) : _) = []
66
+
assignFields_ m ((i, fs) : cs) = fs >>= \f -> assignFields_ (Map.insert i f m) $ removeField f cs
67
+
68
+
main :: IO ()
69
+
main = do
70
+
(fields, Ticket myTicket, nearbyTickets) <- parse . T.pack <$> getContents
71
+
let
72
+
validTickets = removeInvalid fields nearbyTickets
73
+
fieldValues = transpose (ticketFields <$> validTickets)
74
+
candidates = zip [0..] (findCandidates fields <$> fieldValues)
75
+
fieldAssignment = assignFields (sortOn (length . snd) candidates)
76
+
departureFields = Map.filter (T.isPrefixOf "departure") (fieldName <$> fieldAssignment)
77
+
in print $ product $ (myTicket !!) <$> Map.keys departureFields
+59
2020/17/p1.hs
+59
2020/17/p1.hs
···
1
+
{-# LANGUAGE FlexibleInstances #-}
2
+
import Control.Monad
3
+
import Data.Maybe
4
+
5
+
tile :: Char -> Bool
6
+
tile '#' = True
7
+
tile '.' = False
8
+
9
+
update :: Int -> Bool -> Bool
10
+
update 2 True = True
11
+
update 3 _ = True
12
+
update _ _ = False
13
+
14
+
class Remake i where
15
+
remake :: i -> i
16
+
instance Remake Bool where
17
+
remake = const False
18
+
instance (Functor f, Remake i) => Remake (f i) where
19
+
remake = fmap remake
20
+
21
+
class Expand e where
22
+
expand :: e -> e
23
+
instance (Remake e, Expand e) => Expand [e] where
24
+
expand e = remake (head a) : a ++ [remake (last a)]
25
+
where a = fmap expand e
26
+
instance Expand Bool where
27
+
expand = id
28
+
29
+
(!?) :: [a] -> Int -> Maybe a
30
+
(!?) l x | x < 0 = Nothing
31
+
(!?) l x | x >= length l = Nothing
32
+
(!?) l x = Just (l !! x)
33
+
34
+
cycleOnce :: [[[Bool]]] -> [[[Bool]]]
35
+
cycleOnce state = run (expand state)
36
+
37
+
neighbours :: [[[Bool]]] -> (Int, Int, Int) -> Int
38
+
neighbours space (x, y, z) = count [space !? zz >>= (!? yy) >>= (!? xx) | xx <- [x-1..x+1],
39
+
yy <- [y-1..y+1],
40
+
zz <- [z-1..z+1],
41
+
xx /= x || yy /= y || zz /= z]
42
+
where count = length . filter id . catMaybes
43
+
44
+
run :: [[[Bool]]] -> [[[Bool]]]
45
+
run space = [[[next (x, y, z) value | (x, value) <- [0..] `zip` row]
46
+
| (y, row) <- [0..] `zip` plane]
47
+
| (z, plane) <- [0..] `zip` space]
48
+
where
49
+
next :: (Int, Int, Int) -> Bool -> Bool
50
+
next = update . neighbours space
51
+
52
+
cycles :: Int -> [[[Bool]]] -> [[[Bool]]]
53
+
cycles 0 state = state
54
+
cycles n state = cycles (n - 1) $ cycleOnce state
55
+
56
+
main :: IO ()
57
+
main = do
58
+
contents <- fmap (fmap tile) . lines <$> getContents
59
+
print . length . filter id . join . join $ cycles 6 [contents]
+61
2020/17/p2.hs
+61
2020/17/p2.hs
···
1
+
{-# LANGUAGE FlexibleInstances #-}
2
+
import Control.Monad
3
+
import Data.Maybe
4
+
5
+
tile :: Char -> Bool
6
+
tile '#' = True
7
+
tile '.' = False
8
+
9
+
update :: Int -> Bool -> Bool
10
+
update 2 True = True
11
+
update 3 _ = True
12
+
update _ _ = False
13
+
14
+
class Remake i where
15
+
remake :: i -> i
16
+
instance Remake Bool where
17
+
remake = const False
18
+
instance (Functor f, Remake i) => Remake (f i) where
19
+
remake = fmap remake
20
+
21
+
class Expand e where
22
+
expand :: e -> e
23
+
instance (Remake e, Expand e) => Expand [e] where
24
+
expand e = remake (head a) : a ++ [remake (last a)]
25
+
where a = fmap expand e
26
+
instance Expand Bool where
27
+
expand = id
28
+
29
+
(!?) :: [a] -> Int -> Maybe a
30
+
(!?) l x | x < 0 = Nothing
31
+
(!?) l x | x >= length l = Nothing
32
+
(!?) l x = Just (l !! x)
33
+
34
+
cycleOnce :: [[[[Bool]]]] -> [[[[Bool]]]]
35
+
cycleOnce state = run (expand state)
36
+
37
+
neighbours :: [[[[Bool]]]] -> (Int, Int, Int, Int) -> Int
38
+
neighbours space (x, y, z, w) = count [space !? ww >>= (!? zz) >>= (!? yy) >>= (!? xx) | xx <- [x-1..x+1],
39
+
yy <- [y-1..y+1],
40
+
zz <- [z-1..z+1],
41
+
ww <- [w-1..w+1],
42
+
xx /= x || yy /= y || zz /= z || ww /= w]
43
+
where count = length . filter id . catMaybes
44
+
45
+
run :: [[[[Bool]]]] -> [[[[Bool]]]]
46
+
run hyperspace = [[[[next (x, y, z, w) value | (x, value) <- [0..] `zip` row]
47
+
| (y, row) <- [0..] `zip` plane]
48
+
| (z, plane) <- [0..] `zip` space]
49
+
| (w, space) <- [0..] `zip` hyperspace]
50
+
where
51
+
next :: (Int, Int, Int, Int) -> Bool -> Bool
52
+
next = update . neighbours hyperspace
53
+
54
+
cycles :: Int -> [[[[Bool]]]] -> [[[[Bool]]]]
55
+
cycles 0 state = state
56
+
cycles n state = cycles (n - 1) $ cycleOnce state
57
+
58
+
main :: IO ()
59
+
main = do
60
+
contents <- fmap (fmap tile) . lines <$> getContents
61
+
print . length . filter id . join . join . join $ cycles 6 [[contents]]
+63
2020/18/p1.hs
+63
2020/18/p1.hs
···
1
+
{-# LANGUAGE OverloadedStrings #-}
2
+
import Control.Monad.State
3
+
import Data.Either
4
+
import Data.Maybe
5
+
import qualified Data.Text as T
6
+
import Data.Text (Text)
7
+
import Data.Text.Read
8
+
9
+
data Op = Add | Mul
10
+
11
+
eval :: Text -> Int
12
+
eval = evalState (eval' 0 Add)
13
+
14
+
number :: State Text Int
15
+
number = do
16
+
e <- gets (decimal . T.strip)
17
+
case e of
18
+
Left _ -> do
19
+
e <- get
20
+
error $ T.unpack e
21
+
Right (num, str) -> do
22
+
put $ T.strip str
23
+
return num
24
+
25
+
parenthesized :: State Text Int
26
+
parenthesized = do
27
+
modify (T.strip . T.tail)
28
+
eval' 0 Add
29
+
30
+
getValue :: State Text Int
31
+
getValue = do
32
+
str <- gets T.strip
33
+
if "(" `T.isPrefixOf` str
34
+
then parenthesized
35
+
else number
36
+
37
+
getOp :: State Text (Maybe Op)
38
+
getOp = do
39
+
mc <- gets T.uncons
40
+
case mc of
41
+
Nothing -> return Nothing
42
+
Just (c, cs) -> do
43
+
put $ T.strip cs
44
+
case c of
45
+
'+' -> return $ Just Add
46
+
'*' -> return $ Just Mul
47
+
')' -> return Nothing
48
+
_ -> error [c]
49
+
50
+
eval' :: Int -> Op -> State Text Int
51
+
eval' lhs Add = do
52
+
rhs <- getValue
53
+
op <- getOp
54
+
let v = lhs + rhs in
55
+
maybe (return v) (eval' v) op
56
+
eval' lhs Mul = do
57
+
rhs <- getValue
58
+
op <- getOp
59
+
let v = lhs * rhs in
60
+
maybe (return v) (eval' v) op
61
+
62
+
main :: IO ()
63
+
main = getContents >>= print . sum . fmap eval . T.lines . T.pack
+69
2020/18/p2.hs
+69
2020/18/p2.hs
···
1
+
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
2
+
import Control.Monad.State
3
+
import Data.Either
4
+
import Data.Maybe
5
+
import qualified Data.Text as T
6
+
import Data.Text (Text)
7
+
import Data.Text.Read
8
+
9
+
data Op = Add | Mul
10
+
11
+
eval :: Text -> Int
12
+
eval = evalState factors
13
+
14
+
number :: State Text Int
15
+
number = do
16
+
e <- gets (decimal . T.strip)
17
+
case e of
18
+
Left _ -> do
19
+
e <- get
20
+
error $ T.unpack e
21
+
Right (num, str) -> do
22
+
put $ T.strip str
23
+
return num
24
+
25
+
parenthesized :: State Text Int
26
+
parenthesized = do
27
+
modify (T.strip . T.tail)
28
+
x <- factors
29
+
modify (T.strip . T.tail)
30
+
return x
31
+
32
+
getValue :: State Text Int
33
+
getValue = do
34
+
str <- gets T.strip
35
+
if "(" `T.isPrefixOf` str
36
+
then parenthesized
37
+
else number
38
+
39
+
mapsnd :: (b -> c) -> (a, b) -> (a, c)
40
+
mapsnd f (a, b) = (a, f b)
41
+
42
+
op :: Char -> State Text Bool
43
+
op c = do
44
+
mc <- gets $ fmap (mapsnd T.strip) . T.uncons
45
+
case mc of
46
+
Just (cx, cs) | cx == c -> do
47
+
put cs
48
+
return True
49
+
_ -> return False
50
+
51
+
add = op '+'
52
+
mul = op '*'
53
+
54
+
terms :: State Text Int
55
+
terms = do
56
+
lhs <- getValue
57
+
add >>= \case
58
+
False -> return lhs
59
+
True -> (lhs +) <$> terms
60
+
61
+
factors :: State Text Int
62
+
factors = do
63
+
lhs <- terms
64
+
mul >>= \case
65
+
False -> return lhs
66
+
True -> (lhs *) <$> factors
67
+
68
+
main :: IO ()
69
+
main = getContents >>= print . sum . fmap eval . T.lines . T.pack
+51
2020/19/p1.hs
+51
2020/19/p1.hs
···
1
+
import Control.Monad
2
+
import Data.Either
3
+
import Data.IntMap (IntMap, (!))
4
+
import Data.IntMap qualified as IntMap
5
+
import Text.Parsec
6
+
7
+
int :: Parsec String u Int
8
+
int = read <$> many1 digit
9
+
10
+
spaceSep = try $ do
11
+
char ' '
12
+
notFollowedBy $ char '|'
13
+
14
+
nonterminal = NonTerminal <$> int `sepBy1` spaceSep
15
+
16
+
terminal =
17
+
Terminal <$> do
18
+
char '"'
19
+
ch <- letter
20
+
char '"'
21
+
return ch
22
+
23
+
data Rule = Terminal Char | NonTerminal [Int]
24
+
25
+
parseParser = do
26
+
id <- int
27
+
string ": "
28
+
alternatives <- (nonterminal <|> terminal) `sepBy` string " | "
29
+
return (id, alternatives)
30
+
31
+
buildParser :: IntMap [Rule] -> Parsec String u ()
32
+
buildParser map = rules ! 0 >> eof
33
+
where
34
+
rules = fmap ruleParser map
35
+
ruleParser [single] = altParser single
36
+
ruleParser many = choice $ fmap (try . altParser) many
37
+
altParser (Terminal ch) = void $ char ch
38
+
altParser (NonTerminal ids) = foldr (>>) (return ()) $ fmap (rules !) ids
39
+
40
+
parseInput = do
41
+
rules <- buildParser . IntMap.fromList <$> parseParser `endBy` newline
42
+
newline
43
+
inputs <- many (oneOf "ab") `endBy` newline
44
+
return (rules, inputs)
45
+
46
+
answer contents = length $ filter isRight $ parse parser "" <$> inputs
47
+
where
48
+
Right (parser, inputs) = parse parseInput "" contents
49
+
50
+
main :: IO ()
51
+
main = getContents >>= print . answer
+56
2020/19/p2.hs
+56
2020/19/p2.hs
···
1
+
import Control.Monad
2
+
import Data.Either
3
+
import Data.IntMap (IntMap, (!))
4
+
import Data.IntMap qualified as IntMap
5
+
import Text.Parsec
6
+
7
+
int :: Parsec String u Int
8
+
int = read <$> many1 digit
9
+
10
+
spaceSep = try $ do
11
+
char ' '
12
+
notFollowedBy $ char '|'
13
+
14
+
nonterminal = NonTerminal <$> int `sepBy1` spaceSep
15
+
16
+
terminal =
17
+
Terminal <$> do
18
+
char '"'
19
+
ch <- letter
20
+
char '"'
21
+
return ch
22
+
23
+
data Rule = Terminal Char | NonTerminal [Int]
24
+
25
+
parseParser = do
26
+
id <- int
27
+
string ": "
28
+
alternatives <- (nonterminal <|> terminal) `sepBy` string " | "
29
+
return (id, alternatives)
30
+
31
+
buildParser :: IntMap [Rule] -> Parsec String u ()
32
+
buildParser map = do
33
+
l <- length <$> many1 (rules ! 42)
34
+
r <- length <$> many1 (rules ! 31)
35
+
eof
36
+
guard $ l > r
37
+
return ()
38
+
where
39
+
rules = fmap ruleParser map
40
+
ruleParser [single] = altParser single
41
+
ruleParser many = choice $ fmap (try . altParser) many
42
+
altParser (Terminal ch) = void $ char ch
43
+
altParser (NonTerminal ids) = foldr (>>) (return ()) $ fmap (rules !) ids
44
+
45
+
parseInput = do
46
+
rules <- buildParser . IntMap.fromList <$> parseParser `endBy` newline
47
+
newline
48
+
inputs <- many (oneOf "ab") `endBy` newline
49
+
return (rules, inputs)
50
+
51
+
answer contents = length $ filter isRight $ parse parser "" <$> inputs
52
+
where
53
+
Right (parser, inputs) = parse parseInput "" contents
54
+
55
+
main :: IO ()
56
+
main = getContents >>= print . answer
+24
2020/2/p1.hs
+24
2020/2/p1.hs
···
1
+
import Text.Parsec
2
+
3
+
int :: Parsec String u Int
4
+
int = read <$> many digit
5
+
6
+
parseInput = do
7
+
low <- int
8
+
char '-'
9
+
high <- int
10
+
char ' '
11
+
ch <- letter
12
+
string ": "
13
+
password <- many letter
14
+
return (low, high, ch, password)
15
+
16
+
main :: IO ()
17
+
main = do
18
+
contents <- getContents
19
+
print $ length [() | line <- lines contents, check line]
20
+
21
+
check line = low <= len && len <= high
22
+
where
23
+
Right (low, high, char, password) = parse parseInput "" line
24
+
len = length [() | ch <- password, ch == char]
+25
2020/2/p2.hs
+25
2020/2/p2.hs
···
1
+
import Text.Parsec
2
+
3
+
int :: Parsec String u Int
4
+
int = read <$> many digit
5
+
6
+
parseInput = do
7
+
low <- int
8
+
char '-'
9
+
high <- int
10
+
char ' '
11
+
ch <- letter
12
+
string ": "
13
+
password <- many letter
14
+
return (low, high, ch, password)
15
+
16
+
main :: IO ()
17
+
main = do
18
+
contents <- getContents
19
+
print $ length [() | line <- lines contents, check line]
20
+
21
+
check line = (isLeft && not isRight) || (isRight && not isLeft)
22
+
where
23
+
Right (left, right, char, password) = parse parseInput "" line
24
+
isLeft = (password !! (left - 1)) == char
25
+
isRight = (password !! (right - 1)) == char
+19
2020/20/p1.hs
+19
2020/20/p1.hs
···
1
+
import Text.Parsec
2
+
3
+
makeTile grid = []
4
+
5
+
parseTile = do
6
+
string "Tile "
7
+
id :: Int <- read <$> many digit
8
+
char ':'
9
+
newline
10
+
rows <- count 10 (oneOf ".#") `endBy` newline
11
+
return (id, makeTile rows)
12
+
13
+
parseTiles = parseTile `endBy` newline
14
+
15
+
answer contents = 0
16
+
where
17
+
Right input = parse parseTiles "" contents
18
+
19
+
main = getContents >>= print . answer
+7
2020/3/p1.hs
+7
2020/3/p1.hs
+17
2020/3/p2.hs
+17
2020/3/p2.hs
···
1
+
main :: IO ()
2
+
main = do
3
+
contents <- getContents
4
+
let
5
+
levels = lines contents
6
+
a = checkAll [0,3..] levels
7
+
b = checkAll [0..] levels
8
+
c = checkAll [0,5..] levels
9
+
d = checkAll [0,7..] levels
10
+
e = checkAll [0..] [l | (i, l) <- zip [0..] levels, i `mod` 2 == 0]
11
+
in print $ a * b * c * d * e
12
+
13
+
checkAll :: [Int] -> [String] -> Int
14
+
checkAll step levels = length $ filter check $ zip step levels
15
+
16
+
check :: (Int, String) -> Bool
17
+
check (i, line) = line !! (i `mod` length line) == '#'
+16
2020/4/p1.hs
+16
2020/4/p1.hs
···
1
+
import Data.List
2
+
3
+
main :: IO ()
4
+
main = do
5
+
contents <- getContents
6
+
print $ checkAll $ lines contents
7
+
8
+
checkAll :: [String] -> Int
9
+
checkAll [] = 0
10
+
checkAll ls =
11
+
if length [w | w <- fmap (take 3) (passport >>= words), w `elem` ["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"]] == 7
12
+
then 1 + checkAll rest
13
+
else checkAll rest
14
+
where (passport, rest) = case findIndex null ls of
15
+
Nothing -> (ls, [])
16
+
Just n -> let (p, r) = splitAt n ls in (p, tail r)
+36
2020/4/p2.hs
+36
2020/4/p2.hs
···
1
+
{-# LANGUAGE ViewPatterns #-}
2
+
import Data.List
3
+
4
+
main :: IO ()
5
+
main = do
6
+
contents <- getContents
7
+
print $ checkAll $ lines contents
8
+
9
+
checkAll :: [String] -> Int
10
+
checkAll [] = 0
11
+
checkAll ls =
12
+
if length (filter valid (passport >>= words)) == 7
13
+
then 1 + checkAll rest
14
+
else checkAll rest
15
+
where (passport, rest) = case findIndex null ls of
16
+
Nothing -> (ls, [])
17
+
Just n -> let (p, r) = splitAt n ls in (p, tail r)
18
+
19
+
valid :: String -> Bool
20
+
valid (stripPrefix "byr:" -> Just y) = let year = read y in year >= 1920 && year <= 2002
21
+
valid (stripPrefix "iyr:" -> Just y) = let year = read y in year >= 2010 && year <= 2020
22
+
valid (stripPrefix "eyr:" -> Just y) = let year = read y in year >= 2020 && year <= 2030
23
+
valid (stripPrefix "hgt:" -> Just str)
24
+
| "cm" `isSuffixOf` str = height >= 150 && height <= 193
25
+
| "in" `isSuffixOf` str = height >= 59 && height <= 76
26
+
| otherwise = False
27
+
where
28
+
height :: Int
29
+
height = read (take (length str - 2) str)
30
+
valid (stripPrefix "hcl:#" -> Just col) | length col == 6 = all isHex col
31
+
valid (stripPrefix "ecl:" -> Just col) | col `elem` ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"] = True
32
+
valid (stripPrefix "pid:" -> Just pid) | length pid == 9 = all (`elem` ['0'..'9']) pid
33
+
valid _ = False
34
+
35
+
isHex :: Char -> Bool
36
+
isHex ch = ch `elem` ['0'..'9'] ++ ['a'..'f']
+20
2020/5/p1.hs
+20
2020/5/p1.hs
···
1
+
main :: IO ()
2
+
main = do
3
+
contents <- getContents
4
+
print $ maximum (fmap seatID (lines contents))
5
+
6
+
seatID :: String -> Int
7
+
seatID s = let (row, col) = rowcol s in row * 8 + col
8
+
9
+
rowcol :: String -> (Int, Int)
10
+
rowcol = rowcol_ [0..127] [0..8]
11
+
where
12
+
rowcol_ row col [] = (head row, head col)
13
+
rowcol_ row col s = case s of
14
+
'F' : s -> rowcol_ (take halfrow row) col s
15
+
'B' : s -> rowcol_ (drop halfrow row) col s
16
+
'L' : s -> rowcol_ row (take halfcol col) s
17
+
'R' : s -> rowcol_ row (drop halfcol col) s
18
+
_ -> error "wrong"
19
+
where halfrow = length row `div` 2
20
+
halfcol = length col `div` 2
+25
2020/5/p2.hs
+25
2020/5/p2.hs
···
1
+
import Data.List
2
+
3
+
main :: IO ()
4
+
main = do
5
+
contents <- getContents
6
+
let
7
+
seats = sort $ fmap seatID (lines contents)
8
+
Just (before, _) = find (\(x, y) -> x + 2 == y) (zip seats (tail seats))
9
+
in print $ before + 1
10
+
11
+
seatID :: String -> Int
12
+
seatID s = let (row, col) = rowcol s in row * 8 + col
13
+
14
+
rowcol :: String -> (Int, Int)
15
+
rowcol = rowcol_ [0..127] [0..8]
16
+
where
17
+
rowcol_ row col [] = (head row, head col)
18
+
rowcol_ row col s = case s of
19
+
'F' : s -> rowcol_ (take halfrow row) col s
20
+
'B' : s -> rowcol_ (drop halfrow row) col s
21
+
'L' : s -> rowcol_ row (take halfcol col) s
22
+
'R' : s -> rowcol_ row (drop halfcol col) s
23
+
_ -> error "wrong"
24
+
where halfrow = length row `div` 2
25
+
halfcol = length col `div` 2
+24
2020/6/p1.hs
+24
2020/6/p1.hs
···
1
+
groups :: [String] -> [[String]]
2
+
groups = splitWhere null
3
+
4
+
splitWhere :: (a -> Bool) -> [a] -> [[a]]
5
+
splitWhere = splitWhere_ []
6
+
where
7
+
splitWhere_ [] _ [] = []
8
+
splitWhere_ g _ [] = [g]
9
+
splitWhere_ g f (a : as)
10
+
| f a = reverse g : splitWhere_ [] f as
11
+
| otherwise = splitWhere_ (a : g) f as
12
+
13
+
uniq :: Eq a => [a] -> [a]
14
+
uniq = uniq_ []
15
+
where
16
+
uniq_ as [] = as
17
+
uniq_ u (a : as)
18
+
| a `elem` u = uniq_ u as
19
+
| otherwise = uniq_ (a : u) as
20
+
21
+
main :: IO ()
22
+
main = do
23
+
contents <- getContents
24
+
print (sum $ fmap (length . uniq . concat) (groups $ lines contents))
+30
2020/6/p2.hs
+30
2020/6/p2.hs
···
1
+
groups :: [String] -> [[String]]
2
+
groups = splitWhere null
3
+
4
+
splitWhere :: (a -> Bool) -> [a] -> [[a]]
5
+
splitWhere = splitWhere_ []
6
+
where
7
+
splitWhere_ [] _ [] = []
8
+
splitWhere_ g _ [] = [g]
9
+
splitWhere_ g f (a : as)
10
+
| f a = reverse g : splitWhere_ [] f as
11
+
| otherwise = splitWhere_ (a : g) f as
12
+
13
+
uniq :: Eq a => [a] -> [a]
14
+
uniq = uniq_ []
15
+
where
16
+
uniq_ as [] = as
17
+
uniq_ u (a : as)
18
+
| a `elem` u = uniq_ u as
19
+
| otherwise = uniq_ (a : u) as
20
+
21
+
allAnswered :: [String] -> Int
22
+
allAnswered group = length $ filter answered questions
23
+
where
24
+
answered q = all (q `elem`) group
25
+
questions = (uniq . concat) group
26
+
27
+
main :: IO ()
28
+
main = do
29
+
contents <- getContents
30
+
print (sum $ fmap allAnswered (groups $ lines contents))
+45
2020/7/p1.hs
+45
2020/7/p1.hs
···
1
+
import Control.Monad
2
+
import Data.List
3
+
import Data.Maybe
4
+
5
+
data Rule = Rule String [String] deriving (Show)
6
+
7
+
mapsnd :: (b -> c) -> (a, b) -> (a, c)
8
+
mapsnd f (x, y) = (x, f y)
9
+
10
+
rule :: String -> Rule
11
+
rule str = Rule from to
12
+
where
13
+
a : b : _ : _ : rest = words str
14
+
from = a ++ " " ++ b
15
+
to = bags rest
16
+
bags (_ : a : b : _ : rest) = (a ++ " " ++ b) : bags rest
17
+
bags _ = []
18
+
19
+
ruleFor s (Rule f _) = s == f
20
+
21
+
directlyAllowed :: Rule -> (String, Maybe Bool)
22
+
directlyAllowed (Rule k []) = (k, Just False)
23
+
directlyAllowed (Rule k rs)
24
+
| "shiny gold" `elem` rs = (k, Just True)
25
+
| otherwise = (k, Nothing)
26
+
27
+
check :: [Rule] -> [(String, Maybe Bool)] -> [(String, Bool)]
28
+
check rules pairs
29
+
| all (isJust . snd) pairs = fmap (mapsnd fromJust) pairs
30
+
| otherwise = check rules $ fmap allowed pairs
31
+
where
32
+
allowed (s, Just n) = (s, Just n)
33
+
allowed (s, Nothing) = (s, updated)
34
+
where
35
+
Rule _ to = fromJust (find (ruleFor s) rules)
36
+
children = fmap (\s -> snd . fromJust $ find ((== s) . fst) pairs) to
37
+
updated = foldM (\b c -> (|| b) <$> c) False children :: Maybe Bool
38
+
39
+
main :: IO ()
40
+
main = do
41
+
contents <- getContents
42
+
let
43
+
rules = fmap rule $ lines contents
44
+
allowed = fmap directlyAllowed rules
45
+
in print $ length $ filter snd $ check rules allowed
+29
2020/7/p2.hs
+29
2020/7/p2.hs
···
1
+
import Data.List
2
+
import Data.Maybe
3
+
4
+
data Rule = Rule String [(Int, String)] deriving (Show)
5
+
6
+
mapsnd :: (b -> c) -> (a, b) -> (a, c)
7
+
mapsnd f (x, y) = (x, f y)
8
+
9
+
rule :: String -> Rule
10
+
rule str = Rule from to
11
+
where
12
+
a : b : _ : _ : rest = words str
13
+
from = a ++ " " ++ b
14
+
to = bags rest
15
+
bags (n : a : b : _ : rest) = (read n, a ++ " " ++ b) : bags rest
16
+
bags _ = []
17
+
18
+
ruleFor s (Rule f _) = s == f
19
+
20
+
mustContain :: String -> [Rule] -> Int
21
+
mustContain bag rules =
22
+
let Rule _ to = fromJust $ find (ruleFor bag) rules in
23
+
sum $ fmap (\(x, bag) -> x * (1 + mustContain bag rules)) to
24
+
25
+
main :: IO ()
26
+
main = do
27
+
contents <- getContents
28
+
let rules = fmap rule $ lines contents in
29
+
print $ mustContain "shiny gold" rules
+27
2020/8/p1.hs
+27
2020/8/p1.hs
···
1
+
{-# LANGUAGE ViewPatterns #-}
2
+
import Control.Monad
3
+
import Data.List
4
+
5
+
data Instruction
6
+
= Nop
7
+
| Acc Int
8
+
| Jmp Int
9
+
10
+
parse :: String -> Instruction
11
+
parse (fmap read . stripPrefix "acc +" -> Just i) = Acc i
12
+
parse (fmap read . stripPrefix "acc -" -> Just i) = Acc (-i)
13
+
parse (fmap read . stripPrefix "jmp +" -> Just i) = Jmp i
14
+
parse (fmap read . stripPrefix "jmp -" -> Just i) = Jmp (-i)
15
+
parse _ = Nop
16
+
17
+
exec :: Int -> [Int] -> [Instruction] -> Int
18
+
exec i e _ | i `elem` e = 0
19
+
exec i e inst = case inst !! i of
20
+
Nop -> exec (i + 1) (i : e) inst
21
+
Acc n -> n + exec (i + 1) (i : e) inst
22
+
Jmp n -> exec (i + n) (i : e) inst
23
+
24
+
main :: IO ()
25
+
main = do
26
+
instructions <- fmap parse . lines <$> getContents
27
+
print $ exec 0 [] instructions
+46
2020/8/p2.hs
+46
2020/8/p2.hs
···
1
+
{-# LANGUAGE ViewPatterns #-}
2
+
import Control.Monad
3
+
import Data.Functor
4
+
import Data.List
5
+
import Data.Maybe
6
+
7
+
data Instruction
8
+
= Nop Int
9
+
| Acc Int
10
+
| Jmp Int
11
+
12
+
swap :: Instruction -> Maybe Instruction
13
+
swap (Nop i) = Just (Jmp i)
14
+
swap (Jmp i) = Just (Nop i)
15
+
swap _ = Nothing
16
+
17
+
parse :: String -> Instruction
18
+
parse (fmap read . stripPrefix "acc +" -> Just i) = Acc i
19
+
parse (fmap read . stripPrefix "acc -" -> Just i) = Acc (-i)
20
+
parse (fmap read . stripPrefix "jmp +" -> Just i) = Jmp i
21
+
parse (fmap read . stripPrefix "jmp -" -> Just i) = Jmp (-i)
22
+
parse (fmap read . stripPrefix "nop +" -> Just i) = Nop i
23
+
parse (fmap read . stripPrefix "nop -" -> Just i) = Nop (-i)
24
+
parse _ = error "invalid"
25
+
26
+
exec :: Int -> [Int] -> [Instruction] -> Maybe Int
27
+
exec i e _ | i `elem` e = Nothing
28
+
exec i _ inst | i >= length inst = Just 0
29
+
exec i e inst = case inst !! i of
30
+
Nop _ -> exec (i + 1) (i : e) inst
31
+
Acc n -> (n +) <$> exec (i + 1) (i : e) inst
32
+
Jmp n -> exec (i + n) (i : e) inst
33
+
34
+
connect :: [Instruction] -> [Instruction] -> Instruction -> [Instruction]
35
+
connect ls rs i = ls ++ (i : rs)
36
+
37
+
fix :: [Instruction] -> Int
38
+
fix inst = fromJust $ join $ find isJust $ zipWith3 try (inits (init inst)) (tails (tail inst)) (swap <$> inst)
39
+
where
40
+
try :: [Instruction] -> [Instruction] -> Maybe Instruction -> Maybe Int
41
+
try ls rs x = x <&> connect ls rs >>= exec 0 []
42
+
43
+
main :: IO ()
44
+
main = do
45
+
instructions <- fmap parse . lines <$> getContents
46
+
print $ fix instructions
+12
2020/9/p1.hs
+12
2020/9/p1.hs
···
1
+
check :: [Int] -> [Int] -> Int
2
+
check _ [] = error "invalid"
3
+
check preamble (x : xs) = if x `elem` valid preamble then check (x : init preamble) xs else x
4
+
5
+
valid :: [Int] -> [Int]
6
+
valid preamble = [(preamble !! i) + (preamble !! j) | i <- [0..23], j <- [i+1..24]]
7
+
8
+
main :: IO ()
9
+
main = do
10
+
numbers <- fmap read . lines <$> getContents :: IO [Int]
11
+
let (preamble, contents) = splitAt 25 numbers in
12
+
print $ check (reverse preamble) contents
+25
2020/9/p2.hs
+25
2020/9/p2.hs
···
1
+
import Data.Maybe
2
+
3
+
findInvalid :: [Int] -> [Int] -> Int
4
+
findInvalid _ [] = error "invalid"
5
+
findInvalid preamble (x : xs) = if x `elem` valid preamble then findInvalid (x : init preamble) xs else x
6
+
7
+
valid :: [Int] -> [Int]
8
+
valid preamble = [(preamble !! i) + (preamble !! j) | i <- [0..23], j <- [i+1..24]]
9
+
10
+
rangeOf :: Int -> [Int] -> [Int]
11
+
rangeOf x xs = fromMaybe (rangeOf x (tail xs)) $ findRange x xs 0
12
+
where
13
+
findRange :: Int -> [Int] -> Int -> Maybe [Int]
14
+
findRange t (x : xs) a
15
+
| x + a == t = Just [x]
16
+
| x + a < t = (x :) <$> findRange t xs (x + a)
17
+
| otherwise = Nothing
18
+
19
+
main :: IO ()
20
+
main = do
21
+
numbers <- fmap read . lines <$> getContents :: IO [Int]
22
+
let (preamble, contents) = splitAt 25 numbers
23
+
invalid = findInvalid (reverse preamble) contents
24
+
range = rangeOf invalid numbers
25
+
in print $ minimum range + maximum range
+50
2020/Justfile
+50
2020/Justfile
···
1
+
set dotenv-load
2
+
set quiet
3
+
set shell := ["fish", "-c"]
4
+
5
+
year := env_var("YEAR")
6
+
session := env_var("SESSION")
7
+
8
+
[no-cd]
9
+
default: p1 p2
10
+
11
+
all:
12
+
#!/usr/bin/env fish
13
+
for file in (ls)
14
+
if test -d $file
15
+
echo "Day $file"
16
+
just run $file
17
+
end
18
+
end
19
+
20
+
[no-cd]
21
+
p1 input="input": (do "p1" input)
22
+
23
+
[no-cd]
24
+
p2 input="input": (do "p2" input)
25
+
26
+
[no-cd]
27
+
do part input:
28
+
#!/usr/bin/env fish
29
+
if test -f {{part}}.hs
30
+
ghc {{part}} -O -outputdir.{{part}} > /dev/null
31
+
and time ./{{part}} < {{input}}
32
+
else if ls | rg "\.cabal\$" -q
33
+
cabal build {{part}} > /dev/null
34
+
and time cabal run {{part}} < {{input}}
35
+
else if test -f {{part}}.fish
36
+
time ./{{part}}.fish < {{input}}
37
+
else
38
+
echo "Current directory does not contain known solution configuration"
39
+
exit 1
40
+
end
41
+
42
+
run day:
43
+
cd {{day}} && just
44
+
45
+
get day:
46
+
mkdir -p {{day}}
47
+
curl https://adventofcode.com/{{year}}/day/{{day}}/input \
48
+
-X GET \
49
+
-H "Cookie: session={{session}}" \
50
+
-o {{day}}/input