{-# Language ImportQualifiedPost, QuasiQuotes #-}
{-|
Module      : Main
Description : Day 9 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/9>

This solution takes advantage of "Data.Sequence" providing efficient
access to both ends of a sequence. This gives us a amortized constant
time rotation operation and allows the solution to run quickly even at
the part 2 input size.

-}
{-# Language OverloadedStrings #-}
module Main (main) where

import Advent.Format (format)
import Data.IntMap.Strict qualified as IntMap
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq

-- | Print the answers to day 9
--
-- >>> :main
-- 422980
-- 3552041936
main :: IO ()
IO ()
main =
  do [(Int
players, Int
marbles)] <- [format|2018 9 (%u players; last marble is worth %u points%n)*|]
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> Int -> Int
game Int
players Int
marbles)
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> Int -> Int
game Int
players (Int
100Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
marbles))

-- | Player the marble game, find maximum score
--
-- >>> game 10 1618
-- 8317
-- >>> game 13 7999
-- 146373
-- >>> game 17 1104
-- 2764
-- >>> game 21 6111
-- 54718
-- >>> game 30 5807
-- 37305
game :: Int {- ^ players -} -> Int {- ^ max marble -} -> Int {- ^ max score -}
game :: Int -> Int -> Int
game Int
players Int
marbles = IntMap Int -> Seq Int -> Int -> Int
go IntMap Int
forall a. IntMap a
IntMap.empty (Int -> Seq Int
forall a. a -> Seq a
Seq.singleton Int
0) Int
1
  where
    go :: IntMap Int -> Seq Int -> Int -> Int
go IntMap Int
scores Seq Int
circle Int
i

      -- game over, find winning score
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
marbles = IntMap Int -> Int
forall a. Ord a => IntMap a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum IntMap Int
scores

      -- scoring marble, update current elf's score
      | Int -> Bool
isScoreMarble Int
i =
          case Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
rotate (-Int
7) Seq Int
circle of
            Seq Int
Seq.Empty              -> String -> Int
forall a. HasCallStack => String -> a
error String
"game: empty circle"
            Int
picked Seq.:<| Seq Int
circle' -> IntMap Int -> Seq Int -> Int -> Int
go IntMap Int
scores' Seq Int
circle' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              where
                scores' :: IntMap Int
scores' = (Int -> Int -> Int) -> Int -> Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
players) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
picked) IntMap Int
scores

      -- normal turn, just add the marble
      | Bool
otherwise = IntMap Int -> Seq Int -> Int -> Int
go IntMap Int
scores (Int
i Int -> Seq Int -> Seq Int
forall a. a -> Seq a -> Seq a
Seq.<| Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
rotate Int
2 Seq Int
circle) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Rotate the elements of a sequence. Positive numbers index from the front.
-- Negative numbers index from the back. Indexes wrap around.
--
-- >>> rotate (-2) (Seq.fromList [0..10])
-- fromList [9,10,0,1,2,3,4,5,6,7,8]
-- >>> rotate 2 (Seq.fromList [0..10])
-- fromList [2,3,4,5,6,7,8,9,10,0,1]
-- >>> rotate 10 (Seq.fromList [0..2])
-- fromList [1,2,0]
rotate :: Int -> Seq a -> Seq a
rotate :: forall a. Int -> Seq a -> Seq a
rotate Int
n Seq a
xs
  | Seq a -> Bool
forall a. Seq a -> Bool
Seq.null Seq a
xs = Seq a
xs
  | Bool
otherwise   = case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
xs) Seq a
xs of
                    (Seq a
l, Seq a
r) -> Seq a
r Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
l

-- | Predicate for marbles that trigger a score event
isScoreMarble :: Int -> Bool
isScoreMarble :: Int -> Bool
isScoreMarble Int
i = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
23 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0