1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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
|
