adventofcode
/
2017
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Day 14 - performance improvements using strictness

This commit is contained in:
Jonathan Chan 2017-12-23 17:15:35 -08:00
parent 600f4df58e
commit 812cae03d3
2 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
14.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE BangPatterns #-}
import Data.List (foldl')
import Data.List.Split (chunksOf) import Data.List.Split (chunksOf)
import Data.Char (ord) import Data.Char (ord)
import Data.Bits (xor) import Data.Bits (xor)
@ -15,22 +17,26 @@ type Edge = (Int, Int, [Int])
twist :: State -> Length -> State twist :: State -> Length -> State
twist (ring, position, skip) len = twist (ring, position, skip) len =
let rotated = slice position 256 $ cycle ring let !rotated = slice position 256 $ cycle ring
twisted = (reverse $ take len rotated) ++ drop len rotated !twisted = (reverse $ take len rotated) ++ drop len rotated
newRing = slice (256 - position) 256 $ cycle twisted !newRing = slice (256 - position) 256 $ cycle twisted
in (newRing, (position + len + skip) % 256, skip + 1) in (newRing, (position + len + skip) % 256, skip + 1)
where slice start amount = take amount . drop start where slice start amount = take amount . drop start
hash :: [Length] -> State -> State hash :: [Length] -> State -> State
hash lengths state = foldl twist state lengths hash lengths state = foldl' twist state lengths
hashN :: Int -> [Length] -> State -> State
hashN 0 _ state = state
hashN n lengths state = let !nextState = hash lengths state in hashN (n - 1) lengths nextState
sparseHash :: [Int] -> String sparseHash :: [Int] -> String
sparseHash lengths = sparseHash lengths =
let (hashed, _, _) = iterate (hash lengths) ([0..255], 0, 0) !! 64 let (hashed, _, _) = hashN 64 lengths ([0..255], 0, 0)
in concat . map (printf "%08b" . foldr xor 0) . chunksOf 16 $ hashed in concat . map (printf "%08b" . foldr xor 0) . chunksOf 16 $ hashed
getEdges :: Int -> (Seq Char, [Edge]) -> (Seq Char, [Edge]) getEdges :: Seq Char -> Int -> [Edge] -> [Edge]
getEdges ind se@(str, edges) = if str ! ind == '0' then se else getEdges str ind edges = if str ! ind == '0' then edges else
let row = ind // 128 let row = ind // 128
col = ind % 128 col = ind % 128
neighbours = [(row + 1, col ), neighbours = [(row + 1, col ),
@ -38,7 +44,7 @@ getEdges ind se@(str, edges) = if str ! ind == '0' then se else
(row, col + 1), (row, col + 1),
(row, col - 1)] (row, col - 1)]
validNeighbours = filter isOne . map toIndex . filter inBounds $ neighbours validNeighbours = filter isOne . map toIndex . filter inBounds $ neighbours
in (str, (ind, ind, validNeighbours) : edges) in (ind, ind, validNeighbours) : edges
where where
inBounds (r, c) = r >= 0 && r <= 127 && c >= 0 && c <= 127 inBounds (r, c) = r >= 0 && r <= 127 && c >= 0 && c <= 127
toIndex (r, c) = r * 128 + c toIndex (r, c) = r * 128 + c
@ -48,4 +54,4 @@ main :: IO ()
main = do main = do
let hashes = concat $ map (sparseHash . (++ [17, 31, 73, 47, 23]) . map ord . ("ffayrhll-" ++) . show) [0..127] let hashes = concat $ map (sparseHash . (++ [17, 31, 73, 47, 23]) . map ord . ("ffayrhll-" ++) . show) [0..127]
print $ length . filter (== '1') $ hashes print $ length . filter (== '1') $ hashes
print $ length . scc . sel1 . graphFromEdges . snd $ foldr getEdges (fromList hashes, []) [0..128 * 128 - 1] print $ length . scc . sel1 . graphFromEdges $ foldr (getEdges $ fromList hashes) [] [0..128 * 128 - 1]

2
README.md
View File

@ -22,7 +22,7 @@ These are the runtimes of only one trial but the variances are fairly small and
| 11 | 0.119 | | 11 | 0.119 |
| 12 | 0.168 | | 12 | 0.168 |
| 13 | 2.136 | 0.503 | 13 | 2.136 | 0.503
| 14 | 8.211 | 5.206 | 14 | 4.360 | 3.495
| 15 | 62.242 | | 15 | 62.242 |
| 16 | 0.462 | | 16 | 0.462 |
| 17 | 6.753 | 1.865 | 17 | 6.753 | 1.865