trying to get back on track...
This commit is contained in:
parent
a6f059feb6
commit
b0b3abff27
6 changed files with 231 additions and 31 deletions
|
@ -2,7 +2,7 @@
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 31e05860d959d56216fb654ea1de930cc755c6df1d83d10b43259637eed396c4
|
-- hash: f9a4697d8f11ab3d8140e99316d613f42cd6e2550804b33ce3045f2fb81715a1
|
||||||
|
|
||||||
name: adventofcode
|
name: adventofcode
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -46,8 +46,8 @@ library
|
||||||
Day14
|
Day14
|
||||||
Day15
|
Day15
|
||||||
Day16
|
Day16
|
||||||
other-modules:
|
|
||||||
Day17
|
Day17
|
||||||
|
other-modules:
|
||||||
Permutations
|
Permutations
|
||||||
Paths_adventofcode
|
Paths_adventofcode
|
||||||
build-depends:
|
build-depends:
|
||||||
|
|
16
app/Main.hs
16
app/Main.hs
|
@ -24,6 +24,7 @@ import qualified Day13
|
||||||
import qualified Day14
|
import qualified Day14
|
||||||
import qualified Day15
|
import qualified Day15
|
||||||
import qualified Day16
|
import qualified Day16
|
||||||
|
import qualified Day17
|
||||||
|
|
||||||
showSol :: [Char] -> Doc -> IO ()
|
showSol :: [Char] -> Doc -> IO ()
|
||||||
showSol txt d = putText . toS . render $
|
showSol txt d = putText . toS . render $
|
||||||
|
@ -53,6 +54,7 @@ solutions = Map.fromList [(["01"], day01)
|
||||||
,(["14"], day14)
|
,(["14"], day14)
|
||||||
,(["15"], day15)
|
,(["15"], day15)
|
||||||
,(["16"], day16)
|
,(["16"], day16)
|
||||||
|
,(["17"], day17)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -184,7 +186,7 @@ day15 = do
|
||||||
let sol1 = Day15.solution1 Day15.input
|
let sol1 = Day15.solution1 Day15.input
|
||||||
showSol "Solution 1" (int sol1)
|
showSol "Solution 1" (int sol1)
|
||||||
let sol2 = Day15.solution2 Day15.input
|
let sol2 = Day15.solution2 Day15.input
|
||||||
showSol "Solution 1" (int sol2)
|
showSol "Solution 2" (int sol2)
|
||||||
|
|
||||||
day16 :: IO ()
|
day16 :: IO ()
|
||||||
day16 = do
|
day16 = do
|
||||||
|
@ -192,5 +194,13 @@ day16 = do
|
||||||
input <- Day16.parseInput
|
input <- Day16.parseInput
|
||||||
sol1 <- Day16.solution1 16 input
|
sol1 <- Day16.solution1 16 input
|
||||||
showSol "Solution 1" (text (toS sol1))
|
showSol "Solution 1" (text (toS sol1))
|
||||||
sol2 <- Day16.solution2 16 input
|
-- sol2 <- Day16.solution2 16 input
|
||||||
showSol "Solution 2" (text (toS sol2))
|
-- 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)
|
||||||
|
|
|
@ -29,6 +29,7 @@ library:
|
||||||
- Day14
|
- Day14
|
||||||
- Day15
|
- Day15
|
||||||
- Day16
|
- Day16
|
||||||
|
- Day17
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >=4.7 && <5
|
- base >=4.7 && <5
|
||||||
- protolude
|
- protolude
|
||||||
|
|
66
src/Day16.hs
66
src/Day16.hs
|
@ -1,8 +1,11 @@
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
{-| description:
|
{-| description:
|
||||||
|
|
||||||
--- Day 16: Permutation Promenade ---
|
--- Day 16: Permutation Promenade ---
|
||||||
|
|
||||||
You come upon a very unusual sight; a group of programs here appear to be
|
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?
|
In what order are the programs standing after their billion dances?
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|-}
|
|-}
|
||||||
|
|
||||||
module Day16 where
|
module Day16 where
|
||||||
|
|
||||||
import Protolude hiding ((<|>),swap,rotate,(<>))
|
import Protolude hiding (rotate, swap, (<>), (<|>))
|
||||||
|
|
||||||
import Data.IORef
|
import Data.Array
|
||||||
import Data.Semigroup (Semigroup, (<>), stimes)
|
import Data.Array.IO (IOUArray)
|
||||||
import Data.Array
|
import Data.Array.MArray
|
||||||
import Data.Array.MArray
|
import Data.IORef
|
||||||
import Data.Array.IO (IOUArray)
|
import Data.Semigroup (Semigroup, stimes, (<>))
|
||||||
import Text.Parsec
|
import Permutations
|
||||||
import Permutations
|
import Text.Parsec
|
||||||
|
|
||||||
testInput :: [Command]
|
testInput :: [Command]
|
||||||
testInput = readInput "s1,x3/4,pe/b"
|
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
|
, revarr :: IOUArray Char Int
|
||||||
, cursor :: IORef Int
|
, cursor :: IORef Int
|
||||||
, size :: Int
|
, size :: Int
|
||||||
}
|
}
|
||||||
|
|
||||||
showFastarr :: FastArr -> IO ()
|
showFastarr :: FastArr -> IO ()
|
||||||
|
@ -127,8 +128,8 @@ showFastarr fastarr = do
|
||||||
|
|
||||||
|
|
||||||
last :: [a] -> Maybe a
|
last :: [a] -> Maybe a
|
||||||
last [] = Nothing
|
last [] = Nothing
|
||||||
last [x] = Just x
|
last [x] = Just x
|
||||||
last (_:xs) = last xs
|
last (_:xs) = last xs
|
||||||
|
|
||||||
solution1 :: Int -> [Command] -> IO [Char]
|
solution1 :: Int -> [Command] -> IO [Char]
|
||||||
|
@ -191,22 +192,39 @@ solution2bruteforce len commands = do
|
||||||
|
|
||||||
data Dance = Dance { iperm :: Permutation Int
|
data Dance = Dance { iperm :: Permutation Int
|
||||||
, cperm :: Permutation Char
|
, cperm :: Permutation Char
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
applyCmd :: Command -> Dance -> Dance
|
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 (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 :: Int -> Int -> [Command] -> [Char]
|
||||||
solution2 len commands = do
|
solution2 len nbIter commands = do
|
||||||
let letters = take len ['a'..'p']
|
let letters = take len ['a'..'p']
|
||||||
lastLetter = fromMaybe 'a' (head (reverse letters))
|
lastLetter = fromMaybe 'a' (head (reverse letters))
|
||||||
initDance = Dance (nullPerm (0,len-1)) (nullPerm ('a',lastLetter))
|
initDance = Dance (nullPerm (0,len-1)) (nullPerm ('a',lastLetter))
|
||||||
firstDance = foldl' (flip applyCmd) initDance commands
|
firstDance = foldl' (flip applyCmd) initDance commands
|
||||||
finalDance = stimes 1 firstDance
|
finalDance = stimes nbIter firstDance
|
||||||
tmpArray = listArray (0,len-1) (elems (unPerm (cperm finalDance)))
|
tmpArray = listArray (0,len-1) (elems (unPerm (cperm finalDance)))
|
||||||
permute (iperm finalDance) tmpArray & elems
|
permute (iperm finalDance) tmpArray & elems
|
||||||
|
|
||||||
instance Semigroup Dance where
|
instance Semigroup Dance where
|
||||||
Dance r1 p1 <> Dance r2 p2 = Dance (r1 <> r2) (p1 <> p2)
|
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
|
||||||
|
|
161
src/Day17.hs
Normal file
161
src/Day17.hs
Normal file
|
@ -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)
|
|
@ -1,5 +1,8 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
module Permutations where
|
module Permutations where
|
||||||
|
|
||||||
|
import Protolude hiding (swap)
|
||||||
|
|
||||||
import Data.Array
|
import Data.Array
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.Semigroup
|
import Data.Semigroup
|
||||||
|
@ -18,6 +21,12 @@ permute (Permutation p) a =
|
||||||
where
|
where
|
||||||
b@(i0,iN) = bounds a
|
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 :: Array Int Int
|
||||||
testPerm = listArray (0,4) [3,2,4,1,0]
|
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]
|
nullPerm bnds@(start,end) = Permutation $ listArray bnds [start..end]
|
||||||
|
|
||||||
swap :: (Ix i) => i -> i -> Permutation i -> Permutation i
|
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 :: (Ix i) => Int -> Permutation i -> Permutation i
|
||||||
rotate n (Permutation p) =
|
rotate n (Permutation p) =
|
||||||
|
@ -38,4 +47,5 @@ rotate n (Permutation p) =
|
||||||
in Permutation (p // newis)
|
in Permutation (p // newis)
|
||||||
|
|
||||||
instance (Ix i,Enum i) => Semigroup (Permutation i) where
|
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]
|
||||||
|
|
Loading…
Reference in a new issue