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
|
||||
--
|
||||
-- hash: 587471fb4a9e3e35e4a8caa85fa326f402b6840f011abfe42a46f3ea9b123026
|
||||
-- hash: 31e05860d959d56216fb654ea1de930cc755c6df1d83d10b43259637eed396c4
|
||||
|
||||
name: adventofcode
|
||||
version: 0.1.0.0
|
||||
synopsis: Solutions for adventofcode
|
||||
description: Please see the README on Github at <https://github.com/yogsototh/adventofcode#readme>
|
||||
category: Web
|
||||
homepage: https://github.com/yogsototh/adventofcode#readme
|
||||
bug-reports: https://github.com/yogsototh/adventofcode/issues
|
||||
author: Yann Esposito
|
||||
maintainer: yann.esposito@gmail.com
|
||||
copyright: Copyright: © 2017 Yann Esposito
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
name: adventofcode
|
||||
version: 0.1.0.0
|
||||
synopsis: Solutions for adventofcode
|
||||
homepage: https://github.com/yogsototh/adventofcode#readme
|
||||
bug-reports: https://github.com/yogsototh/adventofcode/issues
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Yann Esposito
|
||||
maintainer: yann.esposito@gmail.com
|
||||
copyright: Copyright: © 2017 Yann Esposito
|
||||
category: Web
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
description: Please see the README on Github at <https://github.com/yogsototh/adventofcode#readme>
|
||||
|
||||
extra-source-files:
|
||||
README.md
|
||||
|
@ -29,14 +29,6 @@ source-repository head
|
|||
library
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
array
|
||||
, base >=4.7 && <5
|
||||
, containers
|
||||
, foldl
|
||||
, parsec
|
||||
, protolude
|
||||
, text
|
||||
exposed-modules:
|
||||
Day01
|
||||
Day02
|
||||
|
@ -55,13 +47,24 @@ library
|
|||
Day15
|
||||
Day16
|
||||
other-modules:
|
||||
Day17
|
||||
Permutations
|
||||
Paths_adventofcode
|
||||
build-depends:
|
||||
array
|
||||
, base >=4.7 && <5
|
||||
, containers
|
||||
, foldl
|
||||
, parsec
|
||||
, protolude
|
||||
, text
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
||||
executable adventofcode-exe
|
||||
main-is: Main.hs
|
||||
hs-source-dirs:
|
||||
app
|
||||
main-is: Main.hs
|
||||
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
adventofcode
|
||||
|
@ -75,10 +78,9 @@ executable adventofcode-exe
|
|||
|
||||
test-suite adventofcode-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: Spec.hs
|
||||
build-depends:
|
||||
HUnit
|
||||
, adventofcode
|
||||
|
@ -88,4 +90,5 @@ test-suite adventofcode-test
|
|||
, tasty-hunit
|
||||
other-modules:
|
||||
Paths_adventofcode
|
||||
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -37,6 +37,7 @@ library:
|
|||
- text
|
||||
- array
|
||||
- parsec
|
||||
- vector
|
||||
executables:
|
||||
adventofcode-exe:
|
||||
main: Main.hs
|
||||
|
|
45
src/Day16.hs
45
src/Day16.hs
|
@ -1,7 +1,7 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-| description:
|
||||
--- Day 16: Permutation Promenade ---
|
||||
|
||||
|
@ -54,12 +54,15 @@ In what order are the programs standing after their billion dances?
|
|||
|
||||
module Day16 where
|
||||
|
||||
import Protolude hiding ((<|>),swap)
|
||||
import Protolude hiding ((<|>),swap,rotate,(<>))
|
||||
|
||||
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
|
||||
|
||||
testInput :: [Command]
|
||||
testInput = readInput "s1,x3/4,pe/b"
|
||||
|
@ -151,24 +154,24 @@ applyCommand fastarr (Exchange rawi rawj) = do
|
|||
j = (rawj - cur) `mod` s
|
||||
li <- readArray (arr fastarr) i
|
||||
lj <- readArray (arr fastarr) j
|
||||
swap i j (arr fastarr)
|
||||
swap li lj (revarr fastarr)
|
||||
faswap i j (arr fastarr)
|
||||
faswap li lj (revarr fastarr)
|
||||
applyCommand fastarr (Partner l k) = do
|
||||
li <- readArray (revarr fastarr) l
|
||||
lj <- readArray (revarr fastarr) k
|
||||
swap l k (revarr fastarr)
|
||||
swap li lj (arr fastarr)
|
||||
faswap l k (revarr fastarr)
|
||||
faswap li lj (arr fastarr)
|
||||
|
||||
swap :: (MArray a e m, Ix i) => i -> i -> a i e -> m ()
|
||||
swap i j arr = do
|
||||
faswap :: (MArray a e m, Ix i) => i -> i -> a i e -> m ()
|
||||
faswap i j arr = do
|
||||
tmpi <- readArray arr i
|
||||
tmpj <- readArray arr j
|
||||
writeArray arr i tmpj
|
||||
writeArray arr j tmpi
|
||||
|
||||
-- | brute force, not the real way to do it
|
||||
solution2 :: Int -> [Command] -> IO [Char]
|
||||
solution2 len commands = do
|
||||
solution2bruteforce :: Int -> [Command] -> IO [Char]
|
||||
solution2bruteforce len commands = do
|
||||
let letters = take len ['a'..'p']
|
||||
array <- FastArr <$> newListArray (0,len-1) letters
|
||||
<*> newListArray ('a',fromMaybe 'a' (last letters)) [0..len-1]
|
||||
|
@ -185,3 +188,25 @@ solution2 len commands = do
|
|||
curs <- readIORef (cursor array)
|
||||
let shift = size array - curs
|
||||
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