Compare commits
4 commits
5790767831
...
63c6f24ef5
Author | SHA1 | Date | |
---|---|---|---|
63c6f24ef5 | |||
1900e5128b | |||
b1ac705f73 | |||
4f13a47281 |
6 changed files with 18 additions and 8 deletions
|
@ -11,3 +11,4 @@ https://adventofcode.com/2020/
|
|||
| 3 | `**` | `**` | |
|
||||
| 4 | `**` | `**` | |
|
||||
| 5 | | `**` | |
|
||||
| 6 | | `**` | |
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
module AoC where
|
||||
|
||||
import Data.Function (on)
|
||||
import Data.List (groupBy, intercalate)
|
||||
import Text.ParserCombinators.ReadP
|
||||
|
||||
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
|
||||
|
@ -11,6 +13,9 @@ oneCompleteResult p s = case readP_to_S (p <* eof) s of
|
|||
[(x, "")] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
splitOnEmptyLines :: String -> [[String]]
|
||||
splitOnEmptyLines = filter (not . any null) . groupBy ((==) `on` null) . lines
|
||||
|
||||
runAoC :: (Show r1, Show r2) => (String -> i) -> (i -> r1) -> (i -> r2) -> IO ()
|
||||
runAoC inputTransform part1 part2 = do
|
||||
contents <- inputTransform <$> getContents
|
||||
|
|
|
@ -23,6 +23,6 @@ countHits = length . filterMap lookup . catMaybes .: compose2 (zipWith mzip) may
|
|||
treeCharToBool :: Char -> Bool
|
||||
treeCharToBool = (== '#')
|
||||
|
||||
main = runAoC (fmap (cycle . map treeCharToBool) <$> lines) part1 part2
|
||||
main = runAoC (map (cycle . map treeCharToBool) . lines) part1 part2
|
||||
where part1 = countHits (3, 1)
|
||||
part2 = product . (fmap countHits [(1,1), (3,1), (5,1), (7,1), (1,2)] ??)
|
||||
|
|
|
@ -3,8 +3,6 @@ import AoC
|
|||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (guard, mfilter)
|
||||
import Data.Char (isDigit)
|
||||
import Data.Function (on)
|
||||
import Data.List (groupBy, intercalate)
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Text.Read (readMaybe)
|
||||
|
@ -89,13 +87,10 @@ parseFieldNames = spaceSeparated parseFieldName
|
|||
parsePassport :: ReadP [Field]
|
||||
parsePassport = spaceSeparated parseField
|
||||
|
||||
splitOnEmptyLines :: String -> [String]
|
||||
splitOnEmptyLines = map (intercalate " ") . filter (not . any null) . groupBy ((==) `on` null) . lines
|
||||
|
||||
hasAllRequiredFields :: String -> Bool
|
||||
hasAllRequiredFields = maybe False containsAllFields . fieldNames
|
||||
where requiredFieldNames = ["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"]
|
||||
containsAllFields fields = all (`elem` fields) requiredFieldNames
|
||||
fieldNames = oneCompleteResult parseFieldNames
|
||||
|
||||
main = runAoC (filter hasAllRequiredFields . splitOnEmptyLines) (length) (length . mapMaybe (oneCompleteResult parsePassport))
|
||||
main = runAoC (filter hasAllRequiredFields . map (intercalate " ") . splitOnEmptyLines) (length) (length . mapMaybe (oneCompleteResult parsePassport))
|
||||
|
|
|
@ -18,6 +18,6 @@ findHole (x:y:ys) | y == next = findHole $ y:ys
|
|||
where next = succ x
|
||||
findHole _ = Nothing
|
||||
|
||||
main = runAoC (fmap (fromJust . binarify) <$> lines) part1 part2
|
||||
main = runAoC (map (fromJust . binarify) . lines) part1 part2
|
||||
where part1 = foldr1 max
|
||||
part2 = fromJust . findHole . sort
|
||||
|
|
9
day6/day6.hs
Normal file
9
day6/day6.hs
Normal file
|
@ -0,0 +1,9 @@
|
|||
import AoC
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Data.Set (Set)
|
||||
|
||||
main = runAoC ((fmap . fmap) S.fromList . splitOnEmptyLines) part1 part2
|
||||
where part1 = countSetsFolded S.union
|
||||
part2 = countSetsFolded S.intersection
|
||||
countSetsFolded f = sum . map (S.size . foldr1 f)
|
Loading…
Reference in a new issue