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
|
||||
--
|
||||
-- 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:
|
||||
|
|
16
app/Main.hs
16
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)
|
||||
|
|
|
@ -29,6 +29,7 @@ library:
|
|||
- Day14
|
||||
- Day15
|
||||
- Day16
|
||||
- Day17
|
||||
dependencies:
|
||||
- base >=4.7 && <5
|
||||
- protolude
|
||||
|
|
66
src/Day16.hs
66
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
|
||||
|
|
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
|
||||
|
||||
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]
|
||||
|
|
Loading…
Reference in a new issue