Trying to optimise day 15

diff --git a/advent-of-code.cabal b/advent-of-code.cabal
index 4bd4b0d8f18addd54c3c531743093599cf29618f..a9cf4509d8c9afe390c66efcbb79f32c6cd6c8d2 100644 (file)
--- a/advent-of-code.cabal
+++ b/advent-of-code.cabal
@@ -148,3 +148,9 @@ executable advent15
   main-is:             advent15.hs
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
+
+executable advent15other
+  hs-source-dirs:      src/advent15
+  main-is:             advent15other.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
\ No newline at end of file

diff --git a/src/advent15/advent15.hs b/src/advent15/advent15.hs
index 7cec0d024da9784b39d3fc7a7d6dcafe4950d2cb..6ee03c04cf0c6a6b53cefd98d10cc954cd772c3a 100644 (file)
--- a/src/advent15/advent15.hs
+++ b/src/advent15/advent15.hs
@@ -24,7 +24,7 @@ streamA = stream generatorA generatorAStart
 streamB = stream generatorB generatorBStart
 
 generator :: Word64 -> Word64 -> Word64 -> Word64
-generator divisor factor n = fromIntegral $ fromIntegral n * factor `rem` divisor
+generator divisor factor n = n * factor `rem` divisor
 
 toWord16 :: Word64 -> Word16
 toWord16 = fromIntegral
@@ -33,5 +33,4 @@ stream :: (Word64 -> Word64) -> Word64 -> [Word16]
 stream gen n0 = map toWord16 $ drop 1 $ iterate gen n0
 
 filteredStream :: Word16 -> [Word16] -> [Word16]
-filteredStream f str = filter (\n -> n .&. f == 0) str
-
+filteredStream f str = filter ((== 0) . ( .&. f)) str

diff --git a/src/advent15/advent15other.hs b/src/advent15/advent15other.hs
new file mode 100644 (file)
index 0000000..0802707
--- /dev/null
+++ b/src/advent15/advent15other.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_HADDOCK ignore-exports #-}
+-- module Day15 (day15a, day15b) where
+
+import Control.Arrow ((***))
+import Data.Bits ((.&.))
+import Data.Function (on)
+import Data.List (stripPrefix)
+import Data.Word (Word64)
+
+-- | Returns the initial values for generators A and B.
+parse :: String -> (Word64, Word64)
+parse _ =  (873, 583)
+-- parse input = (read a, read b) where
+--     [line1, line2] = lines input
+--     Just a = stripPrefix "Generator A starts with " line1
+--     Just b = stripPrefix "Generator B starts with " line2
+
+
+main :: IO ()
+main = do
+    print $ day15a "none"
+    print $ day15b "none"
+
+
+-- | One step of generator A.
+genA :: Word64 -> Word64
+genA x = x * 16807 `mod` 2147483647
+
+-- | One step of generator B.
+genB :: Word64 -> Word64
+genB x = x * 48271 `mod` 2147483647
+
+-- | Step generator A until a multiple of 4.
+genA' :: Word64 -> Word64
+genA' x = let y = genA x in if y .&. 3 == 0 then y else genA' y
+
+-- | Step generator A until a multiple of 8.
+genB' :: Word64 -> Word64
+genB' x = let y = genB x in if y .&. 7 == 0 then y else genB' y
+
+-- | One step of both generators A and B.
+gen :: (Word64, Word64) -> (Word64, Word64)
+gen = genA *** genB
+
+-- | Step both generators A and B until a multiple of 4 and 8 respectively.
+gen' :: (Word64, Word64) -> (Word64, Word64)
+gen' = genA' *** genB'
+
+-- | prop> count p f x n == length (filter p . take n . tail $ iterate f x)
+count :: (a -> Bool) -> (a -> a) -> a -> Int -> Int
+count p f = count' 0 where
+    count' !k x 0 = k
+    count' !k x n = count' (if p y then k + 1 else k) y (n - 1) where y = f x
+
+day15a :: String -> Int
+day15a input =
+    count (uncurry ((==) `on` (.&. 0xffff))) gen (parse input) 40000000
+
+day15b :: String -> Int
+day15b input =
+    count (uncurry ((==) `on` (.&. 0xffff))) gen' (parse input) 5000000