finished day 15 and day 17 part 2

1 files changed, 35 insertions, 14 deletions

diff --git a/Puzzle15.hs b/Puzzle15.hs
index 104e2aa..1a1d596 100644
--- a/Puzzle15.hs
+++ b/Puzzle15.hs
@@ -1,24 +1,45 @@
+{-# LANGUAGE BangPatterns #-}
+
 import Data.Int
 
-stepA :: Int64 -> Int64
-stepA x = x * 16807 `mod` 2147483647
-stepB :: Int64 -> Int64
-stepB x = x * 48271 `mod` 2147483647
+stepA :: Int -> Int
+stepA !x = x * 16807 `rem` 2147483647
+stepB :: Int -> Int
+stepB !x = x * 48271 `rem` 2147483647
+
+stepA' :: Int -> Int
+stepA' !x = until ((==0) . flip rem 4) stepA (stepA x)
 
-toInt16 :: Int64 -> Int16
+stepB' :: Int -> Int
+stepB' !x = until ((==0) . flip rem 8) stepB (stepB x)
+
+toInt16 :: Int -> Int16
 toInt16 = fromIntegral
 
-stepAB :: ((Int64, Int64), Int) -> ((Int64, Int64), Int)
-stepAB ((x, y), n) = ((stepA x, stepB y), if (toInt16 x) == (toInt16 y) then n + 1 else n)
+stepAB :: ((Int, Int), Int) -> ((Int, Int), Int)
+stepAB ((!x, !y), !n) = ((stepA x, stepB y), if (toInt16 x) == (toInt16 y) then n + 1 else n)
+
+stepAB' :: ((Int, Int), Int) -> ((Int, Int), Int)
+stepAB' ((!x, !y), !n) = ((stepA' x, stepB' y), if (toInt16 x) == (toInt16 y) then n + 1 else n)
 
-solve1' :: ((Int64, Int64), Int) -> Int -> ((Int64, Int64), Int)
-solve1' z 0 = z
-solve1' z m = let !w = stepAB z in let !m' = m - 1 in solve1' w m'
+f :: Int -> ((Int, Int), Int) -> ((Int, Int), Int)
+f 0 acc = acc
+f m !acc = f (m - 1) (stepAB acc)
 
-solve1 :: (Int64, Int64) -> Int
-solve1 (x, y) = snd $ solve1' ((x, y), 0) 40000000
+f' :: Int -> ((Int, Int), Int) -> ((Int, Int), Int)
+f' 0 acc = acc
+f' m !acc = f' (m - 1) (stepAB' acc)
 
-input :: (Int64, Int64)
+solve1 :: (Int, Int) -> Int
+solve1 (x, y) = snd $ f 40000000 ((x, y), 0)
+
+solve2 :: (Int, Int) -> Int
+solve2 (x, y) = snd $ f' 5000000 ((x, y), 0)
+
+input :: (Int, Int)
 input = (783, 325)
 
-main = (putStrLn . show . solve1) input
+input0 = (65, 8921) :: (Int, Int)
+
+--main = (putStrLn . show . solve1) input
+main = (putStrLn . show . solve2) input