1
0
Fork 0
advent-of-code/2017/src/AdventOfCode/Day6.hs
2022-12-04 14:01:02 -05:00

48 lines
1.4 KiB
Haskell

module AdventOfCode.Day6 (findFirstDuplicateAllocation, findSizeOfLoopOfDuplicateAllocation) where
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
type Memory = [Int]
set i y xs = set' i y xs
where
set' i y [] = []
set' 0 y (_:xs) = y:xs
set' i y (x:xs) = x:set' (i-1) y xs
over f i xs = set i (f (xs !! i)) xs
incrementIdx = over ((+) 1)
distribute :: Int -> Int -> Memory -> Memory
distribute 0 _ ms = ms
distribute x i ms = distribute (x-1) (cyclicIdx+1) (incrementIdx cyclicIdx ms)
where cyclicIdx = i `mod` (length ms)
reallocate :: Memory -> Memory
reallocate ms = distribute max (maxIdx+1) zeroed
where
max = maximum ms
maxIdx = fromJust . findIndex ((==) max) $ ms
zeroed = set maxIdx 0 ms
findFirstDuplicateAllocation :: Memory -> Int
findFirstDuplicateAllocation ms = length $ takeWhile (uncurry (/=)) zipped
where
allocations = iterate reallocate ms
sets = scanl (flip Set.insert) Set.empty allocations
sizes = map Set.size sets
zipped = zip sizes (tail sizes)
findSizeOfLoopOfDuplicateAllocation :: Memory -> Int
findSizeOfLoopOfDuplicateAllocation ms = (+) 1 $ length $ takeWhile ((/=) $ head allocationsFromFirstDuplication) $ tail allocationsFromFirstDuplication
where
allocations = iterate reallocate ms
firstDuplicationIdx = findFirstDuplicateAllocation ms
allocationsFromFirstDuplication = drop firstDuplicationIdx allocations