72 lines
2.0 KiB
Haskell
Executable File
72 lines
2.0 KiB
Haskell
Executable File
#! /usr/bin/env stack
|
|
-- stack --resolver lts-12.20 --install-ghc script
|
|
{-# LANGUAGE LambdaCase, TemplateHaskell #-}
|
|
module Main where
|
|
|
|
import Control.Category ((>>>), (<<<))
|
|
import Control.Lens
|
|
import qualified Control.Monad.State as St
|
|
import qualified Data.List as L
|
|
import qualified Data.Map as M
|
|
import qualified Data.Sequence as Seq
|
|
|
|
import Debug.Trace
|
|
|
|
type Score = Int
|
|
type Marble = Int
|
|
|
|
-- Circular sequence convention:
|
|
-- current <| first CW <| ... <| first CCW
|
|
|
|
data Game = Game
|
|
{ _gameMarbles :: Seq.Seq Marble
|
|
, _gamePlayers :: Seq.Seq Score
|
|
} deriving Show
|
|
makeClassy ''Game
|
|
|
|
-- 1st CCW becomes current; current becomes 1st CW
|
|
rotateCW :: (HasGame c) => Int -> St.State c ()
|
|
rotateCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
|
|
s' :> x -> x <| s'
|
|
|
|
-- 1st CW becomes current; current becomes 1st CCW
|
|
rotateCCW :: (HasGame c) => Int -> St.State c ()
|
|
rotateCCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
|
|
x :< s' -> s' |> x
|
|
|
|
nextPlayer :: (HasGame c) => St.State c ()
|
|
nextPlayer = St.modify $ game . gamePlayers %~ \case
|
|
x :< s' -> s' |> x
|
|
|
|
insertMarble :: (HasGame c) => Marble -> St.State c ()
|
|
insertMarble m = St.modify $ game . gameMarbles %~ (m <|)
|
|
|
|
removeMarble :: (HasGame c) => St.State c Marble
|
|
removeMarble = St.state $ game . gameMarbles %%~ \case
|
|
x :< s' -> (x, s')
|
|
|
|
addScore :: (HasGame c) => Int -> St.State c ()
|
|
addScore delta = St.modify $ game . gamePlayers . _head +~ delta
|
|
|
|
newGame nPlayers = Game
|
|
{ _gameMarbles = Seq.singleton 0
|
|
, _gamePlayers = Seq.replicate nPlayers 0
|
|
}
|
|
|
|
runGame :: Int -> Int -> Game
|
|
runGame nPlayers lastMarble = flip St.execState (newGame nPlayers) $ do
|
|
St.forM_ [1..lastMarble] $ \marble -> do
|
|
--St.get >>= traceM . show
|
|
if marble `mod` 23 /= 0
|
|
then rotateCCW 2 *> insertMarble marble
|
|
else do
|
|
addScore marble
|
|
rotateCW 7
|
|
m <- removeMarble
|
|
addScore m
|
|
nextPlayer
|
|
|
|
main :: IO ()
|
|
--main = print $ runGame 9 25
|
|
main = print $ maximum $ view gamePlayers $ runGame 416 71617
|