Compare commits
No commits in common. "8719522be0ea5fc9a2a4eacde104d8d3c39b3e3b" and "d9703d389812685bafafc22e6400f8020003f98e" have entirely different histories.
8719522be0
...
d9703d3898
@ -1,4 +1,4 @@
|
|||||||
import Aoc
|
import Aoc ( aocMain )
|
||||||
|
|
||||||
parseFile :: [String] -> [Char]
|
parseFile :: [String] -> [Char]
|
||||||
parseFile lines = let [line] = lines in line
|
parseFile lines = let [line] = lines in line
|
||||||
|
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
import Aoc
|
||||||
import Crypto.Hash.MD5 ( hash )
|
import Crypto.Hash.MD5 ( hash )
|
||||||
import Data.ByteString.Char8 ( pack )
|
import Data.ByteString.Char8 ( pack )
|
||||||
|
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
import Aoc
|
||||||
|
|
||||||
part1 :: [String] -> Int
|
part1 :: [String] -> Int
|
||||||
|
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
import Aoc
|
||||||
import Data.List ( group, sort )
|
import Data.List ( group, sort )
|
||||||
|
|
||||||
@ -13,4 +11,4 @@ part1 x = (length after40, after40)
|
|||||||
part2 :: p -> String -> Int
|
part2 :: p -> String -> Int
|
||||||
part2 _ after40 = length (iterate step after40 !! 10) -- only 10 more needed
|
part2 _ after40 = length (iterate step after40 !! 10) -- only 10 more needed
|
||||||
|
|
||||||
main = aocMain' single part1 part2
|
main = aocMain' single part1 part2
|
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
import Aoc
|
||||||
import Data.Char ( ord, chr )
|
import Data.Char ( ord, chr )
|
||||||
import Data.List ( group, nub )
|
import Data.List ( group, nub )
|
||||||
|
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
import Aoc
|
||||||
import Data.Char ( isDigit )
|
import Data.Char ( isDigit )
|
||||||
import Control.Arrow ( first, second )
|
import Control.Arrow ( first, second )
|
||||||
|
@ -1,34 +0,0 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
|
||||||
import Data.List.Split ( splitOn )
|
|
||||||
import Data.List ( nub )
|
|
||||||
import Data.Tuple ( swap )
|
|
||||||
import Data.Maybe ( fromJust )
|
|
||||||
|
|
||||||
type Pref = ((String, String), Int)
|
|
||||||
|
|
||||||
parseLine :: String -> Pref
|
|
||||||
parseLine line =
|
|
||||||
let [a, "would", verb, points, "happiness", "units", "by", "sitting", "next", "to", b] = words line in
|
|
||||||
let [b', ""] = splitOn "." b in
|
|
||||||
let sign = case verb of { "lose" -> -1; "gain" -> 1 } in
|
|
||||||
((a, b'), sign * read points)
|
|
||||||
|
|
||||||
process :: [Pref] -> ([String], [Pref])
|
|
||||||
process prefs = (people, prefs)
|
|
||||||
where people = nub $ concatMap (unpair . fst) prefs
|
|
||||||
|
|
||||||
scoreLookup :: [Pref] -> (String, String) -> Int
|
|
||||||
scoreLookup prefs pair = fromJust (lookup pair prefs) + fromJust (lookup (swap pair) prefs)
|
|
||||||
|
|
||||||
part1 :: ([String], [Pref]) -> Int
|
|
||||||
part1 (people, prefs) = maximum $ map (sum . map (scoreLookup prefs) . adjacents . (first:).(++[first])) $ permutations $ tail people
|
|
||||||
where first = head people
|
|
||||||
|
|
||||||
-- it's probably more efficient to actually go through the list of prefs to find the one that is decreasing the score the most for each permutation, rather than just doing part1 again with another person, but it is fast enough for me to not bother.
|
|
||||||
part2 :: ([String], [Pref]) -> Int
|
|
||||||
part2 (people, prefs) = part1 ("":people, concatMap (\p -> [(("", p), 0), ((p, ""), 0)]) people ++ prefs)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (process . map parseLine) part1 part2
|
|
@ -1,25 +0,0 @@
|
|||||||
import Aoc
|
|
||||||
import Data.Bifunctor ( bimap )
|
|
||||||
import Data.List ( sort, group )
|
|
||||||
|
|
||||||
parseLine :: String -> (String, (Int, Int, Int))
|
|
||||||
parseLine line =
|
|
||||||
let [name, "can", "fly", speed, "km/s", "for", flyTime, "seconds,", "but", "then", "must", "rest", "for", restTime, "seconds."] = words line in
|
|
||||||
(name, (read speed, read flyTime, read restTime))
|
|
||||||
|
|
||||||
atTime :: Int -> (String, (Int, Int, Int)) -> (String, Int)
|
|
||||||
atTime time (name, (s, f, r)) = (name, (*s) $ uncurry (+) $ bimap (*f) (min f) $ quotRem time (f+r))
|
|
||||||
|
|
||||||
part1 :: [(String, (Int, Int, Int))] -> Int
|
|
||||||
part1 = maximum . map (snd . atTime 2503)
|
|
||||||
|
|
||||||
part2 :: [(String, (Int, Int, Int))] -> Int
|
|
||||||
part2 reindeer = maximum $ map length $ group $ sort $ concatMap winners [1..2503]
|
|
||||||
where
|
|
||||||
winners t =
|
|
||||||
let distances = map (atTime t) reindeer in
|
|
||||||
let maxDistance = maximum $ map snd distances in
|
|
||||||
map fst $ filter ((==maxDistance) . snd) distances
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (map parseLine) part1 part2
|
|
@ -1,23 +0,0 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
|
||||||
import Data.List ( transpose )
|
|
||||||
import Data.Bifunctor ( bimap )
|
|
||||||
|
|
||||||
parseLine :: String -> (String, [Int])
|
|
||||||
parseLine line =
|
|
||||||
let [name, "capacity", capacity, "durability", durability, "flavor", flavor, "texture", texture, "calories", calories] = words line in
|
|
||||||
let read' = read . init in
|
|
||||||
(init name, [read calories, read' capacity, read' durability, read' flavor, read' texture])
|
|
||||||
|
|
||||||
part1' :: (Int -> Bool) -> [(String, [Int])] -> Int
|
|
||||||
part1' cond ingredients = maximum $ map (product . tail) $ filter (cond . head) $ map (map (max 0 . sum) . transpose . map (uncurry map . bimap (*) snd) . (`zip` ingredients)) $ starsAndBars 100 (length ingredients - 1)
|
|
||||||
|
|
||||||
part1 :: [(String, [Int])] -> Int
|
|
||||||
part1 = part1' $ const True
|
|
||||||
|
|
||||||
part2 :: [(String, [Int])] -> Int
|
|
||||||
part2 = part1' (==500)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (map parseLine) part1 part2
|
|
@ -1,48 +0,0 @@
|
|||||||
import Aoc
|
|
||||||
import Data.List.Split ( splitOn )
|
|
||||||
import Data.Char ( isDigit )
|
|
||||||
import Control.Arrow ( second )
|
|
||||||
import Data.Maybe ( fromMaybe )
|
|
||||||
|
|
||||||
parseLine :: String -> (Int, [(String, Int)])
|
|
||||||
parseLine line =
|
|
||||||
let ("Sue ", rest0) = splitAt 4 line in
|
|
||||||
let (n, rest1) = span isDigit rest0 in
|
|
||||||
let (':':' ':rest2) = rest1 in
|
|
||||||
let items = splitOn ", " rest2 in
|
|
||||||
(read n, map (second read . pair . splitOn ": ") items)
|
|
||||||
|
|
||||||
tape :: [(String, Int)]
|
|
||||||
tape = [
|
|
||||||
("children", 3),
|
|
||||||
("cats", 7),
|
|
||||||
("samoyeds", 2),
|
|
||||||
("pomeranians", 3),
|
|
||||||
("akitas", 0),
|
|
||||||
("vizslas", 0),
|
|
||||||
("goldfish", 5),
|
|
||||||
("trees", 3),
|
|
||||||
("cars", 2),
|
|
||||||
("perfumes", 1)
|
|
||||||
]
|
|
||||||
|
|
||||||
part1' :: (String -> Int -> Int -> Bool) -> [(Int, [(String, Int)])] -> Int
|
|
||||||
part1' predicate = fst . single . filter matches
|
|
||||||
where matches (_, items) = all itemMatches tape
|
|
||||||
where itemMatches (name, n) = case lookup name items of
|
|
||||||
Nothing -> True
|
|
||||||
Just n' -> predicate name n' n
|
|
||||||
|
|
||||||
part1 :: [(Int, [(String, Int)])] -> Int
|
|
||||||
part1 = part1' $ const (==)
|
|
||||||
|
|
||||||
part2 :: [(Int, [(String, Int)])] -> Int
|
|
||||||
part2 = part1' $ fromMaybe (==) . flip lookup [
|
|
||||||
("cats", (>)),
|
|
||||||
("trees", (>)),
|
|
||||||
("pomeranians", (<)),
|
|
||||||
("goldfish", (<))
|
|
||||||
]
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (map parseLine) part1 part2
|
|
@ -1,34 +0,0 @@
|
|||||||
import Aoc
|
|
||||||
|
|
||||||
numWays :: Int -> [Int] -> Int
|
|
||||||
numWays 0 _ = 1
|
|
||||||
numWays _ [] = 0
|
|
||||||
numWays n (x:xs)
|
|
||||||
| n > 0 = numWays (n-x) xs + numWays n xs
|
|
||||||
| otherwise = 0
|
|
||||||
|
|
||||||
part1 :: [Int] -> Int
|
|
||||||
part1 = numWays 150
|
|
||||||
|
|
||||||
numWays' :: Int -> [Int] -> (Int, Int)
|
|
||||||
numWays' 0 _ = (0, 1)
|
|
||||||
numWays' _ [] = (0, 0)
|
|
||||||
numWays' n (x:xs)
|
|
||||||
| n < 0 = (0, 0)
|
|
||||||
| w1 == 0 = (m0 + 1, w0)
|
|
||||||
| w0 == 0 = (m1, w1)
|
|
||||||
| m0 > m1 -1 = (m1, w1)
|
|
||||||
| m0 == m1 - 1 = (m1, w0 + w1)
|
|
||||||
| m0 < m1 -1 = (m0 + 1, w0)
|
|
||||||
| otherwise = undefined
|
|
||||||
where
|
|
||||||
(m0, w0) = numWays' (n-x) xs
|
|
||||||
(m1, w1) = numWays' n xs
|
|
||||||
|
|
||||||
-- numWays and numWays' can be combined, but I think that that will make it too messy
|
|
||||||
|
|
||||||
part2 :: [Int] -> Int
|
|
||||||
part2 = snd . numWays' 150
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (map read) part1 part2
|
|
@ -1,38 +0,0 @@
|
|||||||
import Aoc
|
|
||||||
|
|
||||||
parseLine :: String -> [Bool]
|
|
||||||
parseLine = map toBool
|
|
||||||
where
|
|
||||||
toBool '.' = False
|
|
||||||
toBool '#' = True
|
|
||||||
|
|
||||||
countNeighbours :: [[Bool]] -> (Bool, Int)
|
|
||||||
countNeighbours [[a, b, c], [d, e, f], [g, h, i]] = (e, length (filter id [a, b, c, d, f, g, h, i]))
|
|
||||||
|
|
||||||
survives :: (Bool, Int) -> Bool
|
|
||||||
survives (False, n) = n == 3
|
|
||||||
survives (True, n) = n == 2 || n == 3
|
|
||||||
|
|
||||||
simulate :: [[Bool]] -> [[Bool]]
|
|
||||||
simulate = kernelMap (survives . countNeighbours) (Just False)
|
|
||||||
|
|
||||||
numOn :: [[Bool]] -> Int
|
|
||||||
numOn = sum . map (sum . map fromEnum)
|
|
||||||
|
|
||||||
doSimulate :: ([[Bool]] -> [[Bool]]) -> [[Bool]] -> Int
|
|
||||||
doSimulate simulate board = numOn $ iterate simulate board !! 100
|
|
||||||
|
|
||||||
part1 :: [[Bool]] -> Int
|
|
||||||
part1 = doSimulate simulate
|
|
||||||
|
|
||||||
part2 :: [[Bool]] -> Int
|
|
||||||
part2 = doSimulate simulate' . keepOn
|
|
||||||
where
|
|
||||||
updateFirst f (x:xs) = f x: xs
|
|
||||||
updateLast f (x:xs) = if null xs then [f x] else x: updateLast f xs
|
|
||||||
updateEnds f = updateFirst f . updateLast f
|
|
||||||
keepOn = updateEnds (updateEnds $ const True)
|
|
||||||
simulate' = keepOn . simulate
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain (map parseLine) part1 part2
|
|
@ -1,8 +1,6 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
|
||||||
import Data.List ( sort, group )
|
import Data.List ( sort, group )
|
||||||
import Data.Maybe ( fromMaybe )
|
import Data.Maybe ( fromMaybe )
|
||||||
|
import Aoc ( aocMain )
|
||||||
|
|
||||||
parseFile :: [String] -> ([Int], [Int])
|
parseFile :: [String] -> ([Int], [Int])
|
||||||
parseFile lines = unzip [(a, b) | line <- lines, let [a, b] = map read $ words line]
|
parseFile lines = unzip [(a, b) | line <- lines, let [a, b] = map read $ words line]
|
||||||
|
@ -1,6 +1,4 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
import Aoc ( aocMain )
|
||||||
|
|
||||||
import Aoc
|
|
||||||
|
|
||||||
parseFile :: [String] -> [[Int]]
|
parseFile :: [String] -> [[Int]]
|
||||||
parseFile = map (map read . words)
|
parseFile = map (map read . words)
|
||||||
|
@ -1,14 +0,0 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
import Aoc
|
|
||||||
import Text.Regex.PCRE
|
|
||||||
import Data.List.Split ( splitOn )
|
|
||||||
|
|
||||||
part1 :: [String] -> Int
|
|
||||||
part1 = sum . map (sum . map (product . map read . tail) . (=~ "mul\\((\\d+),(\\d+)\\)"))
|
|
||||||
|
|
||||||
part2 :: [String] -> Int
|
|
||||||
part2 = part1 . map (head . splitOn "don't()") . splitOn "do()" . concat
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain id part1 part2
|
|
@ -1,37 +0,0 @@
|
|||||||
import Aoc
|
|
||||||
import Data.List.Split ( splitOn )
|
|
||||||
import Data.List ( transpose )
|
|
||||||
|
|
||||||
horizontal :: [String] -> Int
|
|
||||||
horizontal = sum . map horizontal'
|
|
||||||
where
|
|
||||||
count word = pred . length . splitOn word
|
|
||||||
horizontal' line = count "XMAS" line + count "SAMX" line
|
|
||||||
|
|
||||||
sheer :: [String] -> [String]
|
|
||||||
sheer [] = []
|
|
||||||
sheer (x:xs) = x:(map ('.':) $ sheer xs)
|
|
||||||
|
|
||||||
part1 :: [String] -> Int
|
|
||||||
part1 board = horizontal board + vertical board + diagonal1 board + diagonal2 board
|
|
||||||
where
|
|
||||||
vertical = horizontal . transpose
|
|
||||||
diagonal1 = vertical . sheer
|
|
||||||
diagonal2 = diagonal1 . reverse
|
|
||||||
|
|
||||||
isXMAS :: [[Char]] -> Bool
|
|
||||||
isXMAS [
|
|
||||||
[a, _, b],
|
|
||||||
[_, 'A', _],
|
|
||||||
[c, _, d]] = isMS a d && isMS b c
|
|
||||||
where
|
|
||||||
isMS 'M' 'S' = True
|
|
||||||
isMS 'S' 'M' = True
|
|
||||||
isMS _ _ = False
|
|
||||||
isXMAS [[_, _, _], [_, _, _], [_, _, _]] = False
|
|
||||||
|
|
||||||
part2 :: [String] -> Int
|
|
||||||
part2 = sum . map (length . filter id) . kernelMap isXMAS Nothing
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = aocMain id part1 part2
|
|
6
Makefile
6
Makefile
@ -1,14 +1,12 @@
|
|||||||
HS_SRCS = $(shell find . -name 'day*.hs')
|
HS_SRCS = $(shell find . -name 'day*.hs')
|
||||||
HS_TARGETS = $(HS_SRCS:.hs=)
|
HS_TARGETS = $(HS_SRCS:.hs=)
|
||||||
HI_TARGETS = $(HS_SRCS:.hs=.hi)
|
|
||||||
O_TARGETS = $(HS_SRCS:.hs=.o)
|
|
||||||
|
|
||||||
all: $(HS_TARGETS)
|
all: $(HS_TARGETS)
|
||||||
|
|
||||||
%: %.hs
|
%: %.hs
|
||||||
ghc $<
|
ghc $<
|
||||||
|
|
||||||
clean:
|
clean: $(HS_TARGETS)
|
||||||
rm -rf $(HS_TARGETS) $(HI_TARGETS) $(O_TARGETS)
|
rm -rf $(HS_TARGETS)
|
||||||
|
|
||||||
.PHONY: all clean
|
.PHONY: all clean
|
32
aoc.hs
32
aoc.hs
@ -1,5 +1,3 @@
|
|||||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
||||||
|
|
||||||
module Aoc where
|
module Aoc where
|
||||||
|
|
||||||
aocMain' :: (Show p, Show a) => ([String] -> p) -> (p -> (a, c)) -> (p -> c -> a) -> IO ()
|
aocMain' :: (Show p, Show a) => ([String] -> p) -> (p -> (a, c)) -> (p -> c -> a) -> IO ()
|
||||||
@ -52,32 +50,4 @@ permutations [] = [[]]
|
|||||||
permutations xs = concatMap (\n -> let (a, rest) = remove n xs in map (a:) $ permutations rest) [0..length xs-1]
|
permutations xs = concatMap (\n -> let (a, rest) = remove n xs in map (a:) $ permutations rest) [0..length xs-1]
|
||||||
|
|
||||||
adjacents :: [a] -> [(a, a)]
|
adjacents :: [a] -> [(a, a)]
|
||||||
adjacents as = zip as $ tail as
|
adjacents as = zip as $ tail as
|
||||||
|
|
||||||
-- starsAndBars n b returns all lists of non-negative integers of length `b+1` where the sum is `n`
|
|
||||||
starsAndBars :: Int -> Int -> [[Int]]
|
|
||||||
starsAndBars 0 b = [replicate (b+1) 0]
|
|
||||||
starsAndBars n 0 = [[n]]
|
|
||||||
starsAndBars n b = map (0:) (starsAndBars n (b-1)) ++ map (\xs -> head xs + 1 : tail xs) (starsAndBars (n-1) b)
|
|
||||||
|
|
||||||
kernelMapRow' :: ([[a]] -> b) -> Maybe a -> [a] -> [a] -> [a] -> [b]
|
|
||||||
kernelMapRow' kernel x
|
|
||||||
(a:r0@(b:c:_))
|
|
||||||
(d:r1@(e:f:_))
|
|
||||||
(g:r2@(h:i:_)) =
|
|
||||||
kernel [[a,b,c],[d,e,f],[g,h,i]] : kernelMapRow' kernel x r0 r1 r2
|
|
||||||
kernelMapRow' kernel (Just x) [a, b] [c, d] [e, f] = [kernel [[a,b,x],[c,d,x],[e,f,x]]]
|
|
||||||
kernelMapRow' _ Nothing [_, _] [_, _] [_, _] = []
|
|
||||||
|
|
||||||
kernelMapRow :: ([[a]] -> b) -> Maybe a -> [a] -> [a] -> [a] -> [b]
|
|
||||||
kernelMapRow kernel (Just x) a b c = kernelMapRow' kernel (Just x) (x:a) (x:b) (x:c)
|
|
||||||
kernelMapRow kernel Nothing a b c = kernelMapRow' kernel Nothing a b c
|
|
||||||
|
|
||||||
kernelMap' :: ([[a]] -> b) -> Maybe a -> [[a]] -> [[b]]
|
|
||||||
kernelMap' kernel x (a:rest@(b:c:_)) = kernelMapRow kernel x a b c : kernelMap' kernel x rest
|
|
||||||
kernelMap' kernel (Just x) [a, b] = [kernelMapRow kernel (Just x) a b (map (const x) b)]
|
|
||||||
kernelMap' kernel Nothing [_, _] = []
|
|
||||||
|
|
||||||
kernelMap :: ([[a]] -> b) -> Maybe a -> [[a]] -> [[b]]
|
|
||||||
kernelMap kernel (Just x) as = kernelMap' kernel (Just x) ((map (const x) (head as)):as)
|
|
||||||
kernelMap kernel Nothing as = kernelMap' kernel Nothing as
|
|
Loading…
Reference in New Issue
Block a user