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 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 ((&))
|
||||
import Data.List (find)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
@ -38,37 +34,97 @@ 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)
|
||||
combinedMaps ra = unionAl (rawHumidityToLoc ra)
|
||||
$ unionAl (rawTempToHumidity ra)
|
||||
$ unionAl (rawLightToTemp ra)
|
||||
$ unionAl (rawWaterToLight ra)
|
||||
$ unionAl (rawFertToWater ra)
|
||||
$ unionAl (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
|
||||
mapSrcDst m src = case lookupKVAl m src 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
|
||||
lookupKVAl :: AlmanachMap -> Int -> Maybe ((Int,Int),Int)
|
||||
lookupKVAl m i = find (\ ((l,r),_) -> l <= i && i <= r) m
|
||||
|
||||
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'
|
||||
insertAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
|
||||
insertAl x y i set@(uv@((u,v),j) : xs)
|
||||
| v < x = uv : insertAl x y i xs
|
||||
| y < u = ((x,y),i) : set
|
||||
-- | otherwise = prependAl (min x u) (max y v) i xs
|
||||
-- |-----<**>------|
|
||||
-- u x y v
|
||||
| u <= x && y <= v && x <= y = trace "uxyv" $
|
||||
case (u==x,y==v,x==y) of
|
||||
(False, False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
|
||||
(True , False, False ) -> ((x,y), i+j) : ((y+1,v),j) : xs
|
||||
(False, True , False ) -> ((u,x-1),j) : ((x,y), i+j) : xs
|
||||
(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
|
||||
{ rawSeeds :: [Int]
|
||||
|
|
@ -82,7 +138,7 @@ data RawAlmanach = RawAlmanach
|
|||
}
|
||||
deriving Show
|
||||
|
||||
type AlmanachMap = Map (RSet Int) Int
|
||||
type AlmanachMap = [((Int,Int),Int)]
|
||||
|
||||
|
||||
justSpace :: Parser BS.ByteString
|
||||
|
|
@ -91,11 +147,11 @@ justSpace = " "
|
|||
almanachMap :: Parser AlmanachMap
|
||||
almanachMap = do
|
||||
xs <- oneRange `sepBy` endOfLine
|
||||
pure $ Map.fromList xs
|
||||
pure $ foldl (\ acc ((u,v),i) -> insertAl u v i acc) emptyAl xs
|
||||
where
|
||||
oneRange = do
|
||||
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 = do
|
||||
|
|
|
|||
Loading…
Reference in a new issue