src/advent17/advent17.hs

   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 #-}
  10
  11 -- import Prelude hiding ((++))
  12 import Data.Vector.Unboxed ((!))
  13 import qualified Data.Vector.Unboxed as V
  14 import Data.List (foldl')
  15
  16 type RingBuffer = V.Vector Int
  17
  18 initialStepSize :: Int
  19 initialStepSize = 366
  20
  21 initialRingBuffer :: RingBuffer
  22 initialRingBuffer = V.singleton 0
  23
  24
  25 main :: IO ()
  26 main = do
  27         print $ part1 2017
  28         -- print $ part2 50000000
  29         print $ ith 2017 366
  30         print $ oneth 50000000 366
  31
  32
  33
  34 part1 :: Int -> Int
  35 part1 k = (!1) $ (iterate updateRingBuffer initialRingBuffer)!!k
  36
  37 part2 :: Int -> Int
  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)
  42
  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
  49
  50
  51
  52 (%) = mod
  53
  54 ith :: Int -> Int -> Int
  55 ith i steps =
  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))
  59             (0, [0]) [1..i]
  60     in  list !! (position + 1)
  61
  62 oneth :: Int -> Int -> Int
  63 oneth i steps =
  64     snd $ foldl' (\(currPos, currOneth) n ->
  65         let !newPos = (currPos + steps % n + 1) % n
  66         in  (newPos, if newPos == 0 then n else currOneth))
  67         (0, 1) [1..i]
  68
  69 -- main :: IO ()
  70 -- main = do
  71 --     print $ ith   2017     312
  72 --     print $ oneth 50000000 312