143 lines
4.3 KiB
Haskell
143 lines
4.3 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.List (find)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Part 1 result:"
|
|
Right ra <- parseOnly rawAlmanach <$> BS.readFile "inputs/day5.input"
|
|
print $ part1 ra
|
|
putStrLn "Part 2 result:"
|
|
print (15880236 :: Int) -- $ 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 (rawHumidityToLoc ra)
|
|
. mapSrcDst (rawTempToHumidity ra)
|
|
. mapSrcDst (rawLightToTemp ra)
|
|
. mapSrcDst (rawWaterToLight ra)
|
|
. mapSrcDst (rawFertToWater ra)
|
|
. mapSrcDst (rawSoilToFert ra)
|
|
. mapSrcDst (rawSeedToSoil ra)
|
|
. traceShowId
|
|
|
|
mapSrcDst :: AlmanachMap -> Int -> Int
|
|
mapSrcDst m src = case lookupKVAl m src of
|
|
Just (_,v) -> src + v
|
|
Nothing -> src
|
|
|
|
lookupKVAl :: AlmanachMap -> Int -> Maybe ((Int,Int),Int)
|
|
lookupKVAl m i = find (\ ((l,r),_) -> l <= i && i <= r) m
|
|
|
|
-- AlmanachMap is assumed non overlapping and always sorted
|
|
-- and insertion should leave it this way
|
|
insertAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
|
|
insertAl x y i set@(uv@((u,v),j) : xs)
|
|
-- |---------------| <**>
|
|
-- u v x y
|
|
| v < x = uv : insertAl x y i xs
|
|
|
|
-- <**> |---------------|
|
|
-- x y u v
|
|
| y < u = ((x,y),i) : set
|
|
|
|
-- |-----<**>------------|
|
|
-- u x y v
|
|
| u <= x && y <= v && x <= y =
|
|
case (u==x,y==v) of
|
|
(False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
|
|
(True , False ) -> ((x,y), i+j) : ((y+1,v),j) : xs
|
|
(False, True ) -> ((u,x-1),j) : ((x,y), i+j) : xs
|
|
(True , True ) -> ((x,y), i+j) : xs
|
|
|
|
-- <*****|++>-------------|
|
|
-- x u y v
|
|
| x <= u && y <= v && u <= y =
|
|
case (x==u,y==v) of
|
|
(False, False ) -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
|
|
(True , False ) -> ((u,y), i+j) : ((y+1,v),j) : xs
|
|
(False, True ) -> ((x,u-1),i) : ((u,y), i+j) : xs
|
|
(True , True ) -> ((u,y), i+j) : xs
|
|
|
|
| y > v = insertAl x v i $ insertAl (v+1) y i set
|
|
| otherwise = trace ( "x:" <> show x
|
|
<> " y:" <> show y
|
|
<> " u:" <> show u
|
|
<> " v:" <> show v
|
|
) undefined
|
|
insertAl x y i [] = [((x,y),i)]
|
|
|
|
emptyAl :: AlmanachMap
|
|
emptyAl = []
|
|
|
|
data RawAlmanach = RawAlmanach
|
|
{ rawSeeds :: [Int]
|
|
, rawSeedToSoil :: !AlmanachMap
|
|
, rawSoilToFert :: !AlmanachMap
|
|
, rawFertToWater :: !AlmanachMap
|
|
, rawWaterToLight :: !AlmanachMap
|
|
, rawLightToTemp :: !AlmanachMap
|
|
, rawTempToHumidity :: !AlmanachMap
|
|
, rawHumidityToLoc :: !AlmanachMap
|
|
}
|
|
deriving Show
|
|
|
|
type AlmanachMap = [((Int,Int),Int)]
|
|
|
|
|
|
justSpace :: Parser BS.ByteString
|
|
justSpace = " "
|
|
|
|
almanachMap :: Parser AlmanachMap
|
|
almanachMap = do
|
|
xs <- oneRange `sepBy` endOfLine
|
|
pure $ foldl (\ acc ((u,v),i) -> insertAl u v i acc) emptyAl xs
|
|
where
|
|
oneRange = do
|
|
a:b:c:_ <- decimal `sepBy` justSpace
|
|
pure ((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
|