terrana/advent-of-code
1
0
Fork 0
Code Releases Activity

2020 day 7 - refactor

Browse source
This commit is contained in:
Terrana Ninetailed 2020-12-07 13:38:45 +00:00
parent f616cba142
commit b18c8dffec
3 changed files with 15 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
2020/day07/Bag.hs
View file

@ -1,38 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module Bag where
import Data.Bifunctor
import qualified Data.Text as T
import Data.Tuple
type Bag = (String, [(String, Int)])
findWithContent :: [Bag] -> String -> [String]
findWithContent bags target = map first . filter (elem target . second) . map (mapSecond $ map first) $ bags
bagSpec :: String -> Bag
bagSpec = mapFirst T.unpack . mapSecond contents . breakNoPrefix (T.pack " bags contain ") . T.pack
bagSpec = bimap T.unpack contents . breakNoPrefix " bags contain " . T.pack
contents :: T.Text -> [(String, Int)]
contents c
| c == (T.pack "no other bags.") = []
| otherwise = map (mapSecond read . both T.unpack . swap . breakNoPrefix spc . T.strip . first . T.breakOnEnd spc) . T.splitOn (T.pack ",") $ T.init c
where spc = T.pack " "
| c == "no other bags." = []
| otherwise = map (bimap T.unpack (read . T.unpack) . swap . breakNoPrefix " " . T.strip . fst . T.breakOnEnd " ") . T.splitOn "," $ T.init c
breakNoPrefix :: T.Text -> T.Text -> (T.Text, T.Text)
breakNoPrefix prefix text = (a, T.drop (T.length prefix) b) where (a, b) = T.breakOn prefix text
first :: (a, b) -> a
first (a, b) = a
second :: (a, b) -> b
second (a, b) = b
mapFirst :: (a -> c) -> (a, b) -> (c, b)
mapFirst f (a, b) = (f a, b)
mapSecond :: (b -> c) -> (a, b) -> (a, c)
mapSecond f (a, b) = (a, f b)
both :: (a -> b) -> (a, a) -> (b, b)
both f (a, b) = (f a, f b)
swap :: (a, b) -> (b, a)
swap (a,b) = (b,a)

6
2020/day07/part1.hs
View file

@ -1,4 +1,5 @@
import Bag
import Data.Bifunctor
import Data.List
main :: IO ()
@ -8,4 +9,7 @@ main = do
willContain :: String -> [Bag] -> [String]
willContain target bags = foldr union current . map (flip willContain $ bags) $ current
where current = findWithContent bags target
where current = findWithContent target bags
findWithContent :: String -> [Bag] -> [String]
findWithContent target = map fst . filter (elem target . snd) . map (second $ map fst)

8
2020/day07/part2.hs
View file

@ -6,8 +6,8 @@ main = do
putStrLn . show . bagsNeeded "shiny gold" . map bagSpec . lines $ input
bagsNeeded :: String -> [Bag] -> Int
bagsNeeded bagType bags = _bagsNeeded bags (bagType, 1) - 1
bagsNeeded bagType bags = bagsNeededRec bags (bagType, 1) - 1
_bagsNeeded :: [Bag] -> (String, Int) -> Int
_bagsNeeded bags (bagType, qty) = qty + qty * sum
(maybe [] (map $ _bagsNeeded bags) $ lookup bagType bags)
bagsNeededRec :: [Bag] -> (String, Int) -> Int
bagsNeededRec bags (bagType, qty) = qty + qty * sum
(maybe [] (map $ bagsNeededRec bags) $ lookup bagType bags)