1 {-# LANGUAGE NegativeLiterals #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
5 {-# LANGUAGE NegativeLiterals #-}
6 {-# LANGUAGE FlexibleContexts #-}
7 {-# LANGUAGE OverloadedStrings #-}
8 {-# LANGUAGE TypeFamilies #-}
9 {-# LANGUAGE BangPatterns #-}
11 -- import Prelude hiding ((++))
12 import Data.Vector.Unboxed ((!))
13 import qualified Data.Vector.Unboxed as V
14 import Data.List (foldl')
16 type RingBuffer = V.Vector Int
18 initialStepSize :: Int
21 initialRingBuffer :: RingBuffer
22 initialRingBuffer = V.singleton 0
28 -- print $ part2 50000000
30 print $ oneth 50000000 366
35 part1 k = (!1) $ (iterate updateRingBuffer initialRingBuffer)!!k
38 part2 k = finalBuffer!targetLoc
39 where finalBuffer = (iterate updateRingBuffer initialRingBuffer)!!k
40 zeroLoc = V.head $ V.elemIndices 0 finalBuffer
41 targetLoc = (zeroLoc + 1) `rem` (V.length finalBuffer)
43 updateRingBuffer :: RingBuffer -> RingBuffer
44 updateRingBuffer buffer = buffer'
45 where nextPos = (initialStepSize + 1) `rem` V.length buffer
46 (start, end) = V.splitAt nextPos buffer
47 nextValue = V.length buffer
48 buffer' = V.cons nextValue $ (V.++) end start
54 ith :: Int -> Int -> Int
56 let (position, list) = foldl' (\(currPos, currList) n ->
57 let newPos = (currPos + steps % n + 1) % n
58 in (newPos, take newPos currList ++ [n] ++ drop newPos currList))
60 in list !! (position + 1)
62 oneth :: Int -> Int -> Int
64 snd $ foldl' (\(currPos, currOneth) n ->
65 let !newPos = (currPos + steps % n + 1) % n
66 in (newPos, if newPos == 0 then n else currOneth))
71 -- print $ ith 2017 312
72 -- print $ oneth 50000000 312