22-2HEADmistress

1 files changed, 59 insertions, 0 deletions

diff --git a/22-2.hs b/22-2.hs
new file mode 100644
index 0000000..a45ba19
--- /dev/null
+++ b/22-2.hs
@@ -0,0 +1,59 @@
+import Data.Bits (xor)
+import Data.Function ((&))
+import Data.HashMap.Strict as HM hiding (foldl', map, update)
+import Data.List (foldl', nubBy)
+import Data.Maybe (fromMaybe)
+
+type Changes = (Int,Int,Int,Int)
+
+data S = S Int (HM.HashMap Changes Int) deriving Show
+
+h :: S -> Int
+h (S highest _) = highest
+
+mix :: Int -> Int -> Int
+mix = xor
+
+prune :: Int -> Int
+prune = (`mod` 16777216)
+
+mp :: Int -> Int -> Int
+mp cur = prune . mix cur
+
+update :: Int -> Int
+update x = mp x (x * 64) & \ y -> mp y (y `div` 32) & \ z -> mp z (z * 2048)
+
+get :: HM.HashMap Changes Int -> Changes -> Int
+get hm cs = fromMaybe 0 $ HM.lookup cs hm
+
+u1 :: S -> (Changes, Int) -> S
+u1 (S highest hm) (changes, val) = let new = val + get hm changes
+  in S (max highest new) (HM.insert changes new hm)
+
+uBuyer :: S -> [(Changes, Int)] -> S
+uBuyer s  = foldl' u1 s . nubBy ((. fst) . (==) . fst)
+
+uAll :: [[(Changes, Int)]] -> S
+uAll = foldl' uBuyer (S 0 HM.empty)
+
+price :: Int -> Int
+price = (`mod` 10)
+
+diffs :: [Int] -> [Int]
+diffs (p:rest@(q:_)) = q - p : diffs rest
+diffs _ = []
+
+fours :: [Int] -> [Changes]
+fours (a:rest@(b:c:d:_)) = (a,b,c,d) : fours rest
+fours _ = []
+
+diffs' :: [Int] -> [(Changes, Int)]
+diffs' xs = zip (fours $ diffs xs) (drop 4 xs)
+
+main :: IO ()
+main = getContents
+  >>= print
+  . h
+  . uAll
+  . map (diffs' . map price . take 2000 . iterate update . read)
+  . lines