124 lines
3.6 KiB
Haskell
124 lines
3.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
|
|
|
|
module Day5 where
|
|
|
|
import Debug.Trace
|
|
|
|
import Data.Attoparsec.ByteString.Char8
|
|
import qualified Data.ByteString as BS
|
|
import Data.RangeSet.List (RSet)
|
|
import qualified Data.RangeSet.List as RSet
|
|
import Data.Map.Strict (Map)
|
|
import qualified Data.Map.Strict as Map
|
|
import Data.Function ((&))
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Part 1 result:"
|
|
Right ra <- parseOnly rawAlmanach <$> BS.readFile "inputs/day5-test.input"
|
|
print $ part1 ra
|
|
putStrLn "Part 2 result:"
|
|
print $ part2 ra
|
|
|
|
part1 :: RawAlmanach -> Int
|
|
part1 ra = (minimum . map (seedLocation ra) . rawSeeds) ra
|
|
|
|
part2 :: RawAlmanach -> Int
|
|
part2 ra = minimum . map (seedLocation ra) . seedsRange $ ra
|
|
where
|
|
seedsRange al = concat $ fromRange (rawSeeds al)
|
|
fromRange (x:y:xs) = [x..x+y-1] : fromRange xs
|
|
fromRange [_] = error "Should not happen"
|
|
fromRange [] = []
|
|
|
|
-- Needs to be run ~2.3 billion times!
|
|
seedLocation :: RawAlmanach -> Int -> Int
|
|
seedLocation ra = mapSrcDst (combinedMaps ra)
|
|
|
|
combinedMaps :: RawAlmanach -> AlmanachMap
|
|
combinedMaps ra = mergeMaps (rawHumidityToLoc ra)
|
|
$ mergeMaps (rawTempToHumidity ra)
|
|
$ mergeMaps (rawLightToTemp ra)
|
|
$ mergeMaps (rawWaterToLight ra)
|
|
$ mergeMaps (rawFertToWater ra)
|
|
$ mergeMaps (rawSoilToFert ra) (rawSeedToSoil ra)
|
|
|
|
mapSrcDst :: AlmanachMap -> Int -> Int
|
|
mapSrcDst m src = case Map.lookup True $ Map.mapKeys (RSet.member src) m of
|
|
Just v -> src + v
|
|
Nothing -> src
|
|
|
|
mergeMaps :: AlmanachMap -> AlmanachMap -> AlmanachMap
|
|
mergeMaps al1 = Map.foldlWithKey' f Map.empty
|
|
where
|
|
-- f acc k v = Map.union (mergeSet al1 k v) acc
|
|
f acc k v = Map.union (mergeSet al1 k v) acc
|
|
|
|
mergeSet :: AlmanachMap -> RSet Int -> Int -> AlmanachMap
|
|
mergeSet m r mod' = Map.foldrWithKey' f Map.empty m
|
|
where
|
|
f k v acc = specialInsert right v acc
|
|
& specialInsert middle (v+mod')
|
|
& specialInsert left mod'
|
|
where
|
|
left = RSet.difference r k
|
|
middle = RSet.intersection k r
|
|
right = RSet.difference k r
|
|
specialInsert r' v' m' = case Map.lookup True $ Map.mapKeys ((== RSet.empty) . RSet.intersection r) m of
|
|
Just _ -> Map.insert r' v' m'
|
|
Nothing -> mergeSet m' r' v'
|
|
|
|
data RawAlmanach = RawAlmanach
|
|
{ rawSeeds :: [Int]
|
|
, rawSeedToSoil :: AlmanachMap
|
|
, rawSoilToFert :: AlmanachMap
|
|
, rawFertToWater :: AlmanachMap
|
|
, rawWaterToLight :: AlmanachMap
|
|
, rawLightToTemp :: AlmanachMap
|
|
, rawTempToHumidity :: AlmanachMap
|
|
, rawHumidityToLoc :: AlmanachMap
|
|
}
|
|
deriving Show
|
|
|
|
type AlmanachMap = Map (RSet Int) Int
|
|
|
|
|
|
justSpace :: Parser BS.ByteString
|
|
justSpace = " "
|
|
|
|
almanachMap :: Parser AlmanachMap
|
|
almanachMap = do
|
|
xs <- oneRange `sepBy` endOfLine
|
|
pure $ Map.fromList xs
|
|
where
|
|
oneRange = do
|
|
a:b:c:_ <- decimal `sepBy` justSpace
|
|
pure (RSet.fromRangeList [(b,b+c-1)], a-b)
|
|
|
|
rawAlmanach :: Parser RawAlmanach
|
|
rawAlmanach = do
|
|
seeds <- "seeds: " *> decimal `sepBy` justSpace
|
|
endOfLine *> endOfLine
|
|
"seed-to-soil map:" *> endOfLine
|
|
sts <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"soil-to-fertilizer map:" *> endOfLine
|
|
stf <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"fertilizer-to-water map:" *> endOfLine
|
|
ftw <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"water-to-light map:" *> endOfLine
|
|
wtl <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"light-to-temperature map:" *> endOfLine
|
|
ltt <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"temperature-to-humidity map:" *> endOfLine
|
|
tth <- almanachMap
|
|
endOfLine *> endOfLine
|
|
"humidity-to-location map:" *> endOfLine
|
|
RawAlmanach seeds sts stf ftw wtl ltt tth <$> almanachMap
|