Initial commit

2017/17/day17.hs

@@ -0,0 +1,26 @@
+#!/usr/bin/env stack
+-- stack --resolver lts-9.18 script
+
+{-# LANGUAGE BangPatterns #-}
+
+import Data.List
+
+rotate :: Int -> [a] -> [a]
+rotate n xs = take (length xs) (drop n (cycle xs))
+
+spinlock :: (Num a, Enum a) => a -> Int -> [a] -> [a]
+spinlock n steps buf = foldl' f buf [1..n]
+  where f !curbuf !i = let !newbuf = rotate (steps+1) curbuf in i:newbuf
+
+valueAfter :: Eq t => t -> [t] -> t
+valueAfter n buf = buf !! ((i + 1) `rem` length buf)
+  where Just i = elemIndex n buf
+
+main :: IO ()
+main = do
+  let input = 312
+      n = 2017
+      start = [0]
+  print $ valueAfter n $ spinlock n input start
+  -- let n = 50000000
+  -- print $ valueAfter 0 $ spinlock n input start

2017/17/day17.scm

@@ -0,0 +1,25 @@
+;; $ csc day17.scm -o day17 -O5
+;; $ ./day17 -:hm8g
+
+(use srfi-1)
+(declare (fixnum))
+
+(define (prepend! x list)
+  (set-cdr! list (cons (car list) (cdr list)))
+  (set-car! list x))
+
+(define (spin steps n after)
+  (let ((buffer (circular-list 0)))
+    (do ((i 1 (+ i 1)))
+	((> i n) (cadr (member after buffer)))
+      (let ((new (drop buffer (+ steps 1))))
+	(prepend! i new)
+	(set! buffer new)))))
+
+(write (spin 3 2017 2017))
+(newline)
+(write (spin 312 2017 2017))
+(newline)
+(write (spin 312 50000000 0))
+(newline)
+