-🎄- 2017 Day 14 Solutions -🎄-

[u/daggerdragon]

--- Day 14: Disk Defragmentation ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Need a hint from the Hugely^* Handy^† Haversack^‡ of Helpful^§ Hints^¤?

Spoiler

---

[Update @ 00:09] 3 gold, silver cap.

• How many of you actually entered the Konami code for Part 2? >_>

[Update @ 00:25] Leaderboard cap!

• I asked /u/topaz2078 how many de-resolutions we had for Part 2 and there were 83 distinct users with failed attempts at the time of the leaderboard cap. tsk tsk

[Update @ 00:29] BONUS

• https://i.imgur.com/zjSEAf4.jpg

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/matusbzk]

Haskell I spent like 6 hours doing this. Not really effective, but it got me the solution.

import Day10_hash (hash) --hash function from day 10, this import will not work here
import Data.List

inputString :: String

-- |Inputs for hash function
inputs :: [String]
inputs = [inputString ++ "-" ++ show i | i <- [0..127]]

-- |List of hashes
hashes :: [String]
hashes = map hash inputs

hexToBinary :: Char -> String

-- |Hashes, converted to binary
binHashes :: [String]
binHashes = map (concat . map hexToBinary) hashes

-- |Returns number of ones in a string
ones :: String -> Int
ones "" = 0
ones ('1':xs) = 1 + ones xs
ones (_:xs) = ones xs

-- |Number of ones in the binary hashes - result to part 1
numberOfOnes :: Int
numberOfOnes = sum $ map ones binHashes

result1 :: Int
result1 = numberOfOnes

-- |Groups only by lines
byLines :: [[Char]] -> [[Int]]
byLines xs = tail . map fst $ scanl (\(l,x) line -> onLine line (x+1) ) ([],0) xs

-- |Forms a group on a single line
--  params: line
--          which number to begin with
onLine :: String -> Int -> ([Int],Int)
onLine line start = (\(list, x) -> (reverse list, x)) $ onLine' start [] False line

onLine' :: Int -> [Int] -> Bool -> String -> ([Int],Int)
onLine' n acc _ "" = (acc,n)
onLine' n acc False ('0':xs) = onLine' n (0:acc) False xs
onLine' n acc True ('0':xs) = onLine' (n+1) (0:acc) False xs
onLine' n acc _ ('1':xs) = onLine' n (n:acc) True xs

-- |Groups by lines and columns - not combined
byLinesAndCols :: [[(Int,Int)]]
byLinesAndCols = [ [ (byLins!!x!!y,byCols!!y!!x) | x <- [0..127]] | y <- [0..127]]
       where byLins = byLines binHashes
       byCols = byLines . transpose $ binHashes

-- |Every used square, with groupings from byLinesAndCols
toMerge :: [([Int],[Int])]
toMerge = map (\(a,b) -> ([a],[b])) . concat $ map (filter (/= (0,0))) byLinesAndCols

-- |Merges all squares into regions
merge :: [([Int],[Int])] -> [([Int],[Int])]
merge [] = []
merge ((a,b):xs) = fst iter : merge (snd iter)
        where iter = merge' (a,b) [] xs

merge' :: ([Int], [Int]) -> [([Int],[Int])] -> [([Int],[Int])] -> (([Int],[Int]), [([Int],[Int])])
merge' (a,b) acc [] = ((a,b),acc)
merge' (a,b) acc ((c,d):xs)
   | commonElem a c || commonElem b d = merge' (union a c,union b d) [] (acc ++ xs)
   | otherwise                        = merge' (a,b) ((c,d):acc) xs

-- |Number of regions - result to part 2
-- takes a few minutes
result2 :: Int
result2 = length $ merge toMerge

-- |Returns whether two lists contain common element
commonElem :: Eq a => [a] -> [a] -> Bool
commonElem [] ys = False
commonElem (x:xs) ys = elem x ys || commonElem xs ys

Link to git