From b0b3abff271303c64d39aede664f70c6327f9584 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 21 Dec 2017 00:45:37 +0100 Subject: [PATCH] trying to get back on track... --- adventofcode.cabal | 4 +- app/Main.hs | 16 ++++- package.yaml | 1 + src/Day16.hs | 66 +++++++++++------- src/Day17.hs | 161 ++++++++++++++++++++++++++++++++++++++++++++ src/Permutations.hs | 14 +++- 6 files changed, 231 insertions(+), 31 deletions(-) create mode 100644 src/Day17.hs diff --git a/adventofcode.cabal b/adventofcode.cabal index 942b166..c229886 100644 --- a/adventofcode.cabal +++ b/adventofcode.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 31e05860d959d56216fb654ea1de930cc755c6df1d83d10b43259637eed396c4 +-- hash: f9a4697d8f11ab3d8140e99316d613f42cd6e2550804b33ce3045f2fb81715a1 name: adventofcode version: 0.1.0.0 @@ -46,8 +46,8 @@ library Day14 Day15 Day16 - other-modules: Day17 + other-modules: Permutations Paths_adventofcode build-depends: diff --git a/app/Main.hs b/app/Main.hs index cf91a16..6d11e86 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -24,6 +24,7 @@ import qualified Day13 import qualified Day14 import qualified Day15 import qualified Day16 +import qualified Day17 showSol :: [Char] -> Doc -> IO () showSol txt d = putText . toS . render $ @@ -53,6 +54,7 @@ solutions = Map.fromList [(["01"], day01) ,(["14"], day14) ,(["15"], day15) ,(["16"], day16) + ,(["17"], day17) ] @@ -184,7 +186,7 @@ day15 = do let sol1 = Day15.solution1 Day15.input showSol "Solution 1" (int sol1) let sol2 = Day15.solution2 Day15.input - showSol "Solution 1" (int sol2) + showSol "Solution 2" (int sol2) day16 :: IO () day16 = do @@ -192,5 +194,13 @@ day16 = do input <- Day16.parseInput sol1 <- Day16.solution1 16 input showSol "Solution 1" (text (toS sol1)) - sol2 <- Day16.solution2 16 input - showSol "Solution 2" (text (toS sol2)) + -- sol2 <- Day16.solution2 16 input + -- showSol "Solution 2" (text (toS sol2)) + +day17 :: IO () +day17 = do + putText "Day 17:" + sol1 <- Day17.solution1 2017 Day17.input + showSol "Solution 1" (int (fromMaybe 0 sol1)) + let sol2 = Day17.solution2 50000000 Day17.input + showSol "Solution 2" (int sol2) diff --git a/package.yaml b/package.yaml index 55abc48..143b861 100644 --- a/package.yaml +++ b/package.yaml @@ -29,6 +29,7 @@ library: - Day14 - Day15 - Day16 + - Day17 dependencies: - base >=4.7 && <5 - protolude diff --git a/src/Day16.hs b/src/Day16.hs index 61a116c..2979ef4 100644 --- a/src/Day16.hs +++ b/src/Day16.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + {-| description: + --- Day 16: Permutation Promenade --- You come upon a very unusual sight; a group of programs here appear to be @@ -48,21 +51,19 @@ pe/b, swapping programs e and b: ceadb. In what order are the programs standing after their billion dances? - - |-} module Day16 where -import Protolude hiding ((<|>),swap,rotate,(<>)) +import Protolude hiding (rotate, swap, (<>), (<|>)) -import Data.IORef -import Data.Semigroup (Semigroup, (<>), stimes) -import Data.Array -import Data.Array.MArray -import Data.Array.IO (IOUArray) -import Text.Parsec -import Permutations +import Data.Array +import Data.Array.IO (IOUArray) +import Data.Array.MArray +import Data.IORef +import Data.Semigroup (Semigroup, stimes, (<>)) +import Permutations +import Text.Parsec testInput :: [Command] testInput = readInput "s1,x3/4,pe/b" @@ -108,10 +109,10 @@ int = do --- -data FastArr = FastArr { arr :: IOUArray Int Char +data FastArr = FastArr { arr :: IOUArray Int Char , revarr :: IOUArray Char Int , cursor :: IORef Int - , size :: Int + , size :: Int } showFastarr :: FastArr -> IO () @@ -127,8 +128,8 @@ showFastarr fastarr = do last :: [a] -> Maybe a -last [] = Nothing -last [x] = Just x +last [] = Nothing +last [x] = Just x last (_:xs) = last xs solution1 :: Int -> [Command] -> IO [Char] @@ -191,22 +192,39 @@ solution2bruteforce len commands = do data Dance = Dance { iperm :: Permutation Int , cperm :: Permutation Char - } + } deriving (Eq, Show) applyCmd :: Command -> Dance -> Dance -applyCmd (Spin n) d@Dance{..} = d { iperm = rotate n iperm} +applyCmd (Spin n) d@Dance{..} = d { iperm = rotate n iperm } applyCmd (Exchange i j) d@Dance{..} = d { iperm = swap i j iperm } -applyCmd (Partner x y) d@Dance{..} = d { cperm = swap x y cperm } +applyCmd (Partner x y) d@Dance{..} = d { cperm = swap x y cperm } -solution2 :: Int -> [Command] -> [Char] -solution2 len commands = do +solution2 :: Int -> Int -> [Command] -> [Char] +solution2 len nbIter commands = do let letters = take len ['a'..'p'] lastLetter = fromMaybe 'a' (head (reverse letters)) initDance = Dance (nullPerm (0,len-1)) (nullPerm ('a',lastLetter)) firstDance = foldl' (flip applyCmd) initDance commands - finalDance = stimes 1 firstDance + finalDance = stimes nbIter firstDance tmpArray = listArray (0,len-1) (elems (unPerm (cperm finalDance))) permute (iperm finalDance) tmpArray & elems instance Semigroup Dance where Dance r1 p1 <> Dance r2 p2 = Dance (r1 <> r2) (p1 <> p2) + +test n = do + input <- fmap (take n) parseInput + sol1 <- solution1 16 input + let sol2 = solution2 16 1 input + print (head (reverse input)) + print sol1 + print sol2 + return $ sol1 == sol2 + +test2 commands = do + sol1 <- solution1 3 commands + let sol2 = solution2 3 1 commands + print (head (reverse commands)) + print sol1 + print sol2 + return $ sol1 == sol2 diff --git a/src/Day17.hs b/src/Day17.hs new file mode 100644 index 0000000..b31f0bb --- /dev/null +++ b/src/Day17.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Strict #-} +{-| description: + +--- Day 17: Spinlock --- + +Suddenly, whirling in the distance, you notice what looks like a massive, +pixelated hurricane: a deadly spinlock. This spinlock isn't just consuming +computing power, but memory, too; vast, digital mountains are being ripped from +the ground and consumed by the vortex. + +If you don't move quickly, fixing that printer will be the least of your +problems. + +This spinlock's algorithm is simple but efficient, quickly consuming everything +in its path. It starts with a circular buffer containing only the value 0, which +it marks as the current position. It then steps forward through the circular +buffer some number of steps (your puzzle input) before inserting the first new +value, 1, after the value it stopped on. The inserted value becomes the current +position. Then, it steps forward from there the same number of steps, and +wherever it stops, inserts after it the second new value, 2, and uses that as +the new current position again. + +It repeats this process of stepping forward, inserting a new value, and using +the location of the inserted value as the new current position a total of 2017 +times, inserting 2017 as its final operation, and ending with a total of 2018 +values (including 0) in the circular buffer. + +For example, if the spinlock were to step 3 times per insert, the circular +buffer would begin to evolve like this (using parentheses to mark the current +position after each iteration of the algorithm): + +- (0), the initial state before any insertions. +- 0 (1): the spinlock steps forward three times (0, 0, 0), and then inserts the + first value, 1, after it. 1 becomes the current position. +- 0 (2) 1: the spinlock steps forward three times (0, 1, 0), and then inserts + the second value, 2, after it. 2 becomes the current position. +- 0 2 (3) 1: the spinlock steps forward three times (1, 0, 2), and then inserts + the third value, 3, after it. 3 becomes the current position. + +And so on: + +- 0 2 (4) 3 1 +- 0 (5) 2 4 3 1 +- 0 5 2 4 3 (6) 1 +- 0 5 (7) 2 4 3 6 1 +- 0 5 7 2 4 3 (8) 6 1 +- 0 (9) 5 7 2 4 3 8 6 1 + +Eventually, after 2017 insertions, the section of the circular buffer near the +last insertion looks like this: + +1512 1134 151 (2017) 638 1513 851 + +Perhaps, if you can identify the value that will ultimately be after the last +value written (2017), you can short-circuit the spinlock. In this example, that +would be 638. + +What is the value after 2017 in your completed circular buffer? + + +--- Part Two --- + +The spinlock does not short-circuit. Instead, it gets more angry. At least, you +assume that's what happened; it's spinning significantly faster than it was a +moment ago. + +You have good news and bad news. + +The good news is that you have improved calculations for how to stop the +spinlock. They indicate that you actually need to identify the value after 0 in +the current state of the circular buffer. + +The bad news is that while you were determining this, the spinlock has just +finished inserting its fifty millionth value (50000000). + +What is the value after 0 the moment 50000000 is inserted? + +|-} + +module Day17 where + +import Protolude + +import qualified Data.Text as T + +input :: Int +input = 303 +testInput :: Int +testInput = 3 + +data Buffer = Buffer { elems :: [Int] + , pos :: Int + } deriving (Show) + +nextPreStep :: Int -> Buffer -> Buffer +nextPreStep nbSteps b@Buffer{..} = + b { pos = (pos + nbSteps) `rem` length elems } + +showBuffer :: Buffer -> Text +showBuffer Buffer{..} = + zip [0..] elems + & map (\(i,v) -> if i == pos + then "(" <> show v <> ") " + else show v <> " ") + & T.concat + +nextStep :: Int -> Int -> Buffer -> Buffer +nextStep nbSteps roundNumber b = + b + & nextPreStep nbSteps + & addElem roundNumber + -- & \x -> trace (showBuffer x) (addElem roundNumber x) + +addElem :: Int -> Buffer -> Buffer +addElem roundNumber b@Buffer {..} = + b { elems = newelems + , pos = pos + 1 `rem` length newelems + } + where + newelems = take (pos + 1) elems + ++ [roundNumber] + ++ drop (pos + 1) elems + +solution1 :: Int -> Int -> IO (Maybe Int) +solution1 nbOcc nbSteps = go initState 0 + where + initState = Buffer [0] 0 + go st n + | n == nbOcc = st & elems & elemAt (1 + (pos st)) & return + | otherwise = do + -- print st + -- putText $ "> " <> showBuffer st + go (nextStep nbSteps (n+1) st) (n+1) + elemAt :: Int -> [a] -> Maybe a + elemAt 0 (x:xs) = Just x + elemAt n (_:xs) = elemAt (n-1) xs + elemAt _ _ = Nothing + +data Buf2 = Buf2 { position :: Int + , size :: Int + , lastSol :: Int + } + +solution2 :: Int -> Int -> Int +solution2 nbOcc nbSteps = go initState 1 + where + initState = Buf2 0 1 0 + go st@Buf2{..} n + | n == nbOcc = lastSol + | (position + nbSteps) `rem` size == 0 = + traceShow n $ go (st { position = 1 + , lastSol = n + , size = size + 1 + }) + (n+1) + | otherwise = go (st { position = (1 + position + nbSteps) `rem` size + , size = size + 1 }) + (n+1) diff --git a/src/Permutations.hs b/src/Permutations.hs index 1783030..e9d0f65 100644 --- a/src/Permutations.hs +++ b/src/Permutations.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Permutations where +import Protolude hiding (swap) + import Data.Array import Data.Proxy import Data.Semigroup @@ -18,6 +21,12 @@ permute (Permutation p) a = where b@(i0,iN) = bounds a +revpermute :: (Ix i,Enum i) => Permutation i -> Permutation i +revpermute (Permutation p) = + Permutation $ p // [(j,i) | (i,j) <- assocs p] + + + testPerm :: Array Int Int testPerm = listArray (0,4) [3,2,4,1,0] @@ -28,7 +37,7 @@ nullPerm :: (Ix i,Enum i) => (i,i) -> Permutation i nullPerm bnds@(start,end) = Permutation $ listArray bnds [start..end] swap :: (Ix i) => i -> i -> Permutation i -> Permutation i -swap x y (Permutation p) = Permutation (p // [(x,p ! y), (y,p ! x)]) +swap x y (Permutation p) = Permutation (p // [(x,y), (y,x)]) rotate :: (Ix i) => Int -> Permutation i -> Permutation i rotate n (Permutation p) = @@ -38,4 +47,5 @@ rotate n (Permutation p) = in Permutation (p // newis) instance (Ix i,Enum i) => Semigroup (Permutation i) where - p1 <> Permutation a2 = Permutation $ permute p1 a2 + Permutation a1 <> Permutation a2 = Permutation $ + array (bounds a2) [ (i, a2 ! j) | (i,j) <- assocs a1]