From 0f8bf3b8acf20d14c71dcdd6bca5ce1f5bcf479f Mon Sep 17 00:00:00 2001
From: Anup Kishore <anup@secondspectrum.com>
Date: Fri, 23 Feb 2018 20:48:46 +0530
Subject: [PATCH] Day 6.1

---
 day6/Main.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 package.yaml |  3 ++
 2 files changed, 88 insertions(+)
 create mode 100644 day6/Main.hs

diff --git a/day6/Main.hs b/day6/Main.hs
new file mode 100644
index 0000000..4b16b70
--- /dev/null
+++ b/day6/Main.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Main where
+
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import Data.Set (Set)
+import Paths_aoc2017
+import System.Environment (getArgs)
+import System.Exit (exitSuccess)
+
+file :: IO FilePath
+file = getDataFileName "data/6-1"
+
+getData :: IO [Int]
+getData = map read . words <$> (readFile =<< file)
+
+usage :: IO ()
+usage = putStrLn "Usage: stack exec day-n -- [--two] [...args]"
+
+data St = St
+  { seen :: Set [Int]
+  , jumps :: Int
+  , blocks :: [Int]
+  }
+
+initSt :: [Int] -> Either St St
+initSt blocks = Left St {seen = Set.singleton blocks, jumps = 0, blocks = blocks}
+
+maxWithIndex
+  :: (Ord b)
+  => [b] -> (b, Int)
+maxWithIndex = maximum . flip zip [0 ..]
+
+intoList
+  :: Foldable b
+  => b a -> [a]
+intoList = foldr (:) []
+
+{-
+- List of numbers
+- set ix of max to 0
+- update all by (div max 16)
+- update take (rem max 16) . drop ix $ cycle [0..16]
+- [0 1 2 3 4 5 6]
+-          6
+- ix - (7 - 6)
+-}
+perform' :: St -> St
+perform' st@St {blocks} =
+  let (m, ix) = maxWithIndex blocks
+      (d, r) = m `divMod` 16
+      updater :: Int -> (Int -> Int)
+      updater i
+        | i == ix = const d
+        | i > ix && i <= (ix + r) = (+) $d + 1
+        | i < ix && i <= ix - (16 - r) = (+) $d + 1
+        | otherwise = (+ d)
+  in st {blocks = map (uncurry ($)) . flip zip blocks $ map updater [0 .. 16]}
+
+check :: St -> Either St St
+check St {seen, jumps, blocks} =
+  if Set.member blocks seen
+    then Right St {seen, blocks, jumps}
+    else Left St {seen = Set.insert blocks seen, jumps = jumps + 1, blocks = blocks}
+
+perform :: Either St St -> Int
+perform = either (perform . check . perform') jumps
+
+doOne :: [String] -> IO Int
+doOne _ = perform . initSt <$> getData
+
+doTwo :: [String] -> IO Int
+doTwo _ = undefined <$> getData
+
+parse :: [String] -> IO ()
+parse ("--two":xs) = print =<< doTwo xs
+parse ["--help"] = usage
+parse xs = print =<< doOne xs
+
+main :: IO ()
+main = do
+  args <- getArgs
+  parse args
+  exitSuccess
diff --git a/package.yaml b/package.yaml
index 83aaee0..dd53437 100644
--- a/package.yaml
+++ b/package.yaml
@@ -49,6 +49,9 @@ executables:
   day-5:
     <<: *fast-exe
     source-dirs: day5
+  day-6:
+    <<: *base-exe
+    source-dirs: day6
 
 
 tests: