-- nix-shell -p 'haskellPackages.ghcWithPackages (pkgs: [pkgs.massiv])' --run 'ghc Test.hs; time ./Test'
-- [1 of 1] Compiling Main ( Test.hs, Test.o )
-- Linking Test ...
-- 175594
--
-- real 0m15.230s
-- user 0m15.174s
-- sys 0m0.056s
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad (forM_)
import Control.Monad.ST
import Data.Int
import qualified Data.Massiv.Array as A
type Task = [Int32]
work :: Int32 -> Task -> Int32
work last_index input = runST $ do
mem <- A.new @A.U (A.Sz1 $ fromIntegral $ last_index + 2)
forM_ (zip [1..] input) $ \(idx, x) -> do
A.writeM mem (fromIntegral x) idx
let go idx prev | idx == last_index + 1 = pure prev
go idx prev = do
cur <- A.readM mem (fromIntegral prev) >>= \case
0 -> pure 0
prev_idx -> pure (idx - prev_idx - 1)
A.writeM mem (fromIntegral prev) (idx - 1)
go (idx + 1) cur
go (fromIntegral $ length input + 1) (last input)
main = putStrLn . show $ work 30000000 [0, 3, 6]
-- nix-shell -p 'haskellPackages.ghcWithPackages (pkgs: [])' --run 'ghc Test.hs; time ./Test'
-- [1 of 1] Compiling Main ( Test.hs, Test.o )
-- Linking Test ...
-- 175594
--
-- real 0m33.801s
-- user 0m33.204s
-- sys 0m0.572s
{-# LANGUAGE TupleSections #-}
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Maybe (fromMaybe)
solveFor :: Int -> [Int] -> Int
solveFor lastTurn xs =
go (length xs + 1, head (reverse xs), IntMap.fromList $ zip xs ((,0) <$> [1 ..]))
where
go :: (Int, Int, IntMap (Int, Int)) -> Int
go (turn, last, m)
| turn > lastTurn = last
| Just (a, b) <- IntMap.lookup last m, b /= 0 = go (next turn (a - b) m)
| otherwise = go (next turn 0 m)
next :: Int -> Int -> IntMap (Int, Int) -> (Int, Int, IntMap (Int, Int))
next t n m = (t + 1, n, IntMap.insert n (t, fromMaybe 0 (fst <$> IntMap.lookup n m)) m)
main = putStrLn . show $ solveFor 30000000 [0, 3, 6]
-- nix-shell -p 'haskellPackages.ghcWithPackages (pkgs: [pkgs.hashtables])' --run 'ghc Test.hs; time ./Test'
-- [1 of 1] Compiling Main ( Test.hs, Test.o )
-- Linking Test ...
-- 175594
--
-- real 2m15.024s
-- user 2m14.865s
-- sys 0m0.156s
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
import Control.Monad.ST
import qualified Data.HashTable.Class as MHM
import Data.HashTable.ST.Linear (HashTable)
import Data.Maybe (fromMaybe)
solveForMut :: Int -> [Int] -> Int
solveForMut limit xs = runST $ do
hm <- MHM.fromList $ zip xs [1 ..]
go hm (length xs + 1) (last xs)
where
go :: HashTable s Int Int -> Int -> Int -> ST s Int
go hm t prev
| t > limit = pure prev
| otherwise = do
cur <-
MHM.lookup hm prev >>= \case
Just pt | pt > 0 -> pure (t - pt - 1)
_ -> pure 0
MHM.insert hm prev (t - 1)
go hm (t + 1) cur
main = putStrLn . show $ solveForMut 30000000 [0, 3, 6]
-- nix-shell -p 'haskellPackages.ghcWithPackages (pkgs: [pkgs.vector])' --run 'ghc Test.hs; tim e ./Test'
-- [1 of 1] Compiling Main ( Test.hs, Test.o )
-- Linking Test ...
-- Just 175594
--
-- real 0m19.813s
-- user 0m19.660s
-- sys 0m0.152s
{-# LANGUAGE BangPatterns #-}
import Control.Monad (forM_)
import Control.Monad.ST
import Data.Foldable (foldlM)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Vector.Mutable as VM
run :: NonEmpty Int -> Int -> Maybe Int
run input target
| target <= 0 = Nothing
| target <= length input = Just $ input NE.!! (target - 1)
| otherwise = let len = length input
in Just $ runST $ do
{ v <- VM.replicate (maximum (target : NE.toList input) + 1) 0
; forM_ (zip (NE.init input) [1..]) $ uncurry (VM.write v)
; foldlM (speakNum v) (NE.last input) [len..target-1]
}
speakNum :: VM.MVector s Int -> Int -> Int -> ST s Int
speakNum !v !prev i = do
{ prevPos <- VM.unsafeRead v prev
; VM.write v prev i
; return $ if prevPos == 0 then 0 else i - prevPos
}
main = putStrLn . show $ run (0:|[3,6]) 30000000
-- nix-shell -p 'haskellPackages.ghcWithPackages (pkgs: [pkgs.vector])' --run 'ghc Test.hs; tim e ./Test'
-- [1 of 1] Compiling Main ( Test.hs, Test.o )
-- Linking Test ...
-- Just 175594
--
-- real 0m5.085s
-- user 0m5.013s
-- sys 0m0.072s
{-# LANGUAGE BangPatterns #-}
import Control.Monad (forM_)
import Control.Monad.ST
import Data.Foldable (foldlM)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Vector.Unboxed.Mutable as VM
run :: NonEmpty Int -> Int -> Maybe Int
run input target
| target <= 0 = Nothing
| target <= length input = Just $ input NE.!! (target - 1)
| otherwise = let len = length input
in Just $ runST $ do
{ v <- VM.replicate (maximum (target : NE.toList input) + 1) 0
; forM_ (zip (NE.init input) [1..]) $ uncurry (VM.write v)
; foldlM (speakNum v) (NE.last input) [len..target-1]
}
speakNum :: VM.MVector s Int -> Int -> Int -> ST s Int
speakNum !v !prev i = do
{ prevPos <- VM.unsafeRead v prev
; VM.write v prev i
; return $ if prevPos == 0 then 0 else i - prevPos
}
main = putStrLn . show $ run (0:|[3,6]) 30000000
