86 lines
2.7 KiB
Haskell
86 lines
2.7 KiB
Haskell
import Data.List
|
|
import Debug.Trace
|
|
|
|
traceOut :: Show a => a -> a
|
|
traceOut x = (traceShow x x)
|
|
|
|
addFirst :: [[a]] -> a -> [[a]]
|
|
addFirst [] x = [[x]]
|
|
addFirst (y:ys) x = ([x] ++ y) : ys
|
|
|
|
split :: [Char] -> String -> [String]
|
|
split _ [] = []
|
|
split delims (x:xs)
|
|
| elem x delims = [[]] ++ split delims xs
|
|
| otherwise = addFirst (split delims xs) x
|
|
|
|
splitInput :: String -> [Int]
|
|
splitInput = map (\x -> read [x]) . head . split ['\n']
|
|
|
|
solve1 :: [Int] -> Int
|
|
solve1 = sum . zipWith (\a b -> a*b) [0..] . replaces (-1) . concat . zipWith (\z y -> replicate y z) ids
|
|
|
|
solve2 :: [Int] -> Int
|
|
solve2 = sum . zipWith (\a b -> a*(if b == (-1) then 0 else b)) [0..] . concat . map (\(Block {blockID=x, blockLength=y}) -> replicate y x) . replaces2 . map makeBlock . zip ids
|
|
|
|
-- [Block id length]
|
|
|
|
makeBlock :: (Int, Int) -> Block
|
|
makeBlock (a, b) = Block {blockID=a, blockLength=b}
|
|
|
|
data Block = Block {blockID :: Int, blockLength :: Int}
|
|
|
|
instance Eq Block where
|
|
a == b = (blockLength a) == (blockLength b) && (blockID a) == (blockID b)
|
|
|
|
instance Show Block where
|
|
show (Block{blockID=a, blockLength=b}) = show (a, b)
|
|
|
|
replaces2 :: [Block] -> [Block]
|
|
replaces2 [] = []
|
|
replaces2 (x:[]) = [x]
|
|
replaces2 (x:xs)
|
|
| (blockLength x) == 0 = replaces2 xs
|
|
| (blockID x) /= (-1) = (x) : (replaces2 xs)
|
|
| (blockID (last xs)) == (-1) = replaces2 (x:(init xs)) ++ [last xs]
|
|
| otherwise = case getFirstGap (x:xs) (last xs) of
|
|
Nothing -> (replaces2 (init (x:xs))) ++ [last xs]
|
|
Just y -> replaces2 $ replacePair y ((last xs), Block{blockID=(-1), blockLength=((blockLength y) - (blockLength (last xs)))}) (x:(init xs)) ++ [Block{blockID=(-1), blockLength=(blockLength (last xs))}]
|
|
|
|
getFirstGap :: [Block] -> Block -> Maybe Block
|
|
getFirstGap [] _ = Nothing
|
|
getFirstGap (x:xs) y
|
|
| (blockID x == (-1)) && ((blockLength x) >= (blockLength y)) = Just x
|
|
| otherwise = getFirstGap xs y
|
|
|
|
replacePair :: Eq a => a -> (a, a) -> [a] -> [a]
|
|
replacePair _ _ [] = []
|
|
replacePair a (b, c) (x:xs)
|
|
| x == a = b:c:xs
|
|
| otherwise = x:(replacePair a (b, c) xs)
|
|
|
|
merge :: [a] -> [a] -> [a]
|
|
merge (x:xs) ys = x:(merge ys xs)
|
|
|
|
replace :: Eq a => a -> a -> [a] -> [a]
|
|
replace _ _ [] = []
|
|
replace a b (x:xs)
|
|
| x == a = b:xs
|
|
| otherwise = x:(replace a b xs)
|
|
|
|
replaces :: (Eq a, Show a) => a -> [a] -> [a]
|
|
replaces _ [] = []
|
|
replaces a xs
|
|
| not (elem a xs) = xs
|
|
| otherwise = replaces a . init $ replace a (last xs) (traceShow (length xs) xs)
|
|
|
|
ids :: [Int] = merge [0..] (repeat (-1))
|
|
|
|
main :: IO()
|
|
main = do
|
|
fileinp <- readFile "input.txt"
|
|
let parsed = splitInput fileinp
|
|
let solved1 = solve1 parsed
|
|
let solved2 = solve2 parsed
|
|
print solved1
|
|
print solved2
|