diff --git a/14.hs b/14.hs
index 282c824..a4d99d8 100644
--- a/14.hs
+++ b/14.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+import Data.List (foldl')
 import Data.List.Split (chunksOf)
 import Data.Char (ord)
 import Data.Bits (xor)
@@ -15,22 +17,26 @@ type Edge = (Int, Int, [Int])
 
 twist :: State -> Length -> State
 twist (ring, position, skip) len =
-    let rotated = slice position 256 $ cycle ring
-        twisted = (reverse $ take len rotated) ++ drop len rotated
-        newRing = slice (256 - position) 256 $ cycle twisted
+    let !rotated = slice position 256 $ cycle ring
+        !twisted = (reverse $ take len rotated) ++ drop len rotated
+        !newRing = slice (256 - position) 256 $ cycle twisted
     in  (newRing, (position + len + skip) % 256, skip + 1)
     where slice start amount = take amount . drop start
     
 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 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
 
-getEdges :: Int -> (Seq Char, [Edge]) -> (Seq Char, [Edge])
-getEdges ind se@(str, edges) = if str ! ind == '0' then se else
+getEdges :: Seq Char -> Int -> [Edge] -> [Edge]
+getEdges str ind edges = if str ! ind == '0' then edges else
     let row = ind // 128
         col = ind %  128
         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)]
         validNeighbours = filter isOne . map toIndex . filter inBounds $ neighbours
-    in  (str, (ind, ind, validNeighbours) : edges)
+    in  (ind, ind, validNeighbours) : edges
     where 
         inBounds (r, c) = r >= 0 && r <= 127 && c >= 0 && c <= 127
         toIndex  (r, c) = r * 128 + c
@@ -48,4 +54,4 @@ main :: IO ()
 main = do
     let hashes = concat $ map (sparseHash . (++ [17, 31, 73, 47, 23]) . map ord . ("ffayrhll-" ++) . show) [0..127]
     print $ length . filter (== '1') $ hashes
-    print $ length . scc . sel1 . graphFromEdges . snd $ foldr getEdges (fromList hashes, []) [0..128 * 128 - 1]
\ No newline at end of file
+    print $ length . scc . sel1 . graphFromEdges $ foldr (getEdges $ fromList hashes) [] [0..128 * 128 - 1]
\ No newline at end of file
diff --git a/README.md b/README.md
index a7672c2..c00399b 100644
--- a/README.md
+++ b/README.md
@@ -22,7 +22,7 @@ These are the runtimes of only one trial but the variances are fairly small and
 | 11  |  0.119      |
 | 12  |  0.168      |
 | 13  |  2.136      |  0.503
-| 14  |  8.211      |  5.206
+| 14  |  4.360      |  3.495
 | 15  | 62.242      |
 | 16  |  0.462      |
 | 17  |  6.753      |  1.865