save
This commit is contained in:
Samae
parent
3bdb08528a
commit
a842bedaed
1 changed files with 90 additions and 34 deletions
124
src/Day5.hs
124
src/Day5.hs
|
|
@ -8,11 +8,7 @@ import Debug.Trace
|
||||||
|
|
||||||
import Data.Attoparsec.ByteString.Char8
|
import Data.Attoparsec.ByteString.Char8
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.RangeSet.List (RSet)
|
import Data.List (find)
|
||||||
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
|
@ -38,37 +34,97 @@ seedLocation :: RawAlmanach -> Int -> Int
|
||||||
seedLocation ra = mapSrcDst (combinedMaps ra)
|
seedLocation ra = mapSrcDst (combinedMaps ra)
|
||||||
|
|
||||||
combinedMaps :: RawAlmanach -> AlmanachMap
|
combinedMaps :: RawAlmanach -> AlmanachMap
|
||||||
combinedMaps ra = mergeMaps (rawHumidityToLoc ra)
|
combinedMaps ra = unionAl (rawHumidityToLoc ra)
|
||||||
$ mergeMaps (rawTempToHumidity ra)
|
$ unionAl (rawTempToHumidity ra)
|
||||||
$ mergeMaps (rawLightToTemp ra)
|
$ unionAl (rawLightToTemp ra)
|
||||||
$ mergeMaps (rawWaterToLight ra)
|
$ unionAl (rawWaterToLight ra)
|
||||||
$ mergeMaps (rawFertToWater ra)
|
$ unionAl (rawFertToWater ra)
|
||||||
$ mergeMaps (rawSoilToFert ra) (rawSeedToSoil ra)
|
$ unionAl (rawSoilToFert ra) (rawSeedToSoil ra)
|
||||||
|
|
||||||
mapSrcDst :: AlmanachMap -> Int -> Int
|
mapSrcDst :: AlmanachMap -> Int -> Int
|
||||||
mapSrcDst m src = case Map.lookup True $ Map.mapKeys (RSet.member src) m of
|
mapSrcDst m src = case lookupKVAl m src of
|
||||||
Just v -> src + v
|
Just (_,v) -> src + v
|
||||||
Nothing -> src
|
Nothing -> src
|
||||||
|
|
||||||
mergeMaps :: AlmanachMap -> AlmanachMap -> AlmanachMap
|
lookupKVAl :: AlmanachMap -> Int -> Maybe ((Int,Int),Int)
|
||||||
mergeMaps al1 = Map.foldlWithKey' f Map.empty
|
lookupKVAl m i = find (\ ((l,r),_) -> l <= i && i <= r) m
|
||||||
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
|
insertAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
|
||||||
mergeSet m r mod' = Map.foldrWithKey' f Map.empty m
|
insertAl x y i set@(uv@((u,v),j) : xs)
|
||||||
where
|
| v < x = uv : insertAl x y i xs
|
||||||
f k v acc = specialInsert right v acc
|
| y < u = ((x,y),i) : set
|
||||||
& specialInsert middle (v+mod')
|
-- | otherwise = prependAl (min x u) (max y v) i xs
|
||||||
& specialInsert left mod'
|
-- |-----<**>------|
|
||||||
where
|
-- u x y v
|
||||||
left = RSet.difference r k
|
| u <= x && y <= v && x <= y = trace "uxyv" $
|
||||||
middle = RSet.intersection k r
|
case (u==x,y==v,x==y) of
|
||||||
right = RSet.difference k r
|
(False, False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
|
||||||
specialInsert r' v' m' = case Map.lookup True $ Map.mapKeys ((== RSet.empty) . RSet.intersection r) m of
|
(True , False, False ) -> ((x,y), i+j) : ((y+1,v),j) : xs
|
||||||
Just _ -> Map.insert r' v' m'
|
(False, True , False ) -> ((u,x-1),j) : ((x,y), i+j) : xs
|
||||||
Nothing -> mergeSet m' r' v'
|
(True , True , False ) -> ((x,y), i+j) : xs
|
||||||
|
(False, False, True ) -> ((u,x-1),j) : ((x,x), i+j) : ((y+1,v),j) : xs
|
||||||
|
(True , False, True ) -> ((x,x), i+j) : ((y+1,v),j) : xs
|
||||||
|
(False, True , True ) -> ((u,x-1),j) : ((x,x), i+j) : xs
|
||||||
|
(True , True , True ) -> ((x,x), i+j) : xs
|
||||||
|
-- <*****|++>------|
|
||||||
|
-- x u y v
|
||||||
|
| x <= u && y <= v && u <= y = trace "xuyv" $
|
||||||
|
case (x==u,y==v,u==y) of
|
||||||
|
(False, False, False ) -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
|
||||||
|
(True , False, False ) -> ((u,y), i+j) : ((y+1,v),j) : xs
|
||||||
|
(False, True , False ) -> ((x,u-1),i) : ((u,y), i+j) : xs
|
||||||
|
(True , True , False ) -> ((u,y), i+j) : xs
|
||||||
|
(False, False, True ) -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
|
||||||
|
(True , False, True ) -> ((u,y), i+j) : ((y+1,v),j) : xs
|
||||||
|
(False, True , True ) -> ((x,u-1),i) : ((u,y), i+j) : xs
|
||||||
|
(True , True , True ) -> ((u,y), i+j) : xs
|
||||||
|
-- |-----<++|******>
|
||||||
|
-- u x v y
|
||||||
|
| u <= x && v <= y && x <= v = trace "uxvy" $
|
||||||
|
case (u==x,v==y,x==v) of
|
||||||
|
(False, False, False ) -> ((u,x-1),j) : ((x,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(True , False, False ) -> ((x,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(False, True , False ) -> ((u,x-1),j) : ((x,v), i+j) : xs
|
||||||
|
(True , True , False ) -> ((x,v), i+j) : xs
|
||||||
|
(False, False, True ) -> ((u,x-1),j) : ((x,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(True , False, True ) -> ((x,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(False, True , True ) -> ((u,x-1),j) : ((x,v), i+j) : xs
|
||||||
|
(True , True , True ) -> ((x,v), i+j) : xs
|
||||||
|
-- <*****|++|******>
|
||||||
|
-- x u v y
|
||||||
|
| x <= u && v <= y && u <= v = trace "xuvy" $
|
||||||
|
case (x==u,v==y,u==v) of
|
||||||
|
(False, False, False ) -> ((x,u-1),i) : ((u,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(True , False, False ) -> ((u,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(False, True , False ) -> ((x,u-1),i) : ((u,v), i+j) : xs
|
||||||
|
(True , True , False ) -> ((u,v), i+j) : xs
|
||||||
|
(False, False, True ) -> ((x,u-1),i) : ((u,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(True , False, True ) -> ((u,v), i+j) : ((v+1,y),i) : xs
|
||||||
|
(False, True , True ) -> ((x,u-1),i) : ((u,v), i+j) : xs
|
||||||
|
(True , True , True ) -> ((u,v), i+j) : xs
|
||||||
|
| otherwise = trace ( "x:" <> show x
|
||||||
|
<> " y:" <> show y
|
||||||
|
<> " u:" <> show u
|
||||||
|
<> " v:" <> show v
|
||||||
|
) undefined
|
||||||
|
insertAl x y i [] = [((x,y),i)]
|
||||||
|
|
||||||
|
-- -- | Add @[x,y]@ to the beginning (assuming @x <= u@).
|
||||||
|
-- prependAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
|
||||||
|
-- prependAl x y vi set@(((u,v),_) : xs)
|
||||||
|
-- | y < u && succ y /= u = ((x,y),v) : set
|
||||||
|
-- | otherwise = prependAl x (max y v) vi xs
|
||||||
|
-- prependAl x y v [] = [((x,y),v)]
|
||||||
|
|
||||||
|
-- | Union two range lists.
|
||||||
|
unionAl :: AlmanachMap -> AlmanachMap -> AlmanachMap
|
||||||
|
unionAl (((x,y),i):as) (((u,v),j):bs) =
|
||||||
|
insertAl x y i $ insertAl u v j $ unionAl as bs
|
||||||
|
unionAl s [] = s
|
||||||
|
unionAl [] s = s
|
||||||
|
|
||||||
|
emptyAl :: AlmanachMap
|
||||||
|
emptyAl = []
|
||||||
|
|
||||||
data RawAlmanach = RawAlmanach
|
data RawAlmanach = RawAlmanach
|
||||||
{ rawSeeds :: [Int]
|
{ rawSeeds :: [Int]
|
||||||
|
|
@ -82,7 +138,7 @@ data RawAlmanach = RawAlmanach
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
type AlmanachMap = Map (RSet Int) Int
|
type AlmanachMap = [((Int,Int),Int)]
|
||||||
|
|
||||||
|
|
||||||
justSpace :: Parser BS.ByteString
|
justSpace :: Parser BS.ByteString
|
||||||
|
|
@ -91,11 +147,11 @@ justSpace = " "
|
||||||
almanachMap :: Parser AlmanachMap
|
almanachMap :: Parser AlmanachMap
|
||||||
almanachMap = do
|
almanachMap = do
|
||||||
xs <- oneRange `sepBy` endOfLine
|
xs <- oneRange `sepBy` endOfLine
|
||||||
pure $ Map.fromList xs
|
pure $ foldl (\ acc ((u,v),i) -> insertAl u v i acc) emptyAl xs
|
||||||
where
|
where
|
||||||
oneRange = do
|
oneRange = do
|
||||||
a:b:c:_ <- decimal `sepBy` justSpace
|
a:b:c:_ <- decimal `sepBy` justSpace
|
||||||
pure (RSet.fromRangeList [(b,b+c-1)], a-b)
|
pure ((b,b+c-1), a-b)
|
||||||
|
|
||||||
rawAlmanach :: Parser RawAlmanach
|
rawAlmanach :: Parser RawAlmanach
|
||||||
rawAlmanach = do
|
rawAlmanach = do
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue