From a6f059feb60231c6baf958662c1b3e1279f18de1 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Tue, 19 Dec 2017 00:34:26 +0100 Subject: [PATCH] better day16 --- adventofcode.cabal | 55 ++++++++++++++++++++++++--------------------- package.yaml | 1 + src/Day16.hs | 45 ++++++++++++++++++++++++++++--------- src/Permutations.hs | 41 +++++++++++++++++++++++++++++++++ 4 files changed, 106 insertions(+), 36 deletions(-) create mode 100644 src/Permutations.hs diff --git a/adventofcode.cabal b/adventofcode.cabal index 7f95069..942b166 100644 --- a/adventofcode.cabal +++ b/adventofcode.cabal @@ -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 -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 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 diff --git a/package.yaml b/package.yaml index 23b03d4..55abc48 100644 --- a/package.yaml +++ b/package.yaml @@ -37,6 +37,7 @@ library: - text - array - parsec + - vector executables: adventofcode-exe: main: Main.hs diff --git a/src/Day16.hs b/src/Day16.hs index e82ad99..61a116c 100644 --- a/src/Day16.hs +++ b/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) diff --git a/src/Permutations.hs b/src/Permutations.hs new file mode 100644 index 0000000..1783030 --- /dev/null +++ b/src/Permutations.hs @@ -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