finished day 15 and day 17 part 2

9 files changed, 43 insertions, 18 deletions

diff --git a/.Puzzle17.hs.swp b/.Puzzle17.hs.swp
deleted file mode 100644
index 4873b94..0000000
--- a/.Puzzle17.hs.swp
+++ /dev/null
diff --git a/Puzzle15 b/Puzzle15
index 5b98560..cea91ec 100755
--- a/Puzzle15
+++ b/Puzzle15
diff --git a/Puzzle15.hi b/Puzzle15.hi
index 2df21fd..c3b5b63 100644
--- a/Puzzle15.hi
+++ b/Puzzle15.hi
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
diff --git a/Puzzle15.o b/Puzzle15.o
index 0303362..575aff1 100644
--- a/Puzzle15.o
+++ b/Puzzle15.o
diff --git a/Puzzle17 b/Puzzle17
index 79e5c36..4b0d63c 100755
--- a/Puzzle17
+++ b/Puzzle17
diff --git a/Puzzle17.hi b/Puzzle17.hi
index 070faf5..062ceab 100644
--- a/Puzzle17.hi
+++ b/Puzzle17.hi
diff --git a/Puzzle17.hs b/Puzzle17.hs
index ff2d0d7..0cdaf54 100644
--- a/Puzzle17.hs
+++ b/Puzzle17.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 insert :: Int -> Int -> [Int] -> [Int]
 insert k x xs = let (ys, zs) = splitAt k xs in ys ++ (x:zs)
 
@@ -5,20 +7,22 @@ step :: Int -> ([Int], Int, Int) -> ([Int], Int, Int)
 step n (xs, pos, l) = let newpos = (pos + n) `rem` l + 1 in (insert newpos l xs, newpos, l + 1)
 
 step' :: Int -> (Int, Int, Int) -> (Int, Int, Int)
-step' n (x, pos, l) = let newpos = (pos + n) `rem` l + 1 in 
+step' n (!x, !pos, !l) = let newpos = (pos + n) `rem` l + 1 in 
   (if newpos == 1 then l else x, newpos, l + 1)
 
 f :: Int -> Int -> ([Int], Int, Int)
 f n m = foldl1 (.) (replicate m (step n)) ([0], 0, 1)
 
-f' :: Int -> Int -> (Int, Int, Int)
-f' n m = foldl1 (.) (replicate m (step' n)) (-1, 0, 1)
+f' :: Int -> Int -> (Int, Int, Int) -> (Int, Int, Int)
+f' n 0 acc = acc
+--f' n m = step' n (f' n (m - 1))
+f' n m !acc = f' n (m - 1) (step' n acc)
 
 solve1 :: Int -> Int
 solve1 n = let (xs, pos, l) = f n 2017 in xs !! (pos + 1)
 
 solve2 :: Int -> Int
-solve2 n = let (x, pos, l) = f' n 50000000 in x
+solve2 n = let (x, pos, l) = f' n 50000000 (-1, 0, 1) in x
 
 input0 :: Int
 input0 = 3
diff --git a/Puzzle17.o b/Puzzle17.o
index 76d835f..afa9ebd 100644
--- a/Puzzle17.o
+++ b/Puzzle17.o