better day16
This commit is contained in:
parent
7b71fbcac0
commit
a6f059feb6
4 changed files with 106 additions and 36 deletions
|
@ -2,22 +2,22 @@
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 587471fb4a9e3e35e4a8caa85fa326f402b6840f011abfe42a46f3ea9b123026
|
-- hash: 31e05860d959d56216fb654ea1de930cc755c6df1d83d10b43259637eed396c4
|
||||||
|
|
||||||
name: adventofcode
|
name: adventofcode
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
synopsis: Solutions for adventofcode
|
synopsis: Solutions for adventofcode
|
||||||
description: Please see the README on Github at <https://github.com/yogsototh/adventofcode#readme>
|
homepage: https://github.com/yogsototh/adventofcode#readme
|
||||||
category: Web
|
bug-reports: https://github.com/yogsototh/adventofcode/issues
|
||||||
homepage: https://github.com/yogsototh/adventofcode#readme
|
license: BSD3
|
||||||
bug-reports: https://github.com/yogsototh/adventofcode/issues
|
license-file: LICENSE
|
||||||
author: Yann Esposito
|
author: Yann Esposito
|
||||||
maintainer: yann.esposito@gmail.com
|
maintainer: yann.esposito@gmail.com
|
||||||
copyright: Copyright: © 2017 Yann Esposito
|
copyright: Copyright: © 2017 Yann Esposito
|
||||||
license: BSD3
|
category: Web
|
||||||
license-file: LICENSE
|
build-type: Simple
|
||||||
build-type: Simple
|
cabal-version: >= 1.10
|
||||||
cabal-version: >= 1.10
|
description: Please see the README on Github at <https://github.com/yogsototh/adventofcode#readme>
|
||||||
|
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
README.md
|
README.md
|
||||||
|
@ -29,14 +29,6 @@ source-repository head
|
||||||
library
|
library
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
build-depends:
|
|
||||||
array
|
|
||||||
, base >=4.7 && <5
|
|
||||||
, containers
|
|
||||||
, foldl
|
|
||||||
, parsec
|
|
||||||
, protolude
|
|
||||||
, text
|
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Day01
|
Day01
|
||||||
Day02
|
Day02
|
||||||
|
@ -55,13 +47,24 @@ library
|
||||||
Day15
|
Day15
|
||||||
Day16
|
Day16
|
||||||
other-modules:
|
other-modules:
|
||||||
|
Day17
|
||||||
|
Permutations
|
||||||
Paths_adventofcode
|
Paths_adventofcode
|
||||||
|
build-depends:
|
||||||
|
array
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, containers
|
||||||
|
, foldl
|
||||||
|
, parsec
|
||||||
|
, protolude
|
||||||
|
, text
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable adventofcode-exe
|
executable adventofcode-exe
|
||||||
main-is: Main.hs
|
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
app
|
app
|
||||||
|
main-is: Main.hs
|
||||||
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
adventofcode
|
adventofcode
|
||||||
|
@ -75,10 +78,9 @@ executable adventofcode-exe
|
||||||
|
|
||||||
test-suite adventofcode-test
|
test-suite adventofcode-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
test
|
test
|
||||||
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
main-is: Spec.hs
|
||||||
build-depends:
|
build-depends:
|
||||||
HUnit
|
HUnit
|
||||||
, adventofcode
|
, adventofcode
|
||||||
|
@ -88,4 +90,5 @@ test-suite adventofcode-test
|
||||||
, tasty-hunit
|
, tasty-hunit
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_adventofcode
|
Paths_adventofcode
|
||||||
|
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -37,6 +37,7 @@ library:
|
||||||
- text
|
- text
|
||||||
- array
|
- array
|
||||||
- parsec
|
- parsec
|
||||||
|
- vector
|
||||||
executables:
|
executables:
|
||||||
adventofcode-exe:
|
adventofcode-exe:
|
||||||
main: Main.hs
|
main: Main.hs
|
||||||
|
|
45
src/Day16.hs
45
src/Day16.hs
|
@ -1,7 +1,7 @@
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
{-| description:
|
{-| description:
|
||||||
--- Day 16: Permutation Promenade ---
|
--- Day 16: Permutation Promenade ---
|
||||||
|
|
||||||
|
@ -54,12 +54,15 @@ In what order are the programs standing after their billion dances?
|
||||||
|
|
||||||
module Day16 where
|
module Day16 where
|
||||||
|
|
||||||
import Protolude hiding ((<|>),swap)
|
import Protolude hiding ((<|>),swap,rotate,(<>))
|
||||||
|
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import Data.Semigroup (Semigroup, (<>), stimes)
|
||||||
|
import Data.Array
|
||||||
import Data.Array.MArray
|
import Data.Array.MArray
|
||||||
import Data.Array.IO (IOUArray)
|
import Data.Array.IO (IOUArray)
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
|
import Permutations
|
||||||
|
|
||||||
testInput :: [Command]
|
testInput :: [Command]
|
||||||
testInput = readInput "s1,x3/4,pe/b"
|
testInput = readInput "s1,x3/4,pe/b"
|
||||||
|
@ -151,24 +154,24 @@ applyCommand fastarr (Exchange rawi rawj) = do
|
||||||
j = (rawj - cur) `mod` s
|
j = (rawj - cur) `mod` s
|
||||||
li <- readArray (arr fastarr) i
|
li <- readArray (arr fastarr) i
|
||||||
lj <- readArray (arr fastarr) j
|
lj <- readArray (arr fastarr) j
|
||||||
swap i j (arr fastarr)
|
faswap i j (arr fastarr)
|
||||||
swap li lj (revarr fastarr)
|
faswap li lj (revarr fastarr)
|
||||||
applyCommand fastarr (Partner l k) = do
|
applyCommand fastarr (Partner l k) = do
|
||||||
li <- readArray (revarr fastarr) l
|
li <- readArray (revarr fastarr) l
|
||||||
lj <- readArray (revarr fastarr) k
|
lj <- readArray (revarr fastarr) k
|
||||||
swap l k (revarr fastarr)
|
faswap l k (revarr fastarr)
|
||||||
swap li lj (arr fastarr)
|
faswap li lj (arr fastarr)
|
||||||
|
|
||||||
swap :: (MArray a e m, Ix i) => i -> i -> a i e -> m ()
|
faswap :: (MArray a e m, Ix i) => i -> i -> a i e -> m ()
|
||||||
swap i j arr = do
|
faswap i j arr = do
|
||||||
tmpi <- readArray arr i
|
tmpi <- readArray arr i
|
||||||
tmpj <- readArray arr j
|
tmpj <- readArray arr j
|
||||||
writeArray arr i tmpj
|
writeArray arr i tmpj
|
||||||
writeArray arr j tmpi
|
writeArray arr j tmpi
|
||||||
|
|
||||||
-- | brute force, not the real way to do it
|
-- | brute force, not the real way to do it
|
||||||
solution2 :: Int -> [Command] -> IO [Char]
|
solution2bruteforce :: Int -> [Command] -> IO [Char]
|
||||||
solution2 len commands = do
|
solution2bruteforce len commands = do
|
||||||
let letters = take len ['a'..'p']
|
let letters = take len ['a'..'p']
|
||||||
array <- FastArr <$> newListArray (0,len-1) letters
|
array <- FastArr <$> newListArray (0,len-1) letters
|
||||||
<*> newListArray ('a',fromMaybe 'a' (last letters)) [0..len-1]
|
<*> newListArray ('a',fromMaybe 'a' (last letters)) [0..len-1]
|
||||||
|
@ -185,3 +188,25 @@ solution2 len commands = do
|
||||||
curs <- readIORef (cursor array)
|
curs <- readIORef (cursor array)
|
||||||
let shift = size array - curs
|
let shift = size array - curs
|
||||||
return $ drop shift elems ++ take shift elems
|
return $ drop shift elems ++ take shift elems
|
||||||
|
|
||||||
|
data Dance = Dance { iperm :: Permutation Int
|
||||||
|
, cperm :: Permutation Char
|
||||||
|
}
|
||||||
|
|
||||||
|
applyCmd :: Command -> Dance -> Dance
|
||||||
|
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 }
|
||||||
|
|
||||||
|
solution2 :: Int -> [Command] -> [Char]
|
||||||
|
solution2 len 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
|
||||||
|
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)
|
||||||
|
|
41
src/Permutations.hs
Normal file
41
src/Permutations.hs
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
module Permutations where
|
||||||
|
|
||||||
|
import Data.Array
|
||||||
|
import Data.Proxy
|
||||||
|
import Data.Semigroup
|
||||||
|
import GHC.TypeLits
|
||||||
|
|
||||||
|
newtype Permutation i =
|
||||||
|
Permutation (Array i i)
|
||||||
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
|
unPerm :: Permutation i -> Array i i
|
||||||
|
unPerm (Permutation x) = x
|
||||||
|
|
||||||
|
permute :: (Ix i,Enum i) => Permutation i -> Array i e -> Array i e
|
||||||
|
permute (Permutation p) a =
|
||||||
|
array b [(i, a ! (p ! i)) | i <- [i0..iN] ]
|
||||||
|
where
|
||||||
|
b@(i0,iN) = bounds a
|
||||||
|
|
||||||
|
testPerm :: Array Int Int
|
||||||
|
testPerm = listArray (0,4) [3,2,4,1,0]
|
||||||
|
|
||||||
|
testArray :: Array Int Char
|
||||||
|
testArray = listArray (0,4) ['a'..]
|
||||||
|
|
||||||
|
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)])
|
||||||
|
|
||||||
|
rotate :: (Ix i) => Int -> Permutation i -> Permutation i
|
||||||
|
rotate n (Permutation p) =
|
||||||
|
let is = indices p
|
||||||
|
es = elems p
|
||||||
|
newis = zip (drop n (cycle is)) es
|
||||||
|
in Permutation (p // newis)
|
||||||
|
|
||||||
|
instance (Ix i,Enum i) => Semigroup (Permutation i) where
|
||||||
|
p1 <> Permutation a2 = Permutation $ permute p1 a2
|
Loading…
Reference in a new issue