From: Neil Smith Date: Mon, 26 Dec 2016 23:11:06 +0000 (+0000) Subject: Broke days into individual pacakges X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=245aed74ce202a0be5cf2f61f79b48ed51aa0e62;p=advent-of-code-16.git Broke days into individual pacakges --- diff --git a/adventofcode16/adventofcode16.cabal b/adventofcode16/adventofcode16.cabal index 18cc51d..0d7f264 100644 --- a/adventofcode16/adventofcode16.cabal +++ b/adventofcode16/adventofcode16.cabal @@ -19,311 +19,311 @@ library build-depends: base >= 4.7 && < 5 default-language: Haskell2010 -executable advent03 - hs-source-dirs: app - main-is: advent03.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , split - default-language: Haskell2010 - -executable advent04 - hs-source-dirs: app - main-is: advent04.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , split - , containers - default-language: Haskell2010 - -executable advent05 - hs-source-dirs: app - main-is: advent05.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , containers - , MissingH - default-language: Haskell2010 - -executable advent06 - hs-source-dirs: app - main-is: advent06.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent07 - hs-source-dirs: app - main-is: advent07.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - default-language: Haskell2010 - -executable advent08 - hs-source-dirs: app - main-is: advent08.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , array - , parsec - default-language: Haskell2010 - -executable advent09 - hs-source-dirs: app - main-is: advent09.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , split - default-language: Haskell2010 - -executable advent10 - hs-source-dirs: app - main-is: advent10.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , text - , mtl - default-language: Haskell2010 - -executable advent11 - hs-source-dirs: app - main-is: advent11.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent11a - hs-source-dirs: app - main-is: advent11a.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent11h - hs-source-dirs: app - main-is: advent11h.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent11p - hs-source-dirs: app - main-is: advent11p.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , pqueue - default-language: Haskell2010 - -executable advent12 - hs-source-dirs: app - main-is: advent12.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - , mtl - default-language: Haskell2010 - -executable advent13 - hs-source-dirs: app - main-is: advent13.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , MissingH - default-language: Haskell2010 - -executable advent14 - hs-source-dirs: app - main-is: advent14.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , MissingH - default-language: Haskell2010 - -executable advent14c - hs-source-dirs: app - main-is: advent14c.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , bytestring - , cryptonite - default-language: Haskell2010 - -executable advent14parallel - hs-source-dirs: app - main-is: advent14parallel.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parallel - , bytestring - , cryptonite - default-language: Haskell2010 - -executable advent15 - hs-source-dirs: app - main-is: advent15.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent15l - hs-source-dirs: app - main-is: advent15l.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent16 - hs-source-dirs: app - main-is: advent16.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent16i - hs-source-dirs: app - main-is: advent16i.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent17 - hs-source-dirs: app - main-is: advent17.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , bytestring - , cryptonite - default-language: Haskell2010 - -executable advent18 - hs-source-dirs: app - main-is: advent18.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent18f - hs-source-dirs: app - main-is: advent18f.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - default-language: Haskell2010 - -executable advent19 - hs-source-dirs: app - main-is: advent19.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , containers - default-language: Haskell2010 - -executable advent20 - hs-source-dirs: app - main-is: advent20.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent21 - hs-source-dirs: app - main-is: advent21.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - , mtl - default-language: Haskell2010 - -executable advent22 - hs-source-dirs: app - main-is: advent22.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent22search - hs-source-dirs: app - main-is: advent22search.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent22showgrid - hs-source-dirs: app - main-is: advent22showgrid.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - default-language: Haskell2010 - -executable advent22library - hs-source-dirs: app - main-is: advent22library.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - , containers - , astar - , unordered-containers - , hashable - default-language: Haskell2010 - -executable advent23 - hs-source-dirs: app - main-is: advent23.hs - ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , adventofcode16 - , parsec - , parsec-numbers - , mtl - default-language: Haskell2010 +-- executable advent03 +-- hs-source-dirs: app +-- main-is: advent03.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , split +-- default-language: Haskell2010 + +-- executable advent04 +-- hs-source-dirs: app +-- main-is: advent04.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , split +-- , containers +-- default-language: Haskell2010 + +-- executable advent05 +-- hs-source-dirs: app +-- main-is: advent05.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , containers +-- , MissingH +-- default-language: Haskell2010 + +-- executable advent06 +-- hs-source-dirs: app +-- main-is: advent06.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent07 +-- hs-source-dirs: app +-- main-is: advent07.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- default-language: Haskell2010 + +-- executable advent08 +-- hs-source-dirs: app +-- main-is: advent08.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , array +-- , parsec +-- default-language: Haskell2010 + +-- executable advent09 +-- hs-source-dirs: app +-- main-is: advent09.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , split +-- default-language: Haskell2010 + +-- executable advent10 +-- hs-source-dirs: app +-- main-is: advent10.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , text +-- , mtl +-- default-language: Haskell2010 + +-- executable advent11 +-- hs-source-dirs: app +-- main-is: advent11.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent11a +-- hs-source-dirs: app +-- main-is: advent11a.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent11h +-- hs-source-dirs: app +-- main-is: advent11h.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent11p +-- hs-source-dirs: app +-- main-is: advent11p.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , pqueue +-- default-language: Haskell2010 + +-- executable advent12 +-- hs-source-dirs: app +-- main-is: advent12.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- , mtl +-- default-language: Haskell2010 + +-- executable advent13 +-- hs-source-dirs: app +-- main-is: advent13.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , MissingH +-- default-language: Haskell2010 + +-- executable advent14 +-- hs-source-dirs: app +-- main-is: advent14.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , MissingH +-- default-language: Haskell2010 + +-- executable advent14c +-- hs-source-dirs: app +-- main-is: advent14c.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , bytestring +-- , cryptonite +-- default-language: Haskell2010 + +-- executable advent14parallel +-- hs-source-dirs: app +-- main-is: advent14parallel.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parallel +-- , bytestring +-- , cryptonite +-- default-language: Haskell2010 + +-- executable advent15 +-- hs-source-dirs: app +-- main-is: advent15.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent15l +-- hs-source-dirs: app +-- main-is: advent15l.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent16 +-- hs-source-dirs: app +-- main-is: advent16.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent16i +-- hs-source-dirs: app +-- main-is: advent16i.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent17 +-- hs-source-dirs: app +-- main-is: advent17.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , bytestring +-- , cryptonite +-- default-language: Haskell2010 + +-- executable advent18 +-- hs-source-dirs: app +-- main-is: advent18.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent18f +-- hs-source-dirs: app +-- main-is: advent18f.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- default-language: Haskell2010 + +-- executable advent19 +-- hs-source-dirs: app +-- main-is: advent19.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , containers +-- default-language: Haskell2010 + +-- executable advent20 +-- hs-source-dirs: app +-- main-is: advent20.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent21 +-- hs-source-dirs: app +-- main-is: advent21.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- , mtl +-- default-language: Haskell2010 + +-- executable advent22 +-- hs-source-dirs: app +-- main-is: advent22.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent22search +-- hs-source-dirs: app +-- main-is: advent22search.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent22showgrid +-- hs-source-dirs: app +-- main-is: advent22showgrid.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- default-language: Haskell2010 + +-- executable advent22library +-- hs-source-dirs: app +-- main-is: advent22library.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- , containers +-- , astar +-- , unordered-containers +-- , hashable +-- default-language: Haskell2010 + +-- executable advent23 +-- hs-source-dirs: app +-- main-is: advent23.hs +-- ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N +-- build-depends: base +-- , adventofcode16 +-- , parsec +-- , parsec-numbers +-- , mtl +-- default-language: Haskell2010 executable adventofcode16-exe hs-source-dirs: app diff --git a/adventofcode1603/adventofcode1603.cabal b/adventofcode1603/adventofcode1603.cabal new file mode 100644 index 0000000..9dd7cb7 --- /dev/null +++ b/adventofcode1603/adventofcode1603.cabal @@ -0,0 +1,44 @@ +name: adventofcode1603 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent03 + hs-source-dirs: app + main-is: advent03.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1603 + , adventofcode16 + , split + default-language: Haskell2010 + +test-suite adventofcode1603-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1603 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1603/app/advent03.hs b/adventofcode1603/app/advent03.hs new file mode 100644 index 0000000..ef40bcc --- /dev/null +++ b/adventofcode1603/app/advent03.hs @@ -0,0 +1,33 @@ +module Main(main) where + +import Data.List (transpose, sort) +import Data.List.Split (splitOn, chunksOf) + +type Triple = [Integer] + +main :: IO () +main = do + instrText <- readFile "data/advent03.txt" + let triangles = map (parseLine) $ lines instrText + part1 triangles + part2 triangles + + +part1 :: [Triple] -> IO () +part1 triangles = do + print $ length $ filter (validTriangle) triangles + +part2 :: [Triple] -> IO () +part2 triangles = do + print $ length $ filter (validTriangle) $ byColumns triangles + + +parseLine :: String -> Triple +parseLine = map (read) . filter (not . null) . splitOn " " + +validTriangle :: Triple -> Bool +validTriangle triple = sortedTriple!!0 + sortedTriple!!1 > sortedTriple!!2 + where sortedTriple = sort triple + +byColumns :: [[Integer]] -> [Triple] +byColumns = chunksOf 3 . concat . transpose diff --git a/adventofcode1604/adventofcode1604.cabal b/adventofcode1604/adventofcode1604.cabal new file mode 100644 index 0000000..f0473b9 --- /dev/null +++ b/adventofcode1604/adventofcode1604.cabal @@ -0,0 +1,45 @@ +name: adventofcode1604 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent04 + hs-source-dirs: app + main-is: advent04.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1604 + , adventofcode16 + , split + , containers + default-language: Haskell2010 + +test-suite adventofcode1604-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1604 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1604/app/advent04.hs b/adventofcode1604/app/advent04.hs new file mode 100644 index 0000000..85b7555 --- /dev/null +++ b/adventofcode1604/app/advent04.hs @@ -0,0 +1,66 @@ +module Main(main) where + +import Data.List (last, intersperse, sortBy, intercalate, isInfixOf, init) +import Data.List.Split (splitOn) +import Data.Char (isLetter, ord, chr) +import qualified Data.Map.Lazy as Map + +data Room = Room { name :: String + , sector :: Int + , checksum :: String + } deriving (Show) + +main :: IO () +main = do + instrText <- readFile "data/advent04.txt" + let rooms = map (parseLine) $ lines instrText + part1 rooms + part2 rooms + + +part1 :: [Room] -> IO () +part1 rooms = do + print $ sum $ map (sector) validRooms + where + validChecksum room = (checksum room) == makeChecksum (name room) + validRooms = filter (validChecksum) rooms + +part2 :: [Room] -> IO () +part2 rooms = do + print $ fst $ head $ filter (\sn -> isInfixOf "north" (snd sn)) sectorNames + where + validChecksum room = (checksum room) == makeChecksum (name room) + validRooms = filter (validChecksum) rooms + sectorNames = [((sector r), + shiftWord (sector r) (name r)) | r <- validRooms] + + +parseLine :: String -> Room +parseLine line = Room {name=name, sector=sector, checksum=checksum} + where components = splitOn "-" line + name = intercalate "-" $ init components + sector = read $ head $ splitOn "[" $ last components + checksum = filter (isLetter) $ last components + +countedLetters :: String -> [(Char, Int)] +countedLetters name = sortBy sortCLetter $ unsortedCountedLetters name + where unsortedCountedLetters name = + Map.toList $ Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name] + +sortCLetter :: (Char, Int) -> (Char, Int) -> Ordering +sortCLetter (l1, n1) (l2, n2) + | n1 < n2 = GT + | n1 > n2 = LT + | n1 == n2 = compare l1 l2 + +makeChecksum :: String -> String +makeChecksum name = [l | (l, _) <- take 5 $ countedLetters name] + + +shiftWord :: Int -> String -> String +shiftWord shift letters = map (shiftLetter shift) letters + +shiftLetter :: Int -> Char -> Char +shiftLetter shift letter + | isLetter letter = chr $ (ord letter - ord 'a' + shift) `mod` 26 + ord 'a' + | otherwise = ' ' diff --git a/adventofcode1605/adventofcode1605.cabal b/adventofcode1605/adventofcode1605.cabal new file mode 100644 index 0000000..d18d610 --- /dev/null +++ b/adventofcode1605/adventofcode1605.cabal @@ -0,0 +1,46 @@ +name: adventofcode1605 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent05 + hs-source-dirs: app + main-is: advent05.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1601 + , adventofcode16 + , containers + , MissingH + default-language: Haskell2010 + +test-suite adventofcode1605-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1605 + , adventofcode16 + , containers + , MissingH + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1605/app/advent05.hs b/adventofcode1605/app/advent05.hs new file mode 100644 index 0000000..82a035e --- /dev/null +++ b/adventofcode1605/app/advent05.hs @@ -0,0 +1,44 @@ +module Main(main) where + +import Data.Hash.MD5 (md5s, Str(..)) +import Data.List (isPrefixOf) +import qualified Data.Map.Lazy as Map + +type Password = Map.Map Integer Char + +input = "cxdnnyjw" + +main :: IO () +main = do + part1 + part2 + + +part1 :: IO () +part1 = do + putStrLn $ take 8 [h!!5 | h <- filter (interesting) $ md5sequence input 0] + +part2 :: IO () +part2 = do + putStrLn $ Map.foldr (:) [] password + where interestingHashes = + [(read [h!!5], h!!6) | + h <- filter (interesting) (md5sequence input 0), + h!!5 `elem` "01234567"] + password = findPassword Map.empty interestingHashes + + +md5sequence :: String -> Integer -> [String] +md5sequence key i = (md5s (Str (key ++ show i))) : (md5sequence key (i+1)) + +interesting :: String -> Bool +interesting hash = "00000" `isPrefixOf` hash + +dontReplace :: (Integer, Char) -> Password -> Password +dontReplace (k, v) = Map.insertWith (\_ v -> v) k v + +findPassword :: Password -> [(Integer, Char)] -> Password +findPassword p (c:cs) + | Map.size p == 8 = p + | otherwise = findPassword p' cs + where p' = dontReplace c p diff --git a/adventofcode1606/adventofcode1606.cabal b/adventofcode1606/adventofcode1606.cabal new file mode 100644 index 0000000..bbf1359 --- /dev/null +++ b/adventofcode1606/adventofcode1606.cabal @@ -0,0 +1,42 @@ +name: adventofcode1606 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent06 + hs-source-dirs: app + main-is: advent06.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1606 + , adventofcode16 + default-language: Haskell2010 + +test-suite adventofcode1606-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1606 + , adventofcode16 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1606/app/advent06-old.hs b/adventofcode1606/app/advent06-old.hs new file mode 100644 index 0000000..77d4093 --- /dev/null +++ b/adventofcode1606/app/advent06-old.hs @@ -0,0 +1,36 @@ +module Main(main) where + +import Data.List (transpose) +import Data.Char (isLetter) +import qualified Data.Map.Lazy as Map + +main :: IO () +main = do + text <- readFile "advent06.txt" + let message = lines text + part1 message + part2 message + +part1 :: [String] -> IO () +part1 message = do + print $ map (fst) $ map (mostCommon) $ map (countedLetters) $ transpose message + +part2 :: [String] -> IO () +part2 message = do + print $ map (fst) $ map (leastCommon) $ map (countedLetters) $ transpose message + + +countedLetters :: String -> Map.Map Char Int +countedLetters name = Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name] + +mostCommon = Map.foldlWithKey (mostCommonP) ('a', 0) + +mostCommonP (letter0, count0) letter count + | count > count0 = (letter, count) + | otherwise = (letter0, count0) + +leastCommon = Map.foldlWithKey (leastCommonP) ('a', maxBound :: Int) + +leastCommonP (letter0, count0) letter count + | count < count0 = (letter, count) + | otherwise = (letter0, count0) \ No newline at end of file diff --git a/adventofcode1606/app/advent06.hs b/adventofcode1606/app/advent06.hs new file mode 100644 index 0000000..96c4aa2 --- /dev/null +++ b/adventofcode1606/app/advent06.hs @@ -0,0 +1,22 @@ +module Main(main) where + +import Data.List (transpose, maximum, minimum, sort, group) +import Data.Tuple (swap) + +main :: IO () +main = do + text <- readFile "data/advent06.txt" + let message = lines text + part1 message + part2 message + +part1 :: [String] -> IO () +part1 message = do + putStrLn $ map (snd . maximum . counts) $ transpose message + +part2 :: [String] -> IO () +part2 message = do + putStrLn $ map (snd . minimum . counts) $ transpose message + +counts :: (Eq a, Ord a) => [a] -> [(Int, a)] +counts = map (\g -> (length g, head g)) . group . sort \ No newline at end of file diff --git a/adventofcode1607/adventofcode1607.cabal b/adventofcode1607/adventofcode1607.cabal new file mode 100644 index 0000000..5c34d31 --- /dev/null +++ b/adventofcode1607/adventofcode1607.cabal @@ -0,0 +1,44 @@ +name: adventofcode1607 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent07 + hs-source-dirs: app + main-is: advent07.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1607 + , adventofcode16 + , parsec + default-language: Haskell2010 + +test-suite adventofcode1607-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1607 + , adventofcode16 + , parsec + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1607/app/advent07.hs b/adventofcode1607/app/advent07.hs new file mode 100644 index 0000000..8700958 --- /dev/null +++ b/adventofcode1607/app/advent07.hs @@ -0,0 +1,136 @@ +module Main(main) where + +import Text.Parsec +import Data.List (partition, union, intersect, tails) +import Data.Char (isAlphaNum) + +data Chunk = Include String | Exclude String deriving (Show) +data ChunkV = Includev Bool | Excludev Bool deriving (Show) + +chunkValue :: Chunk -> String +chunkValue (Include v) = v +chunkValue (Exclude v) = v + +isInclude :: Chunk -> Bool +isInclude (Include _) = True +isInclude (Exclude _) = False + +chunkValueV :: ChunkV -> Bool +chunkValueV (Includev v) = v +chunkValueV (Excludev v) = v + +isIncludeV :: ChunkV -> Bool +isIncludeV (Includev _) = True +isIncludeV (Excludev _) = False + + +main :: IO () +main = do + text <- readFile "data/advent07.txt" + part1 text + part2 text + + +part1 :: String -> IO () +part1 text = do + print $ length $ filter (allowsAbba) $ successfulParse $ parseI7vf text + + +part2 :: String -> IO () +part2 text = do + print $ length $ filter (supportsSSL) $ successfulParse $ parseI7f text + +allowsAbba :: [ChunkV] -> Bool +allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks)) + where (includeChunks, excludeChunks) = partition (isIncludeV) chunks + +i7file = i7line `endBy` newline +i7line = many1 (includeChunk <|> excludeChunk) + +chunk = many1 alphaNum + +excludeChunk = Exclude <$> (between (char '[') (char ']') $ chunk) +includeChunk = Include <$> chunk + +hasABBA = preambleAbba <* (many alphaNum) +preambleAbba = (try abba) <|> (alphaNum >> preambleAbba) + +-- abba = +-- do a <- alphaNum +-- b <- alphaNum +-- if a == b then +-- fail "Identical" +-- else do char b +-- char a +-- return [a, b, b, a] + +abba = + do a <- alphaNum + b <- noneOf [a] + char b + char a + return [a, b, b, a] + +-- where +--   firstChar = satisfy (\a -> isLetter a || a == '_') +--   nonFirstChar = satisfy (\a -> isDigit a || isLetter a || a == '_') + + -- b <- bChar +-- where bChar = satisfy (\l -> lsLetter l && l /= a) + + + +i7filev = i7linev `endBy` newline +i7linev = many1 (includeChunkv <|> excludeChunkv) + +excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv) +includeChunkv = Includev <$> hasABBAv + +hasABBAv = + (try (id True <$ preambleAbba <* (many alphaNum))) + <|> + (id False <$ (many1 alphaNum)) + + +parseI7f :: String -> Either ParseError [[Chunk]] +parseI7f input = parse i7file "(unknown)" input + +parseI7 :: String -> Either ParseError [Chunk] +parseI7 input = parse i7line "(unknown)" input + +parseAbba :: String -> Either ParseError String +parseAbba input = parse hasABBA "(unknown)" input + +parseI7v :: String -> Either ParseError [ChunkV] +parseI7v input = parse i7linev "(unknown)" input + +parseI7vf :: String -> Either ParseError [[ChunkV]] +parseI7vf input = parse i7filev "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a + + +allSubstrings :: Int -> [a] -> [[a]] +-- allSubstrings n es +-- | length es < n = [] +-- | otherwise = (take n es) : (allSubstrings n $ tail es) +allSubstrings n e = filter (\s -> length s == n) $ map (take n) $ tails e + + +ieCandidates :: [Chunk] -> ([String], [String]) +ieCandidates chunks = (includeCandidates, excludeCandidates) + where (includeChunks, excludeChunks) = partition (isInclude) chunks + isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1) + candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue)) + includeCandidates = candidates includeChunks + excludeCandidates = candidates excludeChunks + +inverseABA :: String -> String +inverseABA s = [s!!1, s!!0, s!!1] + +supportsSSL :: [Chunk] -> Bool +supportsSSL chunks = not $ null $ intersect abas eabas + where (abas, babs) = ieCandidates chunks + eabas = map (inverseABA) babs diff --git a/adventofcode1608/adventofcode1608.cabal b/adventofcode1608/adventofcode1608.cabal new file mode 100644 index 0000000..5fdf44e --- /dev/null +++ b/adventofcode1608/adventofcode1608.cabal @@ -0,0 +1,46 @@ +name: adventofcode1608 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent08 + hs-source-dirs: app + main-is: advent08.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1608 + , adventofcode16 + , array + , parsec + default-language: Haskell2010 + +test-suite adventofcode1608-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1608 + , adventofcode16 + , array + , parsec + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1608/app/advent08.hs b/adventofcode1608/app/advent08.hs new file mode 100644 index 0000000..ccf2de0 --- /dev/null +++ b/adventofcode1608/app/advent08.hs @@ -0,0 +1,148 @@ +module Main(main) where + +import Data.Array.IArray +import Text.Parsec +import Control.Monad (liftM, ap) + +-- Row 1 is top, column 1 is left +type Position = (Int, Int) +type Screen = Array Position Bool + +data Direction = Row | Column deriving (Show) +data Command = Rect Int Int | Rotate Direction Int Int deriving (Show) + +data ScState a = ScState (Screen -> (Screen, a)) + +mkScreen :: Int -> Int -> Screen +mkScreen w h = array ((0, 0), (h - 1, w - 1)) + [((i, j), False) | i <- [0..(h-1)], j <- [0..(w-1)]] + +showScreen :: Screen -> String +showScreen screen = unlines [showRow r | r <- [minRow..maxRow]] + where ((minRow, minCol), (maxRow, maxCol)) = bounds screen + showCell True = '*' + showCell False = ' ' + showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]] + +countLights :: Screen -> Int +countLights screen = length $ filter (id) $ elems screen + +screen0 :: Screen +screen0 = mkScreen 50 6 + + +main :: IO () +main = do + text <- readFile "data/advent08.txt" + let instrs = successfulParse $ parseCommands text + part1 instrs + part2 instrs + +part1 :: [Command] -> IO () +part1 commands = + print $ countLights $ (extractScreen . doCommands) commands + +part2 :: [Command] -> IO () +part2 commands = + putStrLn $ showScreen $ (extractScreen . doCommands) commands + + +instance Functor ScState where + fmap = liftM + +instance Applicative ScState where + pure = return + (<*>) = ap + +instance Monad ScState where + return x = ScState (\screen -> (screen, x)) + + (ScState st) >>= f + = ScState (\screen -> let + (newScreen, y) = st screen + (ScState transformer) = f y + in + transformer newScreen) + +doCommands :: [Command] -> ScState (Int) +doCommands [] = return 0 +doCommands (i:is) = + do doCommand i + doCommands is + return 0 + +doCommand :: Command -> ScState Int +doCommand i = ScState (execute i) + +execute :: Command -> (Screen -> (Screen, Int)) +execute (Rect w h) screen = (rect screen w h, 0) +execute (Rotate Column c n) screen = (rotateColumn screen c n, 0) +execute (Rotate Row r n) screen = (rotateRow screen r n, 0) + +extractScreen :: ScState Int -> Screen +extractScreen (ScState st) = fst (st screen0) + + + +parseCommands :: String -> Either ParseError [Command] +parseCommands input = parse commandFile "(unknown)" input + +commandFile = commandLine `endBy` newline +commandLine = (try rectCommand) <|> rotateCommand + +rectCommand = + do string "rect" + spaces + w <- (many1 digit) + char 'x' + h <- (many1 digit) + return (Rect (read w) (read h)) + +rotateCommand = + do string "rotate" + spaces + direction <- (string "row" <|> string "column") + spaces + string "x=" <|> string "y=" + index <- (many1 digit) + spaces + string "by" + spaces + distance <- (many1 digit) + return (buildCommand direction index distance) + +buildCommand "row" i d = Rotate Row (read i) (read d) +buildCommand "column" i d = Rotate Column (read i) (read d) + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a + + + + +rect :: Screen -> Int -> Int -> Screen +rect screen w h = screen // newBits + where newBits = [((i, j), True) | i <- [0..(h-1)], j <- [0..(w-1)]] + +rotateColumn :: Screen -> Int -> Int -> Screen +rotateColumn screen column givenShift = screen // newCells + where + ((minRow, minCol), (maxRow, maxCol)) = bounds screen + colLength = 1 + maxRow - minRow + shift = givenShift `mod` colLength + offset = colLength - shift + column0 = [screen!(r, column) | r <- [minRow..maxRow]] + newColumn = (drop offset column0) ++ (take offset column0) + newCells = [((r, column), cell) | (r, cell) <- zip [minRow..maxRow] newColumn] + +rotateRow :: Screen -> Int -> Int -> Screen +rotateRow screen row givenShift = screen // newCells + where + ((minRow, minCol), (maxRow, maxCol)) = bounds screen + rowLength = 1 + maxCol - minCol + shift = givenShift `mod` rowLength + offset = rowLength - shift + row0 = [screen!(row, c) | c <- [minCol..maxCol]] + newRow = (drop offset row0) ++ (take offset row0) + newCells = [((row, c), cell) | (c, cell) <- zip [minCol..maxCol] newRow] diff --git a/adventofcode1609/adventofcode1609.cabal b/adventofcode1609/adventofcode1609.cabal new file mode 100644 index 0000000..a668c80 --- /dev/null +++ b/adventofcode1609/adventofcode1609.cabal @@ -0,0 +1,44 @@ +name: adventofcode1609 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent09 + hs-source-dirs: app + main-is: advent09.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1609 + , adventofcode16 + , split + default-language: Haskell2010 + +test-suite adventofcode1609-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1609 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1609/app/advent09.hs b/adventofcode1609/app/advent09.hs new file mode 100644 index 0000000..a3ce495 --- /dev/null +++ b/adventofcode1609/app/advent09.hs @@ -0,0 +1,57 @@ +module Main(main) where + +import Data.List.Split (splitOn) +import Data.Char (isSpace) + +type Chunk = (Int, String) + +main :: IO () +main = do + textL <- readFile "data/advent09.txt" + let text = filter (not . isSpace) textL + part1 text + part2 text + +part1 :: String -> IO () +part1 text = do + print $ cLength $ decompress text + +part2 :: String -> IO () +part2 text = do + print $ cLength $ decompress2 text + + +decompress :: String -> [Chunk] +decompress text = + if not (null msuf) + then (1, pre):(num, chunk):drest + else [(1, pre)] + where + (pre, msuf) = span ('(' /= ) text + (marker, suf) = span (')' /= ) msuf + ln = splitOn "x" (tail marker) + len = read (ln!!0) :: Int + num = read (ln!!1) :: Int + (chunk, remainder) = splitAt len (tail suf) + drest = decompress remainder + +decompress2 :: String -> [Chunk] +decompress2 text = + if not (null msuf) + then [(1, pre)] ++ mulDchunks ++ drest + else [(1, pre)] + where + (pre, msuf) = span ('(' /= ) text + (marker, suf) = span (')' /= ) msuf + ln = splitOn "x" (tail marker) + len = read (ln!!0) :: Int + num = read (ln!!1) :: Int + (chunk, remainder) = splitAt len (tail suf) + dchunks = decompress2 chunk + mulDchunks = [(dl * num, ds) | (dl, ds) <- dchunks] + drest = decompress2 remainder + +cLength :: [Chunk] -> Int +cLength = sum . map (clen) + where clen (n, t) = n * (length t) + diff --git a/adventofcode1610/adventofcode1610.cabal b/adventofcode1610/adventofcode1610.cabal new file mode 100644 index 0000000..4a06a73 --- /dev/null +++ b/adventofcode1610/adventofcode1610.cabal @@ -0,0 +1,48 @@ +name: adventofcode1610 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent10 + hs-source-dirs: app + main-is: advent10.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1610 + , adventofcode16 + , parsec + , text + , mtl + default-language: Haskell2010 + +test-suite adventofcode1610-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1610 + , adventofcode16 + , parsec + , text + , mtl + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1610/app/advent10.hs b/adventofcode1610/app/advent10.hs new file mode 100644 index 0000000..70e80e0 --- /dev/null +++ b/adventofcode1610/app/advent10.hs @@ -0,0 +1,217 @@ +import Text.Parsec hiding (State) +import Data.Text (pack, unpack, toTitle) +import Control.Monad.State.Lazy +import Data.List (partition, findIndices, sort, find) +import Data.Maybe (fromJust) + +data Destination = Bot | Output deriving (Show, Read, Eq) +-- Rule bot low-destination high-destination +-- Gift bot value +data Instruction = Rule { ruleId :: Int + , lowDestType :: Destination + , lowDestId :: Int + , highDestType :: Destination + , highDestId :: Int + } | + Gift { giftId :: Int + , value :: Int + } + deriving (Show) + +-- bod id [item1, item2] +data Place = Place { placeId :: Int + , placeType :: Destination + , items :: [Int]} + deriving (Show) + +-- delivery by bot of low-value and high-value +data Event = Delivery { deliveryId :: Int + , lowDelivery :: Int + , highDelivery :: Int + } | + Update { updateId :: Int + , updateType :: Destination + , updateItem :: Int + } deriving (Show) + +type Factory = ([Place], [Instruction], [Event]) +-- data FactorySt History = FactorySt (Factory -> (Factory, History)) + +emptyFactory :: Factory +emptyFactory = ([], [], []) + +main :: IO () +main = do + text <- readFile "data/advent10.txt" + let instructions = successfulParse $ parseIfile text + part1 instructions + part2 instructions + + +part1 :: [Instruction] -> IO () +part1 instructions = + do let (_, _, events) = snd $ runState (runFactory instructions) emptyFactory + -- let (places, instructions, events) = snd finalFactory + print $ deliveryId $ fromJust $ findDelivery events 17 61 + +part2 :: [Instruction] -> IO () +part2 instructions = + do let (places, _, _) = snd $ runState (runFactory instructions) emptyFactory + let outs = findOutputs places [0, 1, 2] + let product = foldl1 (*) $ concatMap (items) outs + print $ product + + +findDelivery :: [Event] -> Int -> Int -> Maybe Event +findDelivery events lowItem highItem = find (delivery) events + where delivery Update {} = False + delivery Delivery {deliveryId = bot, lowDelivery = l, highDelivery = h} + | l == lowItem && h == highItem = True + | otherwise = False + +findOutputs :: [Place] -> [Int] -> [Place] +findOutputs outputs ids = filter (interesting) outputs + where interesting Place {placeId = p, placeType = t, items = i} + | (p `elem` ids) && t == Output = True + | otherwise = False + + +runFactory :: [Instruction] -> State Factory () +runFactory instructions = do + addInstructions instructions + runInstructions instructions + + + +instructionFile = instructionLine `endBy` newline +instructionLine = ruleL <|> giftL + + +ruleL = + do (string "bot" >> spaces) + bot <- many1 digit + (spaces >> string "gives low to" >> spaces) + lowDestType <- (string "output" <|> string "bot") + spaces + lowDest <- many1 digit + (spaces >> string "and high to" >> spaces) + highDestType <- (string "output" <|> string "bot") + spaces + highDest <- many1 digit + let rule = Rule (read bot) + (read $ unpack $ toTitle $ pack lowDestType) + (read lowDest) + (read $ unpack $ toTitle $ pack highDestType) + (read highDest) + return rule + +giftL = + do (string "value" >> spaces) + value <- many1 digit + (spaces >> string "goes to bot" >> spaces) + bot <- many1 digit + let gift = Gift (read bot) (read value) + return gift + + +parseIfile :: String -> Either ParseError [Instruction] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError Instruction +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a + + + + +addInstructions :: [Instruction] -> State Factory () +addInstructions [] = return () +addInstructions (i:is) = do + addInstruction i + addInstructions is + + +addInstruction :: Instruction -> State Factory () +addInstruction r@(Rule {lowDestType = ld, lowDestId = li, + highDestType = hd, highDestId = hi}) = + do (places, rules, history) <- get + put (places, r:rules, history) + addPlace (Place {placeType = ld, placeId = li, items = []}) + addPlace (Place {placeType = hd, placeId = hi, items = []}) +addInstruction Gift {giftId = g} = + do addPlace (Place {placeType = Bot, placeId = g, items = []}) + + +addPlace :: Place -> State Factory () +addPlace place = + do (places, rules, history) <- get + if not $ placeElem place places + then put ((place:places), rules, history) + else return () + + +runInstructions :: [Instruction] -> State Factory () +runInstructions [] = return () +runInstructions (i:is) = + do runInstruction i + runInstructions is + + +runInstruction :: Instruction -> State Factory () +runInstruction Rule {} = return () +runInstruction g@(Gift {}) = + do updatePlace (giftId g) Bot (value g) + propogateUpdates + +updatePlace :: Int -> Destination -> Int -> State Factory () +updatePlace b d i = + do (places, instructions, events) <- get + let (place0s, otherPlaces) = partition (samePlace (Place {placeId = b, placeType = d, items = []})) places + let place = head place0s + let place' = place {items = i:(items place)} + let update = Update {updateId = b, updateType = d, updateItem = i} + put (place':otherPlaces, instructions, update:events) + + +propogateUpdates :: State Factory () +propogateUpdates = + do (places, instructions, events) <- get + let (fullBots, otherPlaces) = fullRobots places + if (not . null) fullBots + then do let fullBot = head fullBots + let maybeRule = findRule instructions (placeId fullBot) + case maybeRule of + Nothing -> propogateUpdates + Just rule -> do let small:large:_ = sort $ items fullBot + let emptyBot = fullBot {items = []} + let delivery = Delivery { deliveryId = placeId fullBot + , lowDelivery = small + , highDelivery = large + } + put (emptyBot:(tail fullBots) ++ otherPlaces, + instructions, + delivery:events) + updatePlace (lowDestId rule) (lowDestType rule) small + updatePlace (highDestId rule) (highDestType rule) large + propogateUpdates + else return () + + +placeElem :: Place -> [Place] -> Bool +placeElem place places = (not . null) $ findIndices (samePlace place) places + +samePlace :: Place -> Place -> Bool +samePlace p1 p2 = (placeId p1 == placeId p2) && (placeType p1 == placeType p2) + +fullRobots :: [Place] -> ([Place], [Place]) +fullRobots places = partition (\p -> placeType p == Bot && length (items p) >= 2) places + +findRule :: [Instruction] -> Int -> Maybe Instruction +findRule instructions bot = find ruleForBot instructions + where ruleForBot Gift {} = False + ruleForBot Rule {ruleId = b} + | b == bot = True + | otherwise = False diff --git a/adventofcode1611/adventofcode1611.cabal b/adventofcode1611/adventofcode1611.cabal new file mode 100644 index 0000000..6875b3d --- /dev/null +++ b/adventofcode1611/adventofcode1611.cabal @@ -0,0 +1,67 @@ +name: adventofcode1611 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent11 + hs-source-dirs: app + main-is: advent11.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + default-language: Haskell2010 + +executable advent11a + hs-source-dirs: app + main-is: advent11a.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + default-language: Haskell2010 + +executable advent11h + hs-source-dirs: app + main-is: advent11h.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + default-language: Haskell2010 + +executable advent11p + hs-source-dirs: app + main-is: advent11p.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + , pqueue + default-language: Haskell2010 + +test-suite adventofcode1611-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1611 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1611/app/advent11.hs b/adventofcode1611/app/advent11.hs new file mode 100644 index 0000000..0286d77 --- /dev/null +++ b/adventofcode1611/app/advent11.hs @@ -0,0 +1,137 @@ +module Main(main) where + +import Data.List (subsequences, (\\), sort, sortBy) +import Data.Ord (comparing) + +data Item = Generator String | Microchip String deriving (Show, Eq) +type Floor = [Item] +data Building = Building Int [Floor] deriving (Show, Eq) + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +instance Ord Building where + compare b1 b2 = comparing estimateCost b1 b2 + +building1 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building2 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "elerium", Microchip "elerium", + Generator "dilithium", Microchip "dilithium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + + +buildingTest = Building 0 [ + sort([Microchip "hydrogen", Microchip "lithium"]), + [Generator "hydrogen"], + [Generator "lithium"], + []] + +main :: IO () +main = do + part1 + part2 + + +part1 :: IO () +-- part1 = print $ length $ init $ extractJust $ hillClimb [[buildingTest]] [] +part1 = print $ length $ init $ extractJust $ hillClimb [[building1]] [] +-- part1 = print $ length $ init $ extractJust $ aStar [[building1]] [] + +part2 :: IO () +part2 = print $ length $ init $ extractJust $ hillClimb [[building2]] [] + + +extractJust :: Maybe [a] -> [a] +extractJust Nothing = [] +extractJust (Just x) = x + +hillClimb :: [[Building]] -> [Building] -> Maybe [Building] +hillClimb [] _ = Nothing +hillClimb (currentTrail:trails) closed = + if isGoal (head currentTrail) then Just currentTrail + else hillClimb newAgenda ((head currentTrail): closed) + where newAgenda = + sortBy (\t1 t2 -> (head t1) `compare` (head t2)) $ + trails ++ (candidates currentTrail closed) + +aStar :: [[Building]] -> [Building] -> Maybe [Building] +aStar [] _ = Nothing +aStar (currentTrail:trails) closed = + if isGoal (head currentTrail) then Just currentTrail + else aStar newAgenda ((head currentTrail): closed) + where newAgenda = + sortBy (\t1 t2 -> (trailCost t1) `compare` (trailCost t2)) $ + trails ++ (candidates currentTrail closed) + trailCost t = estimateCost (head t) + length t - 1 + + +candidates :: [Building] -> [Building] -> [[Building]] +candidates currentTrail closed = newCandidates + where + (candidate:trail) = currentTrail + succs = legalSuccessors $ successors candidate + nonloops = (succs \\ trail) \\ closed + newCandidates = map (\n -> n:candidate:trail) nonloops + +isGoal :: Building -> Bool +isGoal (Building f floors) = + f+1 == height && (all (null) $ take f floors) + where height = length floors + +isLegal :: Building -> Bool +isLegal (Building f floors) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = floors!!f + pairs = [(i, j) | i <- floor, j <- floor, isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> [Building] +successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items] + where + floor = floors!!f + items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: [Building] -> [Building] +legalSuccessors = filter (isLegal) + +updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building +updateBuilding oldF oldFloors newF items = Building newF newFloors + where newFloors = map (updateFloor) $ zip [0..] oldFloors + updateFloor (f, fl) + | f == oldF = sort $ fl \\ items + | f == newF = sort $ items ++ fl + | otherwise = fl + +estimateCost :: Building -> Int +estimateCost (Building _ floors) = + sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors + diff --git a/adventofcode1611/app/advent11a.hs b/adventofcode1611/app/advent11a.hs new file mode 100644 index 0000000..c5349c8 --- /dev/null +++ b/adventofcode1611/app/advent11a.hs @@ -0,0 +1,164 @@ +-- Using the idea of canonical representation of buildings from +-- https://andars.github.io/aoc_day11.html by Andrew Foote, +-- plus my extension of represening the pairs as an integer. + +-- This version is A* search, using a list for the agenda. + +module Main(main) where + +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices) +import Data.Ord (comparing) +import Data.Char (isDigit) + +data Item = Generator String | Microchip String deriving (Show, Eq) +type Floor = [Item] +data Building = Building Int [Floor] deriving (Show, Eq) +data CBuilding = CBuilding Int Integer deriving (Show, Eq) +data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int} + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +instance Ord Building where + compare b1 b2 = comparing estimateCost b1 b2 + +building1 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building0 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building2 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "elerium", Microchip "elerium", + Generator "dilithium", Microchip "dilithium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + + +buildingTest = Building 0 [ + sort([Microchip "hydrogen", Microchip "lithium"]), + [Generator "hydrogen"], + [Generator "lithium"], + []] + +canonical :: Building -> CBuilding +canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs) + where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors + floorOf (Generator g) = head (findIndices + (\fl -> (Generator g) `elem` fl) + floors) + floorOf (Microchip g) = head (findIndices + (\fl -> (Microchip g) `elem` fl) + floors) + pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names + + + +main :: IO () +main = do + part1 + part2 + + +part1 :: IO () +part1 = print $ length $ trail $ aStar (initAgenda building1) [] + +part2 :: IO () +part2 = print $ length $ trail $aStar (initAgenda building2) [] + +initAgenda :: Building -> [Agendum] +initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}] + + +aStar :: [Agendum] -> [CBuilding] -> Agendum +aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} +aStar (currentAgendum:agenda) closed = + if isGoal reached then currentAgendum + else if creached `elem` closed + then aStar agenda closed + else aStar newAgenda (creached:closed) + where + reached = current currentAgendum + creached = canonical reached + newAgenda = + sortOn (cost) $ + agenda ++ (candidates currentAgendum closed) + + +candidates :: Agendum -> [CBuilding] -> [Agendum] +candidates agendum closed = newCandidates + where + candidate = current agendum + previous = trail agendum + succs = legalSuccessors $ successors candidate + excludable = previous ++ closed + nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs + newCandidates = map (\n -> makeAgendum n) nonloops + makeAgendum new = Agendum {current = new, + trail = (canonical candidate):previous, + cost = estimateCost new + length previous + 1} + +isGoal :: Building -> Bool +isGoal (Building f floors) = + f+1 == height && (all (null) $ take f floors) + where height = length floors + +isLegal :: Building -> Bool +isLegal (Building f floors) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = floors!!f + pairs = [(i, j) | i <- floor, j <- floor, isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> [Building] +successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items] + where + floor = floors!!f + items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: [Building] -> [Building] +legalSuccessors = filter (isLegal) + +updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building +updateBuilding oldF oldFloors newF items = Building newF newFloors + where newFloors = map (updateFloor) $ zip [0..] oldFloors + updateFloor (f, fl) + | f == oldF = sort $ fl \\ items + | f == newF = sort $ items ++ fl + | otherwise = fl + +estimateCost :: Building -> Int +estimateCost (Building _ floors) = + sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors + diff --git a/adventofcode1611/app/advent11h.hs b/adventofcode1611/app/advent11h.hs new file mode 100644 index 0000000..d362ee8 --- /dev/null +++ b/adventofcode1611/app/advent11h.hs @@ -0,0 +1,162 @@ +-- Using the idea of canonical representation of buildings from +-- https://andars.github.io/aoc_day11.html by Andrew Foote, +-- plus my extension of represening the pairs as an integer. + +-- This version is hillclimbing search, using a list for the agenda. +module Main(main) where + +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices) +import Data.Ord (comparing) +import Data.Char (isDigit) + +data Item = Generator String | Microchip String deriving (Show, Eq) +type Floor = [Item] +data Building = Building Int [Floor] deriving (Show, Eq) +data CBuilding = CBuilding Int Integer deriving (Show, Eq) +data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int} + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +instance Ord Building where + compare b1 b2 = comparing estimateCost b1 b2 + +building1 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building0 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building2 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "elerium", Microchip "elerium", + Generator "dilithium", Microchip "dilithium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + + +buildingTest = Building 0 [ + sort([Microchip "hydrogen", Microchip "lithium"]), + [Generator "hydrogen"], + [Generator "lithium"], + []] + +canonical :: Building -> CBuilding +canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs) + where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors + floorOf (Generator g) = head (findIndices + (\fl -> (Generator g) `elem` fl) + floors) + floorOf (Microchip g) = head (findIndices + (\fl -> (Microchip g) `elem` fl) + floors) + pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names + + + +main :: IO () +main = do + part1 + part2 + + +part1 :: IO () +part1 = print $ length $ trail $ hillClimb (initAgenda building1) [] + +part2 :: IO () +part2 = print $ length $ trail $ hillClimb (initAgenda building2) [] + +initAgenda :: Building -> [Agendum] +initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}] + +hillClimb :: [Agendum] -> [CBuilding] -> Agendum +hillClimb [] _ = Agendum {current=buildingTest, trail=[], cost=0} +hillClimb (currentAgendum:agenda) closed = + if isGoal reached then currentAgendum + else if creached `elem` closed + then hillClimb agenda closed + else hillClimb newAgenda (creached:closed) + where + reached = current currentAgendum + creached = canonical reached + newAgenda = + sortOn (cost) $ + agenda ++ (candidates currentAgendum closed) + + +candidates :: Agendum -> [CBuilding] -> [Agendum] +candidates agendum closed = newCandidates + where + candidate = current agendum + previous = trail agendum + succs = legalSuccessors $ successors candidate + excludable = previous ++ closed + nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs + newCandidates = map (\n -> makeAgendum n) nonloops + makeAgendum new = Agendum {current = new, + trail = (canonical candidate):previous, + cost = estimateCost new} + +isGoal :: Building -> Bool +isGoal (Building f floors) = + f+1 == height && (all (null) $ take f floors) + where height = length floors + +isLegal :: Building -> Bool +isLegal (Building f floors) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = floors!!f + pairs = [(i, j) | i <- floor, j <- floor, isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> [Building] +successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items] + where + floor = floors!!f + items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: [Building] -> [Building] +legalSuccessors = filter (isLegal) + +updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building +updateBuilding oldF oldFloors newF items = Building newF newFloors + where newFloors = map (updateFloor) $ zip [0..] oldFloors + updateFloor (f, fl) + | f == oldF = sort $ fl \\ items + | f == newF = sort $ items ++ fl + | otherwise = fl + +estimateCost :: Building -> Int +estimateCost (Building _ floors) = + sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors + diff --git a/adventofcode1611/app/advent11p.hs b/adventofcode1611/app/advent11p.hs new file mode 100644 index 0000000..4136e8f --- /dev/null +++ b/adventofcode1611/app/advent11p.hs @@ -0,0 +1,166 @@ +-- Using the idea of canonical representation of buildings from +-- https://andars.github.io/aoc_day11.html by Andrew Foote, +-- plus my extension of represening the pairs as an integer. + +-- This version is A* search, using a priority queue for the agenda. + +module Main(main) where + +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices) +import Data.Ord (comparing) +import Data.Char (isDigit) +import Data.Maybe (fromMaybe) +import qualified Data.PQueue.Prio.Min as P + +data Item = Generator String | Microchip String deriving (Show, Eq) +type Floor = [Item] +data Building = Building Int [Floor] deriving (Show, Eq) +data CBuilding = CBuilding Int Integer deriving (Show, Eq) +data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int} +type Agenda = P.MinPQueue Int Agendum + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +instance Ord Building where + compare b1 b2 = comparing estimateCost b1 b2 + +building1 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building0 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + +building2 = Building 0 [ + (sort [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "elerium", Microchip "elerium", + Generator "dilithium", Microchip "dilithium"]), + (sort [Microchip "polonium", Microchip "promethium"]), + [], + [] + ] + + +buildingTest = Building 0 [ + sort([Microchip "hydrogen", Microchip "lithium"]), + [Generator "hydrogen"], + [Generator "lithium"], + []] + +canonical :: Building -> CBuilding +canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs) + where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors + floorOf (Generator g) = head (findIndices + (\fl -> (Generator g) `elem` fl) + floors) + floorOf (Microchip g) = head (findIndices + (\fl -> (Microchip g) `elem` fl) + floors) + pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names + + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) [] + +part2 :: IO () +part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) [] + +initAgenda :: Building -> Agenda +initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail=[], cost = estimateCost b} + + +aStar :: Agenda -> [CBuilding] -> Maybe Agendum +-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} +aStar agenda closed + | P.null agenda = Nothing + | otherwise = + if isGoal reached then Just currentAgendum + else if creached `elem` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (creached:closed) + where + (_, currentAgendum) = P.findMin agenda + reached = current currentAgendum + creached = canonical reached + newAgenda = P.union (P.deleteMin agenda) + (P.fromList $ candidates currentAgendum closed) + + +candidates :: Agendum -> [CBuilding] -> [(Int, Agendum)] +candidates agendum closed = newCandidates + where + candidate = current agendum + previous = trail agendum + succs = legalSuccessors $ successors candidate + nonloops = filter (\s -> not $ (canonical s) `elem` closed) succs + newCandidates = map (\a -> (cost a, a)) $ map (\n -> makeAgendum n) nonloops + makeAgendum new = Agendum {current = new, + trail = (canonical candidate):previous, + cost = estimateCost new + length previous + 1} + +isGoal :: Building -> Bool +isGoal (Building f floors) = + f+1 == height && (all (null) $ take f floors) + where height = length floors + +isLegal :: Building -> Bool +isLegal (Building f floors) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = floors!!f + pairs = [(i, j) | i <- floor, j <- floor, isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> [Building] +successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items] + where + floor = floors!!f + items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: [Building] -> [Building] +legalSuccessors = filter (isLegal) + +updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building +updateBuilding oldF oldFloors newF items = Building newF newFloors + where newFloors = map (updateFloor) $ zip [0..] oldFloors + updateFloor (f, fl) + | f == oldF = sort $ fl \\ items + | f == newF = sort $ items ++ fl + | otherwise = fl + +estimateCost :: Building -> Int +estimateCost (Building _ floors) = + sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors + diff --git a/adventofcode1612/adventofcode1612.cabal b/adventofcode1612/adventofcode1612.cabal new file mode 100644 index 0000000..48484ed --- /dev/null +++ b/adventofcode1612/adventofcode1612.cabal @@ -0,0 +1,48 @@ +name: adventofcode1612 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent12 + hs-source-dirs: app + main-is: advent12.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1612 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + default-language: Haskell2010 + +test-suite adventofcode1612-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1612 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1612/app/advent12.hs b/adventofcode1612/app/advent12.hs new file mode 100644 index 0000000..906c185 --- /dev/null +++ b/adventofcode1612/app/advent12.hs @@ -0,0 +1,134 @@ +module Main(main) where + +import Text.Parsec hiding (State) +import Text.ParserCombinators.Parsec.Number +import Data.List (partition, union, intersect, tails) +import Data.Char (isDigit) +import Control.Monad.State.Lazy + +data Location = Literal Int | Register Char deriving (Show) +data Instruction = Cpy Location Location | + Inc Location | + Dec Location | + Jnz Location Int + deriving (Show) + +data Machine = Machine { a :: Int + , b :: Int + , c :: Int + , d :: Int + , pc :: Int + , instructions :: [Instruction]} + deriving (Show) + +emptyMachine :: Machine +emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]} + +main :: IO () +main = do + text <- readFile "data/advent12.txt" + let instructions = successfulParse $ parseIfile text + part1 instructions + part2 instructions + + +part1 :: [Instruction] -> IO () +part1 instrs = + do let m0 = emptyMachine {instructions=instrs} + let mf = snd $ runState runMachine m0 + print (a mf) + +part2 :: [Instruction] -> IO () +part2 instrs = + do let m0 = emptyMachine {instructions=instrs, c=1} + let mf = snd $ runState runMachine m0 + print (a mf) + + + +runMachine :: State Machine () +runMachine = + do m <- get + if (pc m) >= (length $ instructions m) + then return () + else do executeStep + runMachine + +executeStep :: State Machine () +executeStep = + do m <- get + let i = (instructions m)!!(pc m) + put (executeInstruction i m) + +executeInstruction :: Instruction -> Machine -> Machine +executeInstruction (Inc (Register r)) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m (Register r) + m' = writeValue m (Register r) (v+1) +executeInstruction (Dec (Register r)) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m (Register r) + m' = writeValue m (Register r) (v-1) +executeInstruction (Cpy s d) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m s + m' = writeValue m d v +executeInstruction (Jnz s d) m + | v == 0 = m {pc=pc1} + | otherwise = m {pc=pcj} + where pc1 = (pc m) + 1 + pcj = (pc m) + d + v = evaluate m s + + +evaluate :: Machine -> Location -> Int +evaluate _ (Literal i) = i +evaluate m (Register r) = + case r of + 'a' -> (a m) + 'b' -> (b m) + 'c' -> (c m) + 'd' -> (d m) + +writeValue :: Machine -> Location -> Int -> Machine +writeValue m (Literal i) _ = m +writeValue m (Register r) v = + case r of + 'a' -> m {a=v} + 'b' -> m {b=v} + 'c' -> m {c=v} + 'd' -> m {d=v} + + +instructionFile = instructionLine `endBy` newline +-- instructionLine = choice [cpyL, incL, decL, jnzL] +instructionLine = incL <|> decL <|> cpyL <|> jnzL + +incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd")) + where incify r = Inc (Register r) +decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd")) + where decify r = Dec (Register r) +cpyL = cpyify <$> (string "cpy" *> spaces *> ((many1 letter) <|> (many1 digit))) + <*> (spaces *> (oneOf "abcd")) + where cpyify s r = Cpy (readLocation s) (Register r) +jnzL = jnzify <$> (string "jnz" *> spaces *> ((many1 letter) <|> (many1 digit))) + <*> (spaces *> int) + where jnzify r d = Jnz (readLocation r) d + + +readLocation :: String -> Location +readLocation l + | all (isDigit) l = Literal (read l) + | otherwise = Register (head l) + + + +parseIfile :: String -> Either ParseError [Instruction] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError Instruction +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a \ No newline at end of file diff --git a/adventofcode1613/adventofcode1613.cabal b/adventofcode1613/adventofcode1613.cabal new file mode 100644 index 0000000..6c202ac --- /dev/null +++ b/adventofcode1613/adventofcode1613.cabal @@ -0,0 +1,44 @@ +name: adventofcode1613 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent13 + hs-source-dirs: app + main-is: advent13.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1613 + , adventofcode16 + , MissingH + default-language: Haskell2010 + +test-suite adventofcode1613-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1613 + , adventofcode16 + , MissingH + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1613/app/advent13.hs b/adventofcode1613/app/advent13.hs new file mode 100644 index 0000000..86981df --- /dev/null +++ b/adventofcode1613/app/advent13.hs @@ -0,0 +1,95 @@ +module Main(main) where + +import Data.List ((\\), nub, sortOn) +import Data.Bits (popCount) +import Data.Maybe (fromMaybe) + +type Pos = (Int, Int) + +seed = 1362 + +goal1 = (31, 39) + +main :: IO () +main = do + part1 + part2 + + +part1 :: IO () +part1 = print $ length $ tail $ fromMaybe [] $ aStar [[(1, 1)]] [] + +part2 :: IO () +part2 = do print $ length $ tail $ edl 50 [[(1, 1)]] [] + putStrLn $ showRoomR 30 25 $ edl 50 [[(1, 1)]] [] + + +-- extractJust :: Maybe [a] -> [a] +-- extractJust Nothing = [] +-- extractJust (Just x) = x + +isWall :: Int -> Int -> Bool +isWall x y = odd $ popCount n + where + n = x*x + 3*x + 2*x*y + y + y*y + seed + + +showRoom w h = showRoomR w h [] + +showRoomR w h reached = unlines rows + where + rows = [row x | x <- [0..h]] + row x = [showCell x y | y <- [0..w]] + showCell x y = if (isWall x y) + then '#' + else if (x, y) `elem` reached + then 'O' + else '.' + + +aStar :: [[Pos]] -> [Pos] -> Maybe [Pos] +aStar [] _ = Nothing +aStar (currentTrail:trails) closed = + if isGoal (head currentTrail) then Just currentTrail + else if (head currentTrail) `elem` closed then aStar trails closed + else aStar newAgenda ((head currentTrail): closed) + where newAgenda = + sortOn (\a -> trailCost a) $ + trails ++ (candidates currentTrail closed) + trailCost t = estimateCost (head t) + length t - 1 + + +-- exhaustive depth-limited +edl :: Int -> [[Pos]] -> [Pos] -> [Pos] +edl _ [] closed = nub closed +edl limit (currentTrail:trails) closed = + if (length currentTrail) > (limit+1) then edl limit trails ((head currentTrail):closed) + else if (head currentTrail) `elem` closed then edl limit trails closed + else edl limit newAgenda ((head currentTrail):closed) + where newAgenda = trails ++ (candidates currentTrail closed) + +candidates :: [Pos] -> [Pos] -> [[Pos]] +candidates currentTrail closed = newCandidates + where + (candidate:trail) = currentTrail + succs = legalSuccessors $ successors candidate + nonloops = (succs \\ trail) \\ closed + newCandidates = map (\n -> n:candidate:trail) nonloops + +isGoal :: Pos -> Bool +isGoal p = p == goal1 + +isLegal :: Pos -> Bool +isLegal (x, y) = + x >= 0 && y >= 0 && (not $ isWall x y) + +successors :: Pos -> [Pos] +successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)] + +legalSuccessors :: [Pos] -> [Pos] +legalSuccessors = filter (isLegal) + +estimateCost :: Pos -> Int +estimateCost (x, y) = abs (x - gx) + abs (y - gy) + where (gx, gy) = goal1 + diff --git a/adventofcode1614/adventofcode1614.cabal b/adventofcode1614/adventofcode1614.cabal new file mode 100644 index 0000000..17ce6c4 --- /dev/null +++ b/adventofcode1614/adventofcode1614.cabal @@ -0,0 +1,67 @@ +name: adventofcode1614 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent14 + hs-source-dirs: app + main-is: advent14.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1614 + , adventofcode16 + , MissingH + default-language: Haskell2010 + +executable advent14c + hs-source-dirs: app + main-is: advent14c.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1614 + , adventofcode16 + , bytestring + , cryptonite + default-language: Haskell2010 + +executable advent14parallel + hs-source-dirs: app + main-is: advent14parallel.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1614 + , adventofcode16 + , parallel + , bytestring + , cryptonite + default-language: Haskell2010 + +test-suite adventofcode1614-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1614 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1614/app/advent14.hs b/adventofcode1614/app/advent14.hs new file mode 100644 index 0000000..c6c092e --- /dev/null +++ b/adventofcode1614/app/advent14.hs @@ -0,0 +1,43 @@ +module Main(main) where + +import Data.List (nub, tails, null) +import Data.Hash.MD5 (md5s, Str(..)) + +salt = "yjdafjpo" +-- salt = "abc" + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequence + +part2 :: IO () +part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequenceS + +md5sequence :: [String] +md5sequence = [makeMd5 i | i <- [0..]] + where makeMd5 i = md5s (Str (salt ++ show i)) + +md5sequenceS :: [String] +md5sequenceS = [makeMd5 i | i <- [0..]] + where makeMd5 i = stretch $ md5s (Str (salt ++ show i)) + stretch h0 = foldr (\_ h -> md5s (Str h)) h0 [1..2016] + +possibleKey :: [String] -> Int-> Bool +possibleKey s = not . null . repeats 3 . ((!!) s) + +confirmKey :: [String] -> Int -> Bool +confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s + where c = head $ repeats 3 $ s!!i + confirmation m = c `elem` (repeats 5 m) + +repeats :: Int -> String -> [String] +repeats n = filter (null . tail) . map (nub) . substrings n + +substrings :: Int -> [a] -> [[a]] +substrings l = filter (\s -> (length s) == l) . map (take l) . tails diff --git a/adventofcode1614/app/advent14c.hs b/adventofcode1614/app/advent14c.hs new file mode 100644 index 0000000..ea699ed --- /dev/null +++ b/adventofcode1614/app/advent14c.hs @@ -0,0 +1,47 @@ +module Main(main) where + +import Data.List (nub, tails) +import Data.ByteString.Char8 (pack) +import Crypto.Hash (hash, Digest, MD5) + +salt = "yjdafjpo" +-- salt = "abc" + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequence + +part2 :: IO () +part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequenceS + +getHash :: String -> String +getHash bs = show (hash $ pack bs :: Digest MD5) + +md5sequence :: [String] +md5sequence = [makeMd5 i | i <- [0..]] + where makeMd5 i = getHash (salt ++ show i) + +md5sequenceS :: [String] +md5sequenceS = [makeMd5 i | i <- [0..]] + where makeMd5 i = stretch $ getHash (salt ++ show i) + stretch h0 = foldr (\_ h -> getHash h) h0 [1..2016] + +possibleKey :: [String] -> Int-> Bool +possibleKey s = not . null . repeats 3 . ((!!) s) + +confirmKey :: [String] -> Int -> Bool +confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s + where c = head $ repeats 3 $ s!!i + confirmation m = c `elem` (repeats 5 m) + +repeats :: Int -> String -> [String] +repeats n = filter (null . tail) . map (nub) . substrings n + +substrings :: Int -> [a] -> [[a]] +substrings l = filter (\s -> (length s) == l) . map (take l) . tails diff --git a/adventofcode1614/app/advent14parallel.hs b/adventofcode1614/app/advent14parallel.hs new file mode 100644 index 0000000..b0ca781 --- /dev/null +++ b/adventofcode1614/app/advent14parallel.hs @@ -0,0 +1,53 @@ +module Main(main) where + +import Data.List (nub, tails) +import Data.ByteString.Char8 (pack) +import Crypto.Hash (hash, Digest, MD5) +import Control.Parallel.Strategies (withStrategy, parBuffer, rdeepseq) + +salt = "yjdafjpo" +-- salt = "abc" + +stretch_factor = [1..2016] +-- stretch_factor = [1..100] + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequence + +part2 :: IO () +part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..] + where sq = md5sequenceS + +getHash :: String -> String +getHash bs = show (hash $ pack bs :: Digest MD5) + +md5sequence :: [String] +-- md5sequence = [makeMd5 i | i <- [0..]] +md5sequence = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..] + where makeMd5 i = getHash (salt ++ show i) + +md5sequenceS :: [String] +-- md5sequenceS = [makeMd5 i | i <- [0..]] +md5sequenceS = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..] + where makeMd5 i = stretch $ getHash (salt ++ show i) + stretch h0 = foldr (\_ h -> getHash h) h0 stretch_factor + +possibleKey :: [String] -> Int-> Bool +possibleKey s = not . null . repeats 3 . ((!!) s) + +confirmKey :: [String] -> Int -> Bool +confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s + where c = head $ repeats 3 $ s!!i + confirmation m = c `elem` (repeats 5 m) + +repeats :: Int -> String -> [String] +repeats n = filter (null . tail) . map (nub) . substrings n + +substrings :: Int -> [a] -> [[a]] +substrings l = filter (\s -> (length s) == l) . map (take l) . tails diff --git a/adventofcode1615/adventofcode1615.cabal b/adventofcode1615/adventofcode1615.cabal new file mode 100644 index 0000000..ef2cda4 --- /dev/null +++ b/adventofcode1615/adventofcode1615.cabal @@ -0,0 +1,56 @@ +name: adventofcode1615 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent15 + hs-source-dirs: app + main-is: advent15.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1615 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +executable advent15l + hs-source-dirs: app + main-is: advent15l.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1615 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +test-suite adventofcode1615-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1615 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1615/app/advent15.hs b/adventofcode1615/app/advent15.hs new file mode 100644 index 0000000..5970bd6 --- /dev/null +++ b/adventofcode1615/app/advent15.hs @@ -0,0 +1,43 @@ +module Main(main) where + +import Text.Parsec +import Text.ParserCombinators.Parsec.Number + +type Disk = (Int -> Bool) + +main :: IO () +main = do + text <- readFile "data/advent15.txt" + let disks = successfulParse $ parseIfile text + part1 disks + part2 disks + +part1 :: [Disk] -> IO () +part1 disks = print $ head $ filter (canFall disks) [0..] + +part2 :: [Disk] -> IO () +part2 disks = print $ head $ filter (canFall disks2) [0..] + where disks2 = disks ++ [diskify 7 11 0] + +canFall :: [Disk] -> Int -> Bool +canFall ds i = all (\d -> (d i)) ds + + +instructionFile = instructionLine `endBy` newline +instructionLine = diskify <$> (string "Disc #" *> int) + <*> (string " has " *> int) + <*> (string " positions; at time=0, it is at position " *> int) + <* (string ".") + +diskify :: Int -> Int -> Int -> (Int -> Bool) +diskify n size pos0 = (\i -> (size + n + pos0 + i) `mod` size == 0) + +parseIfile :: String -> Either ParseError [Disk] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError Disk +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a diff --git a/adventofcode1615/app/advent15l.hs b/adventofcode1615/app/advent15l.hs new file mode 100644 index 0000000..67e2ac0 --- /dev/null +++ b/adventofcode1615/app/advent15l.hs @@ -0,0 +1,39 @@ +module Main(main) where + +import Text.Parsec +import Text.ParserCombinators.Parsec.Number + +main :: IO () +main = do + text <- readFile "data/advent15.txt" + let disks = successfulParse $ parseIfile text + part1 disks + part2 disks + +part1 :: [[Int]] -> IO () +part1 disks = print $ head $ filter (canFall disks) [0..] + +part2 :: [[Int]] -> IO () +part2 disks = print $ head $ filter (canFall disks2) [0..] + where disks2 = disks ++ [drop 7 $ drop 0 $ cycle [0..(11-1)]] + +canFall :: [[Int]] -> Int -> Bool +canFall ds i = all (\d -> (d!!i) == 0) ds + + +instructionFile = instructionLine `endBy` newline +instructionLine = diskify <$> (string "Disc #" *> int) + <*> (string " has " *> int) + <*> (string " positions; at time=0, it is at position " *> int) + <* (string ".") + where diskify n size pos0 = drop n $ drop pos0 $ cycle [0..(size-1)] + +parseIfile :: String -> Either ParseError [[Int]] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError [Int] +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a diff --git a/adventofcode1616/adventofcode1616.cabal b/adventofcode1616/adventofcode1616.cabal new file mode 100644 index 0000000..3b0827d --- /dev/null +++ b/adventofcode1616/adventofcode1616.cabal @@ -0,0 +1,54 @@ +name: adventofcode1616 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent16 + hs-source-dirs: app + main-is: advent16.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1616 + , adventofcode16 + , split + default-language: Haskell2010 + +executable advent16i + hs-source-dirs: app + main-is: advent16i.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1616 + , adventofcode16 + , split + default-language: Haskell2010 + +test-suite adventofcode1616-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1616 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1616/app/advent16.hs b/adventofcode1616/app/advent16.hs new file mode 100644 index 0000000..88b8b59 --- /dev/null +++ b/adventofcode1616/app/advent16.hs @@ -0,0 +1,42 @@ +module Main(main) where + +import Data.List (nub) + +input = "11100010111110100" +disk1length = 272 +disk2length = 35651584 + +-- input = "10000" +-- disk1length = 20 + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = putStrLn $ checksum $ take disk1length $ expand disk1length input + +part2 :: IO () +part2 = putStrLn $ checksum $ take disk2length $ expand disk2length input + + +expand :: Int -> String -> String +expand len a + | length a >= len = a + | otherwise = expand len $ a ++ "0" ++ b + where b = map (invert) $ reverse a + invert '0' = '1' + invert '1' = '0' + +checksum :: String -> String +checksum digits + | odd $ length digits = digits + | otherwise = checksum $ map (checksumPair) $ pairs digits + where checksumPair p = if (length $ nub p) == 1 then '1' else '0' + + +pairs :: [a] -> [[a]] +pairs [] = [] +pairs xs = [p] ++ (pairs ys) + where (p, ys) = splitAt 2 xs diff --git a/adventofcode1616/app/advent16i.hs b/adventofcode1616/app/advent16i.hs new file mode 100644 index 0000000..897559d --- /dev/null +++ b/adventofcode1616/app/advent16i.hs @@ -0,0 +1,45 @@ +module Main(main) where + +input = "11100010111110100" +disk1length = 272 +disk2length = 35651584 + +-- input = "10000" +-- disk1length = 20 + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ fill disk1length input + +part2 :: IO () +part2 = print $ fill disk2length input + +fill :: Int -> String -> String +fill len filler = deBool $ checksum $ take len $ expand len $ enBool filler + +enBool :: String -> [Bool] +enBool = map (== '1') + +deBool :: [Bool] -> String +deBool = map (\b -> if b then '1' else '0') + + +expand :: Int -> [Bool] -> [Bool] +expand len = head . dropWhile ((<= len) . length) . iterate expandStep + +expandStep :: [Bool] -> [Bool] +expandStep a = a ++ [False] ++ b + where b = map (not) $ reverse a + +checksum :: [Bool] -> [Bool] +checksum = head . dropWhile (even . length) . iterate checksumStep + +checksumStep :: [Bool] -> [Bool] +checksumStep [] = [] +checksumStep [x] = [x] +checksumStep (x:y:xs) = (x==y):(checksumStep xs) + diff --git a/adventofcode1617/adventofcode1617.cabal b/adventofcode1617/adventofcode1617.cabal new file mode 100644 index 0000000..246f1e0 --- /dev/null +++ b/adventofcode1617/adventofcode1617.cabal @@ -0,0 +1,46 @@ +name: adventofcode1617 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent17 + hs-source-dirs: app + main-is: advent17.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1617 + , adventofcode16 + , bytestring + , cryptonite + default-language: Haskell2010 + +test-suite adventofcode1617-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1617 + , adventofcode16 + , bytestring + , cryptonite + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1617/app/advent17.hs b/adventofcode1617/app/advent17.hs new file mode 100644 index 0000000..e757def --- /dev/null +++ b/adventofcode1617/app/advent17.hs @@ -0,0 +1,77 @@ +module Main(main) where + +import Data.ByteString.Char8 (pack) +import qualified Crypto.Hash as C + +type Position = (Int, Int) +data Agendum = Agendum {position :: Position, path :: String, hash :: String} deriving (Show, Eq) +type Agenda = [Agendum] + +-- input = "hijkl" +-- input = "ihgpwlah" + +input = "qljzarfv" -- my input + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = putStrLn $ path $ extractJust $ bfs initialAgenda + +part2 :: IO () +part2 = print $ bfs2 initialAgenda 0 + +initialAgenda :: Agenda +initialAgenda = [Agendum {position=(1, 1), path="", hash=(getHash "")}] + +getHash :: String -> String +getHash path = show (C.hash $ pack (input ++ path) :: C.Digest C.MD5) + +extractJust :: Maybe Agendum -> Agendum +extractJust Nothing = head initialAgenda +extractJust (Just x) = x + +bfs :: Agenda -> Maybe Agendum +bfs [] = Nothing +bfs (current:agenda) = + if isGoal current then Just current + else bfs (agenda ++ (successors current)) + +bfs2 :: Agenda -> Int -> Int +bfs2 [] l = l +bfs2 (current:agenda) l = + if isGoal current then bfs2 agenda (length $ path $ current) + else bfs2 (agenda ++ (successors current)) l + +isGoal :: Agendum -> Bool +isGoal agendum = (position agendum) == (4, 4) + +isLegalPos :: Position -> Bool +isLegalPos p = fst p >= 1 && fst p <= 4 && snd p >= 1 && snd p <= 4 + +successors :: Agendum -> Agenda +successors state = [Agendum {position = step p0 ld, + path = path0 ++ [ld], + hash = getHash (path0 ++ [ld])} | ld <- legalDoors ] + where + p0 = position state + path0 = path state + h0 = hash state + doors = openDoors h0 + legalDoors = filter (isLegalPos . (step p0)) doors + +openDoors :: String -> String +openDoors h = up ++ down ++ left ++ right + where + up = if h!!0 `elem` "bcdef" then "U" else "" + down = if h!!1 `elem` "bcdef" then "D" else "" + left = if h!!2 `elem` "bcdef" then "L" else "" + right = if h!!3 `elem` "bcdef" then "R" else "" + +step :: Position -> Char -> Position +step (r, c) 'U' = (r-1, c) +step (r, c) 'D' = (r+1, c) +step (r, c) 'L' = (r, c-1) +step (r, c) 'R' = (r, c+1) diff --git a/adventofcode1618/adventofcode1618.cabal b/adventofcode1618/adventofcode1618.cabal new file mode 100644 index 0000000..fbb54d1 --- /dev/null +++ b/adventofcode1618/adventofcode1618.cabal @@ -0,0 +1,42 @@ +name: adventofcode1618 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent18 + hs-source-dirs: app + main-is: advent18.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1618 + , adventofcode16 + default-language: Haskell2010 + +test-suite adventofcode1618-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1618 + , adventofcode16 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1618/app/advent18.hs b/adventofcode1618/app/advent18.hs new file mode 100644 index 0000000..2b1462f --- /dev/null +++ b/adventofcode1618/app/advent18.hs @@ -0,0 +1,42 @@ +module Main(main) where + +import Data.List (tails) + +-- input = "..^^." +-- input = ".^^.^.^^^^" +input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^." + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +-- part1 = putStrLn $ unlines $ map (showRow) $ take 10 $ iterate nextRow $ readRow input +part1 = print $ length $ filter (not) $ concat $ take 40 $ iterate nextRow $ readRow input + +part2 :: IO () +part2 = print $ length $ filter (not) $ concat $ take 400000 $ iterate nextRow $ readRow input + +readRow :: String -> [Bool] +readRow = map (=='^') + +showRow :: [Bool] -> String +showRow = map (\c -> if c then '^' else '.') + +extended :: [Bool] -> [Bool] +extended row = [False] ++ row ++ [False] + +nextRow :: [Bool] -> [Bool] +nextRow = map (isTrap) . segments . extended + +segments :: [a] -> [[a]] +segments = filter ((==3) . length) . map (take 3) . tails + +isTrap :: [Bool] -> Bool +isTrap segment + | segment == [True, True, False] = True + | segment == [False, True, True] = True + | segment == [True, False, False] = True + | segment == [False, False, True] = True + | otherwise = False diff --git a/adventofcode1618/app/advent18f.hs b/adventofcode1618/app/advent18f.hs new file mode 100644 index 0000000..d1650e6 --- /dev/null +++ b/adventofcode1618/app/advent18f.hs @@ -0,0 +1,50 @@ +module Main(main) where + +import Data.List (tails, foldl') + +-- input = "..^^." +-- input = ".^^.^.^^^^" +input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^." + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..40] + where row = readRow input + +part2 :: IO () +part2 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..400000] + where row = readRow input + +readRow :: String -> [Bool] +readRow = map (=='^') + +showRow :: [Bool] -> String +showRow = map (\c -> if c then '^' else '.') + +extended :: [Bool] -> [Bool] +extended row = [False] ++ row ++ [False] + +nextRow :: [Bool] -> [Bool] +nextRow = map (isTrap) . segments . extended + +nextRowFold :: (Int, [Bool]) -> Int -> (Int, [Bool]) +nextRowFold (n, row) _ = (n + countSafe newRow, newRow) + where newRow = nextRow row + +countSafe :: [Bool] -> Int +countSafe = length . filter (not) + +segments :: [a] -> [[a]] +segments = filter ((==3) . length) . map (take 3) . tails + +isTrap :: [Bool] -> Bool +isTrap segment + | segment == [True, True, False] = True + | segment == [False, True, True] = True + | segment == [True, False, False] = True + | segment == [False, False, True] = True + | otherwise = False diff --git a/adventofcode1619/adventofcode1619.cabal b/adventofcode1619/adventofcode1619.cabal new file mode 100644 index 0000000..69390fb --- /dev/null +++ b/adventofcode1619/adventofcode1619.cabal @@ -0,0 +1,44 @@ +name: adventofcode1619 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent19 + hs-source-dirs: app + main-is: advent19.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1619 + , adventofcode16 + , containers + default-language: Haskell2010 + +test-suite adventofcode1619-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1619 + , adventofcode16 + , containers + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1619/app/advent19.hs b/adventofcode1619/app/advent19.hs new file mode 100644 index 0000000..009a07c --- /dev/null +++ b/adventofcode1619/app/advent19.hs @@ -0,0 +1,37 @@ +module Main(main) where + +import Prelude hiding (length, take, drop) +import Data.Sequence + +-- input = 5 +input = 3012210 + +main :: IO () +main = do + part1 + part2 + +part1 :: IO () +part1 = print $ 2 * (input - 2 ^ (toInteger (floor $ logBase 2 (fromIntegral input)))) + 1 + +part2 :: IO () +part2 = print $ flip index 0 $ presentSteps initial + +presentSteps :: Seq Int -> Seq Int +presentSteps elves + | isFinished elves = elves + | otherwise = presentSteps $ next elves + +initial :: Seq Int +initial = fromList [1..input] + +isFinished :: Seq Int -> Bool +isFinished elves = length elves == 1 + +next :: Seq Int -> Seq Int +next elves = prefix >< (midfix |> suffix) + where + target = length elves `quot` 2 + prefix = drop 1 $ take target elves + midfix = drop (target+1) elves + suffix = index elves 0 diff --git a/adventofcode1620/adventofcode1620.cabal b/adventofcode1620/adventofcode1620.cabal new file mode 100644 index 0000000..d2eb309 --- /dev/null +++ b/adventofcode1620/adventofcode1620.cabal @@ -0,0 +1,46 @@ +name: adventofcode1620 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent20 + hs-source-dirs: app + main-is: advent20.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1620 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +test-suite adventofcode1620-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1601 + , adventofcode16 + , parsec + , parsec-numbers + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1620/app/advent20.hs b/adventofcode1620/app/advent20.hs new file mode 100644 index 0000000..8830c45 --- /dev/null +++ b/adventofcode1620/app/advent20.hs @@ -0,0 +1,74 @@ +module Main(main) where + +import Text.Parsec +import Text.ParserCombinators.Parsec.Number +import Data.List (foldl') + +data Interval = Interval Int Int deriving (Show, Eq) + +low :: Interval -> Int +low (Interval l _) = l + +high :: Interval -> Int +high (Interval _ h) = h + +main :: IO () +main = do + text <- readFile "data/advent20.txt" + let intervals = successfulParse $ parseIfile text + part1 intervals + part2 intervals + +part1 :: [Interval] -> IO () +part1 intervals = print $ (+1) $ high $ head $ foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals + +part2 :: [Interval] -> IO () +part2 intervals = do + let ints = foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals + let gapCount = gaps ints + let lowGap = low $ head ints + let highGap = 4294967295 - (high $ last ints) + print (lowGap + gapCount + highGap) + +disjoint :: Interval -> Interval -> Bool +disjoint (Interval a b) (Interval c d) + | b < c = True + | d < a = True + | a > d = True + | c > b = True + | otherwise = False + +intersect :: Interval -> Interval -> Bool +intersect a b = not $ disjoint a b + +merge :: [Interval] -> Interval -> [Interval] +merge [] i0 = [i0] +merge (i1:intervals) i0 + | (high i0) < (low i1) = i0:i1:intervals + | intersect i0 i1 = merge intervals (Interval a' b') + | otherwise = i1:(merge intervals i0) + where a' = minimum [low i0, low i1] + b' = maximum [high i0, high i1] + +mergeAdjacent :: [Interval] -> Interval -> [Interval] +mergeAdjacent [] i0 = [i0] +mergeAdjacent (i1:intervals) i0 + | high i0 + 1 == low i1 = (Interval (low i0) (high i1)):intervals + | low i0 == high i1 + 1 = (Interval (low i1) (high i0)):intervals + | otherwise = i1:(mergeAdjacent intervals i0) + +gaps :: [Interval] -> Int +gaps [] = 0 +gaps [_] = 0 +gaps ((Interval _ b):(Interval c d):intervals) = + (c - b - 1) + gaps ((Interval c d):intervals) + +intervalFile = intervalLine `endBy` newline +intervalLine = Interval <$> int <*> (string "-" *> int) + +parseIfile :: String -> Either ParseError [Interval] +parseIfile input = parse intervalFile "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a diff --git a/adventofcode1621/adventofcode1621.cabal b/adventofcode1621/adventofcode1621.cabal new file mode 100644 index 0000000..9668d75 --- /dev/null +++ b/adventofcode1621/adventofcode1621.cabal @@ -0,0 +1,48 @@ +name: adventofcode1621 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent21 + hs-source-dirs: app + main-is: advent21.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1621 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + default-language: Haskell2010 + +test-suite adventofcode1621-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1621 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1621/app/advent21.hs b/adventofcode1621/app/advent21.hs new file mode 100644 index 0000000..2415974 --- /dev/null +++ b/adventofcode1621/app/advent21.hs @@ -0,0 +1,198 @@ +module Main(main) where + +import Text.Parsec hiding (State) +import Text.ParserCombinators.Parsec.Number +import Data.Maybe (fromJust) +import Data.List (elemIndex) + +import Control.Monad.Identity +import Control.Monad.State +import Control.Monad.Writer + +data Instruction = SwapPosition Int Int + | SwapLetter Char Char + | RotateSteps Int + | RotateLetter Char + | Reverse Int Int + | Move Int Int + deriving (Show, Eq) + +data Log = Log { + action :: String + } deriving (Show) + +data Password = Password { + password :: String + } deriving (Show) + + +type App = WriterT [Log] (StateT Password Identity) + +infixl 9 ?? + +(??) :: Eq a => [a] -> a -> Int +(??) items item = fromJust $ elemIndex item items + + +initial = "abcdefgh" +final = "fbgdceah" + +testInstructions = "\ +\swap position 4 with position 0\n\ +\swap letter d with letter b\n\ +\reverse positions 0 through 4\n\ +\rotate left 1 step\n\ +\move position 1 to position 4\n\ +\move position 3 to position 0\n\ +\rotate based on position of letter b\n\ +\rotate based on position of letter d\n" + +main :: IO () +main = do + -- let ti = successfulParse $ parseIfile testInstructions + -- part1 ti "abcde" + -- part2 (reverse ti) "decab" + text <- readFile "data/advent21.txt" + let instructions = successfulParse $ parseIfile text + part1 instructions initial + part2 (reverse instructions) final + +part1 :: [Instruction] -> String -> IO () +part1 instructions start = + let st = Password {password = start} + ((_, log), st') = runIdentity (runStateT (runWriterT (apply instructions)) st) + in do + -- putStrLn $ unlines $ map (action) log + putStrLn $ password st' + +part2 :: [Instruction] -> String -> IO () +part2 instructions end = + let st = Password {password = end} + ((_, log), st') = runIdentity (runStateT (runWriterT (unApply instructions)) st) + in do + -- putStrLn $ unlines $ map (action) log + putStrLn $ password st' + + +apply :: [Instruction] -> App () +apply [] = return () +apply (i:is) = + do st <- get + let p0 = password st + let p1 = applyInstruction i p0 + put st {password = p1} + tell [Log (p0 ++ " -> " ++ p1 ++ " : " ++ (show i))] + apply is + + +applyInstruction :: Instruction -> String -> String +applyInstruction (SwapPosition from to) p0 + | from == to = p0 + | otherwise = prefix ++ [p0!!end] ++ midfix ++ [p0!!start] ++ suffix + where start = minimum [from, to] + end = maximum [from, to] + prefix = take start p0 + midfix = take (end-start-1) $ drop (start+1) p0 + suffix = drop (end+1) p0 + +applyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapPosition (p0??l0) (p0??l1)) p0 + +applyInstruction (RotateSteps n) p0 = (drop n' p0) ++ (take n' p0) + where n' = if n < 0 + then (-1 * n) + else (length p0) - n + +applyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0 + where n = (1 + (p0??l) + if (p0??l) >= 4 then 1 else 0) `mod` (length p0) + +applyInstruction (Reverse from to) p0 + | from == to = p0 + | otherwise = prefix ++ (reverse midfix) ++ suffix + where start = minimum [from, to] + end = maximum [from, to] + prefix = take start p0 + midfix = take (end-start+1) $ drop start p0 + suffix = drop (end+1) p0 + +applyInstruction (Move from to) p0 + | from == to = p0 + | otherwise = prefix ++ [p0!!from] ++ suffix + where without = take from p0 ++ drop (from+1) p0 + prefix = take to without + suffix = drop (to) without + + +unApply :: [Instruction] -> App () +unApply [] = return () +unApply (i:is) = + do st <- get + let p0 = password st + let p1 = unApplyInstruction i p0 + put st {password = p1} + tell [Log (p1 ++ " <- " ++ p0 ++ " : " ++ (show i))] + unApply is + +unApplyInstruction :: Instruction -> String -> String +unApplyInstruction (SwapPosition from to) p0 = applyInstruction (SwapPosition from to) p0 +unApplyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapLetter l0 l1) p0 +unApplyInstruction (RotateSteps n) p0 = applyInstruction (RotateSteps (-1 * n)) p0 +unApplyInstruction (Reverse from to) p0 = applyInstruction (Reverse from to) p0 +unApplyInstruction (Move from to) p0 = applyInstruction (Move to from) p0 +unApplyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0 + where n = case (p0??l) of + 0 -> -1 + 1 -> -1 + 2 -> 2 + 3 -> -2 + 4 -> 1 + 5 -> -3 + 6 -> 0 + 7 -> -4 + -- where n = case (p0??l) of + -- 0 -> -1 + -- 1 -> -1 + -- 2 -> 1 + -- 3 -> -2 + -- 4 -> 1 + + +instructionFile = instructionLine `endBy` newline +instructionLine = choice [ swapL + , rotateL + , reverseL + , moveL + ] + +swapL = (try (string "swap ")) *> (swapPosL <|> swapLetterL) + +swapPosL = SwapPosition <$> (string "position" *> spaces *> int) + <*> (spaces *> string "with position" *> spaces *> int) + +swapLetterL = SwapLetter <$> (string "letter" *> spaces *> letter) + <*> (spaces *> string "with letter" *> spaces *> letter) + +rotateL = (try (string "rotate ")) *> (rotateDirL <|> rotateLetterL) + +rotateDirL = rotateStepify <$> ((string "left") <|> (string "right")) + <*> (spaces *> int <* spaces <* skipMany letter) + where rotateStepify dir n = case dir of + "left" -> (RotateSteps (-1 * n)) + "right" -> (RotateSteps n) +rotateLetterL = RotateLetter <$> (string "based on position of letter " *> letter) + +reverseL = Reverse <$> (string "reverse positions" *> spaces *> int) + <*> (spaces *> (string "through") *> spaces *> int) + +moveL = Move <$> (string "move position" *> spaces *> int) + <*> (spaces *> (string "to position") *> spaces *> int) + + +parseIfile :: String -> Either ParseError [Instruction] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError Instruction +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a diff --git a/adventofcode1622/adventofcode1622.cabal b/adventofcode1622/adventofcode1622.cabal new file mode 100644 index 0000000..6076ab7 --- /dev/null +++ b/adventofcode1622/adventofcode1622.cabal @@ -0,0 +1,82 @@ +name: adventofcode1622 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent22 + hs-source-dirs: app + main-is: advent22.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1622 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +executable advent22search + hs-source-dirs: app + main-is: advent22search.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1622 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +executable advent22showgrid + hs-source-dirs: app + main-is: advent22showgrid.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1622 + , adventofcode16 + , parsec + , parsec-numbers + default-language: Haskell2010 + +executable advent22library + hs-source-dirs: app + main-is: advent22library.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1622 + , adventofcode16 + , parsec + , parsec-numbers + , containers + , astar + , unordered-containers + , hashable + default-language: Haskell2010 + +test-suite adventofcode1622-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1622 + , adventofcode16 + , split + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1622/app/advent22.hs b/adventofcode1622/app/advent22.hs new file mode 100644 index 0000000..f2e084a --- /dev/null +++ b/adventofcode1622/app/advent22.hs @@ -0,0 +1,156 @@ +module Main(main) where + +import GHC.Generics (Generic) +import Text.Parsec +import Text.ParserCombinators.Parsec.Number +import Data.Maybe (catMaybes, fromJust) +import Data.List (find, delete, sort, sortOn, reverse) + +data Node = Node { x :: Int + , y :: Int + , size :: Int + , used :: Int + , available :: Int + , use_pc :: Int + } deriving (Show, Eq, Ord) + +data SearchState = SearchState { cx :: Int + , cy :: Int + , grid :: [Node] + } deriving (Show) +instance Ord SearchState where + s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2) +instance Eq SearchState where + s1 == s2 = equivalentState s1 s2 + +equivalentState :: SearchState -> SearchState -> Bool +equivalentState s1 s2 = + let h1 = fromJust $ find (\n -> used n == 0) $ grid s1 + h2 = fromJust $ find (\n -> used n == 0) $ grid s2 + in + cx s1 == cx s2 && cy s1 == cy s2 && + x h1 == x h2 && y h1 == y h2 + + +testGrid = "\ +\Filesystem Size Used Avail Use%\n\ +\/dev/grid/node-x0-y0 10T 8T 2T 80%\n\ +\/dev/grid/node-x0-y1 11T 6T 5T 54%\n\ +\/dev/grid/node-x0-y2 32T 28T 4T 87%\n\ +\/dev/grid/node-x1-y0 9T 7T 2T 77%\n\ +\/dev/grid/node-x1-y1 8T 0T 8T 0%\n\ +\/dev/grid/node-x1-y2 11T 7T 4T 63%\n\ +\/dev/grid/node-x2-y0 10T 6T 4T 60%\n\ +\/dev/grid/node-x2-y1 9T 8T 1T 88%\n\ +\/dev/grid/node-x2-y2 9T 6T 3T 66%\n\ +\" + +main :: IO () +main = do + text <- readFile "data/advent22.txt" + let sizes = successfulParse $ parseFile text + part1 sizes + part2 sizes + +part1 :: [Node] -> IO () +part1 sizes = print $ length viable + where viable = [(a, b) | a <- sizes, + b <- sizes, + a /= b, + (used a) > 0, + (used a) <= (available b)] + + +part2 :: [Node] -> IO () +part2 sizes = + -- do let testSizes = successfulParse $ parseFile testGrid + -- putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] [] + print (26 + 26 + 29 + 5 * 36) + + +aStar :: [[SearchState]] -> [SearchState] -> [SearchState] +aStar [] _ = [] +aStar (currentPath:agenda) closed = + if isGoal reached then currentPath + else if reached `elem` closed + then aStar agenda closed + else aStar newAgenda (reached:closed) + where + reached = head currentPath + successorPaths = map (:currentPath) $ successors reached + newAgenda = sortOn (cost) $ successorPaths ++ agenda + + +searchTrace :: [SearchState] -> String +searchTrace ss = unlines $ map (sst) ss + where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")" + +searchTraceH :: [SearchState] -> String +searchTraceH ss = unlines $ map (sst) ss + where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s + hole sk = fromJust $ find (\n -> used n == 0) $ grid sk + holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")" + +startSt :: [Node] -> SearchState +startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes} + where xs = map (\n -> x n) nodes + +isGoal :: SearchState -> Bool +isGoal st = cx st == 0 && cy st == 0 + +adjacent :: Node -> Node -> Bool +adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1 + +-- A move of data from n1 to n2 is legal. +legal :: Node -> Node -> Bool +legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2 + +heuristic :: SearchState -> Int +heuristic st = (cx st) + (cy st) + +successors :: SearchState -> [SearchState] +successors st = map (newState st current) possibleMoves + where nodes = grid st + current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes + possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2] + + +-- Moving data from n1 to n2 +newState :: SearchState -> Node -> (Node, Node) -> SearchState +newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'} + where cx' = if current == n1 then x n2 else x current + cy' = if current == n1 then y n2 else y current + grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}): + (n1 {used = 0, available = (size n1)}): + (delete n1 $ delete n2 (grid st)) + +cost :: [SearchState] -> Int +cost p = (heuristic $ head p) + (length p) + + + +duFile = duLine `sepEndBy` newline +-- duLine = (optionMaybe nodeL) + +duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing) + +headerL = (many (noneOf "\r\n")) + +nodeL = nodeify <$> (string "/dev/grid/node-x" *> int) + <*> (string "-y" *> int) + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "%") + where nodeify x y size used available use_pc = + Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc} + +parseFile :: String -> Either ParseError [Maybe Node] +parseFile input = parse duFile "(unknown)" input + +parseLine :: String -> Either ParseError (Maybe Node) +parseLine input = parse duLine "(unknown)" input + +successfulParse :: Either ParseError [Maybe a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = catMaybes a diff --git a/adventofcode1622/app/advent22library.hs b/adventofcode1622/app/advent22library.hs new file mode 100644 index 0000000..bad3621 --- /dev/null +++ b/adventofcode1622/app/advent22library.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Main(main) where + +import GHC.Generics (Generic) +import Text.Parsec +import Text.ParserCombinators.Parsec.Number +import Data.Maybe (catMaybes, fromJust) +import Data.List (find, delete, sort) +import Data.Graph.AStar +import Data.Hashable +import qualified Data.HashSet + +data Node = Node { x :: Int + , y :: Int + , size :: Int + , used :: Int + , available :: Int + , use_pc :: Int + } deriving (Show, Eq, Ord, Generic) +instance Hashable Node + +data SearchState = SearchState { cx :: Int + , cy :: Int + , grid :: [Node] + } deriving (Show, Eq, Generic) +instance Hashable SearchState +instance Ord SearchState where + s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2) + + +testGrid = "\ +\Filesystem Size Used Avail Use%\n\ +\/dev/grid/node-x0-y0 10T 8T 2T 80%\n\ +\/dev/grid/node-x0-y1 11T 6T 5T 54%\n\ +\/dev/grid/node-x0-y2 32T 28T 4T 87%\n\ +\/dev/grid/node-x1-y0 9T 7T 2T 77%\n\ +\/dev/grid/node-x1-y1 8T 0T 8T 0%\n\ +\/dev/grid/node-x1-y2 11T 7T 4T 63%\n\ +\/dev/grid/node-x2-y0 10T 6T 4T 60%\n\ +\/dev/grid/node-x2-y1 9T 8T 1T 88%\n\ +\/dev/grid/node-x2-y2 9T 6T 3T 66%\n\ +\" + +main :: IO () +main = do + text <- readFile "data/advent22.txt" + let sizes = successfulParse $ parseFile text + part1 sizes + part2 sizes + +part1 :: [Node] -> IO () +part1 sizes = print $ length viable + where viable = [(a, b) | a <- sizes, + b <- sizes, + a /= b, + (used a) > 0, + (used a) <= (available b)] + + +part2 :: [Node] -> IO () +part2 sizes = + -- do let testSizes = successfulParse $ parseFile testGrid + -- putStrLn $ searchTrace $ fromJust $ + -- aStar successors + -- (\_ _ -> 1) + -- heuristic + -- isGoal + -- (startSt testSizes) + putStrLn $ searchTrace $ fromJust $ + aStar successors + (\_ _ -> 1) + heuristic + isGoal + (startSt sizes) + + + +searchTrace :: [SearchState] -> String +searchTrace ss = unlines $ map (sst) ss + where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s + hole sk = fromJust $ find (\n -> used n == 0) $ grid sk + holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")" + +startSt :: [Node] -> SearchState +startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes} + where xs = map (\n -> x n) nodes + +isGoal :: SearchState -> Bool +isGoal st = cx st == 0 && cy st == 0 + +adjacent :: Node -> Node -> Bool +adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1 + +-- A move of data from n1 to n2 is legal. +legal :: Node -> Node -> Bool +legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2 + +heuristic :: SearchState -> Int +heuristic st = (cx st) + (cy st) + +successors :: SearchState -> Data.HashSet.HashSet SearchState +successors st = Data.HashSet.fromList $ map (newState st current) possibleMoves + where nodes = grid st + current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes + possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2] + + +-- Moving data from n1 to n2 +newState :: SearchState -> Node -> (Node, Node) -> SearchState +newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'} + where cx' = if current == n1 then x n2 else x current + cy' = if current == n1 then y n2 else y current + grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}): + (n1 {used = 0, available = (size n1)}): + (delete n1 $ delete n2 (grid st)) + + +duFile = duLine `sepEndBy` newline +-- duLine = (optionMaybe nodeL) + +duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing) + +headerL = (many (noneOf "\r\n")) + +nodeL = nodeify <$> (string "/dev/grid/node-x" *> int) + <*> (string "-y" *> int) + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "%") + where nodeify x y size used available use_pc = + Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc} + +parseFile :: String -> Either ParseError [Maybe Node] +parseFile input = parse duFile "(unknown)" input + +parseLine :: String -> Either ParseError (Maybe Node) +parseLine input = parse duLine "(unknown)" input + +successfulParse :: Either ParseError [Maybe a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = catMaybes a diff --git a/adventofcode1622/app/advent22search.hs b/adventofcode1622/app/advent22search.hs new file mode 100644 index 0000000..32ada24 --- /dev/null +++ b/adventofcode1622/app/advent22search.hs @@ -0,0 +1,156 @@ +module Main(main) where + +import GHC.Generics (Generic) +import Text.Parsec +import Text.ParserCombinators.Parsec.Number +import Data.Maybe (catMaybes, fromJust) +import Data.List (find, delete, sort, sortOn, reverse) + +data Node = Node { x :: Int + , y :: Int + , size :: Int + , used :: Int + , available :: Int + , use_pc :: Int + } deriving (Show, Eq, Ord) + +data SearchState = SearchState { cx :: Int + , cy :: Int + , grid :: [Node] + } deriving (Show) +instance Ord SearchState where + s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2) +instance Eq SearchState where + s1 == s2 = equivalentState s1 s2 + +equivalentState :: SearchState -> SearchState -> Bool +equivalentState s1 s2 = + let h1 = fromJust $ find (\n -> used n == 0) $ grid s1 + h2 = fromJust $ find (\n -> used n == 0) $ grid s2 + in + cx s1 == cx s2 && cy s1 == cy s2 && + x h1 == x h2 && y h1 == y h2 + + +testGrid = "\ +\Filesystem Size Used Avail Use%\n\ +\/dev/grid/node-x0-y0 10T 8T 2T 80%\n\ +\/dev/grid/node-x0-y1 11T 6T 5T 54%\n\ +\/dev/grid/node-x0-y2 32T 28T 4T 87%\n\ +\/dev/grid/node-x1-y0 9T 7T 2T 77%\n\ +\/dev/grid/node-x1-y1 8T 0T 8T 0%\n\ +\/dev/grid/node-x1-y2 11T 7T 4T 63%\n\ +\/dev/grid/node-x2-y0 10T 6T 4T 60%\n\ +\/dev/grid/node-x2-y1 9T 8T 1T 88%\n\ +\/dev/grid/node-x2-y2 9T 6T 3T 66%\n\ +\" + +main :: IO () +main = do + text <- readFile "data/advent22.txt" + let sizes = successfulParse $ parseFile text + part1 sizes + part2 sizes + +part1 :: [Node] -> IO () +part1 sizes = print $ length viable + where viable = [(a, b) | a <- sizes, + b <- sizes, + a /= b, + (used a) > 0, + (used a) <= (available b)] + + +part2 :: [Node] -> IO () +part2 sizes = + -- do let testSizes = successfulParse $ parseFile testGrid + -- putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] [] + print $ length $ aStar [[startSt sizes]] [] + + +aStar :: [[SearchState]] -> [SearchState] -> [SearchState] +aStar [] _ = [] +aStar (currentPath:agenda) closed = + if isGoal reached then currentPath + else if reached `elem` closed + then aStar agenda closed + else aStar newAgenda (reached:closed) + where + reached = head currentPath + successorPaths = map (:currentPath) $ successors reached + newAgenda = sortOn (cost) $ successorPaths ++ agenda + + +searchTrace :: [SearchState] -> String +searchTrace ss = unlines $ map (sst) ss + where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")" + +searchTraceH :: [SearchState] -> String +searchTraceH ss = unlines $ map (sst) ss + where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s + hole sk = fromJust $ find (\n -> used n == 0) $ grid sk + holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")" + +startSt :: [Node] -> SearchState +startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes} + where xs = map (\n -> x n) nodes + +isGoal :: SearchState -> Bool +isGoal st = cx st == 0 && cy st == 0 + +adjacent :: Node -> Node -> Bool +adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1 + +-- A move of data from n1 to n2 is legal. +legal :: Node -> Node -> Bool +legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2 + +heuristic :: SearchState -> Int +heuristic st = (cx st) + (cy st) + +successors :: SearchState -> [SearchState] +successors st = map (newState st current) possibleMoves + where nodes = grid st + current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes + possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2] + + +-- Moving data from n1 to n2 +newState :: SearchState -> Node -> (Node, Node) -> SearchState +newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'} + where cx' = if current == n1 then x n2 else x current + cy' = if current == n1 then y n2 else y current + grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}): + (n1 {used = 0, available = (size n1)}): + (delete n1 $ delete n2 (grid st)) + +cost :: [SearchState] -> Int +cost p = (heuristic $ head p) + (length p) + + + +duFile = duLine `sepEndBy` newline +-- duLine = (optionMaybe nodeL) + +duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing) + +headerL = (many (noneOf "\r\n")) + +nodeL = nodeify <$> (string "/dev/grid/node-x" *> int) + <*> (string "-y" *> int) + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "%") + where nodeify x y size used available use_pc = + Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc} + +parseFile :: String -> Either ParseError [Maybe Node] +parseFile input = parse duFile "(unknown)" input + +parseLine :: String -> Either ParseError (Maybe Node) +parseLine input = parse duLine "(unknown)" input + +successfulParse :: Either ParseError [Maybe a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = catMaybes a diff --git a/adventofcode1622/app/advent22showgrid.hs b/adventofcode1622/app/advent22showgrid.hs new file mode 100644 index 0000000..aec4309 --- /dev/null +++ b/adventofcode1622/app/advent22showgrid.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Main(main) where + +import GHC.Generics (Generic) +import Text.Parsec +import Text.ParserCombinators.Parsec.Number +import Data.Maybe (catMaybes, fromJust) +import Data.List (find, delete, sort, sortOn, reverse) + +data Node = Node { x :: Int + , y :: Int + , size :: Int + , used :: Int + , available :: Int + , use_pc :: Int + } deriving (Show, Eq, Ord) + + +testGrid = "\ +\Filesystem Size Used Avail Use%\n\ +\/dev/grid/node-x0-y0 10T 8T 2T 80%\n\ +\/dev/grid/node-x0-y1 11T 6T 5T 54%\n\ +\/dev/grid/node-x0-y2 32T 28T 4T 87%\n\ +\/dev/grid/node-x1-y0 9T 7T 2T 77%\n\ +\/dev/grid/node-x1-y1 8T 0T 8T 0%\n\ +\/dev/grid/node-x1-y2 11T 7T 4T 63%\n\ +\/dev/grid/node-x2-y0 10T 6T 4T 60%\n\ +\/dev/grid/node-x2-y1 9T 8T 1T 88%\n\ +\/dev/grid/node-x2-y2 9T 6T 3T 66%\n\ +\" + +main :: IO () +main = do + text <- readFile "data/advent22.txt" + let sizes = successfulParse $ parseFile text + let maxX = maximum $ map (\n -> x n) sizes + let maxY = maximum $ map (\n -> y n) sizes + putStrLn $ unlines $ map (showRow maxX sizes) [0..(maxY-1)] + + +showRow maxX sizes r = map (charOf) row + where row = sortOn (\c -> x c) $ filter (\c -> y c == r) sizes + charOf c = if (used c) == 0 + then '+' + else if (used c) > 100 + then '#' + else '_' + + + + +duFile = duLine `sepEndBy` newline +-- duLine = (optionMaybe nodeL) + +duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing) + +headerL = (many (noneOf "\r\n")) + +nodeL = nodeify <$> (string "/dev/grid/node-x" *> int) + <*> (string "-y" *> int) + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "T") + <*> (spaces *> int <* string "%") + where nodeify x y size used available use_pc = + Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc} + +parseFile :: String -> Either ParseError [Maybe Node] +parseFile input = parse duFile "(unknown)" input + +parseLine :: String -> Either ParseError (Maybe Node) +parseLine input = parse duLine "(unknown)" input + +successfulParse :: Either ParseError [Maybe a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = catMaybes a diff --git a/adventofcode1623/adventofcode1623.cabal b/adventofcode1623/adventofcode1623.cabal new file mode 100644 index 0000000..a5e87b0 --- /dev/null +++ b/adventofcode1623/adventofcode1623.cabal @@ -0,0 +1,48 @@ +name: adventofcode1623 +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/neilnjae/adventofcode16#readme +license: BSD3 +license-file: LICENSE +author: Neil Smith +maintainer: noone@njae.me.uk +copyright: 2016 Neil Smith +category: None +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +executable advent23 + hs-source-dirs: app + main-is: advent23.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode1601 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + default-language: Haskell2010 + +test-suite adventofcode1623-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , adventofcode1623 + , adventofcode16 + , parsec + , parsec-numbers + , mtl + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/neilnjae/adventofcode16 diff --git a/adventofcode1623/app/advent23.hs b/adventofcode1623/app/advent23.hs new file mode 100644 index 0000000..2903967 --- /dev/null +++ b/adventofcode1623/app/advent23.hs @@ -0,0 +1,180 @@ +module Main(main) where + +import Text.Parsec hiding (State) +import Text.ParserCombinators.Parsec.Number +import Control.Monad.State.Lazy +-- import Debug.Trace + +data Location = Literal Int | Register Char deriving (Show, Eq) +data Instruction = Cpy Location Location + | Inc Location + | Dec Location + | Jnz Location Location + | Tgl Location + deriving (Show, Eq) + +data Machine = Machine { a :: Int + , b :: Int + , c :: Int + , d :: Int + , pc :: Int + , instructions :: [Instruction]} + deriving (Show, Eq) + +testInstructions = "cpy 2 a\n\ +\tgl a\n\ +\tgl a\n\ +\tgl a\n\ +\cpy 1 a\n\ +\dec a\n\ +\dec a" + +emptyMachine :: Machine +emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]} + +main :: IO () +main = do + text <- readFile "data/advent23.txt" + let instructions = successfulParse $ parseIfile text + part1 instructions + part2 instructions + + +part1 :: [Instruction] -> IO () +part1 instrs = + do let m0 = emptyMachine {instructions=instrs, a = 7} + let mf = snd $ runState runMachine m0 + print (a mf) + +part2 :: [Instruction] -> IO () +part2 instrs = + do let m0 = emptyMachine {instructions=instrs, a = 12} + let mf = snd $ runState runMachine m0 + print (a mf) + + +runMachine :: State Machine () +runMachine = + do m <- get + if (pc m) >= (length $ instructions m) + then return () + else do executeStep + runMachine + +executeStep :: State Machine () +executeStep = + do m <- get + let i = (instructions m)!!(pc m) + put (executeInstructionPeep i m) + -- put (executeInstruction i m) + +executeInstructionPeep :: Instruction -> Machine -> Machine +executeInstructionPeep i m = + if sample1 == sample1Target + -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1 + then m1 + else if sample2 == sample2Target + -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2 + then m2 + else executeInstruction i m + where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m + sample1Target = [ Cpy (Literal 0) (Register 'a') + , Cpy (Register 'b') (Register 'c') + , Inc (Register 'a') + , Dec (Register 'c') + , Jnz (Register 'c') (Literal (-2)) + , Dec (Register 'd') + , Jnz (Register 'd') (Literal (-5)) ] + m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)} + sample2 = take (length sample2Target) $ drop (pc m) $ instructions m + sample2Target = [ Dec (Register 'b') + , Cpy (Register 'b') (Register 'c') + , Cpy (Register 'c') (Register 'd') + , Dec (Register 'd') + , Inc (Register 'c') + , Jnz (Register 'd') (Literal (-2)) ] + m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)} + + +executeInstruction :: Instruction -> Machine -> Machine +executeInstruction (Inc r@(Register _)) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m r + m' = writeValue m r (v+1) +executeInstruction (Inc (Literal _)) m = m {pc=pc1} + where pc1 = (pc m) + 1 +executeInstruction (Dec r@(Register _)) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m r + m' = writeValue m r (v-1) +executeInstruction (Dec (Literal _)) m = m {pc=pc1} + where pc1 = (pc m) + 1 +executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1} + where pc1 = (pc m) + 1 + v = evaluate m s + m' = writeValue m d v +executeInstruction (Cpy s (Literal _)) m = m {pc=pc1} + where pc1 = (pc m) + 1 +executeInstruction (Jnz s d) m + | v == 0 = m {pc=pc1} + | otherwise = m {pc=pcj} + where pc1 = (pc m) + 1 + ed = evaluate m d + pcj = (pc m) + ed + v = evaluate m s +executeInstruction (Tgl a) m + | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v), + pc=pc1} + | otherwise = m {pc=pc1} + where pc1 = pc m + 1 + v = evaluate m a + pc m + i = (instructions m)!!v + i' = case i of + Inc x -> Dec x + Dec x -> Inc x + Tgl x -> Inc x + Cpy x y -> Jnz x y + Jnz x y -> Cpy x y + replace xs x i = take i xs ++ [x] ++ drop (i+1) xs + + +evaluate :: Machine -> Location -> Int +evaluate _ (Literal i) = i +evaluate m (Register r) = + case r of + 'a' -> (a m) + 'b' -> (b m) + 'c' -> (c m) + 'd' -> (d m) + +writeValue :: Machine -> Location -> Int -> Machine +writeValue m (Literal i) _ = m +writeValue m (Register r) v = + case r of + 'a' -> m {a=v} + 'b' -> m {b=v} + 'c' -> m {c=v} + 'd' -> m {d=v} + + +instructionFile = instructionLine `sepEndBy` newline +instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL + +incL = Inc <$> (string "inc" *> spaces *> register) +decL = Dec <$> (string "dec" *> spaces *> register) +cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register) +jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location) +tglL = Tgl <$> (string "tgl" *> spaces *> location) + +location = (Literal <$> int) <|> register +register = Register <$> (oneOf "abcd") + +parseIfile :: String -> Either ParseError [Instruction] +parseIfile input = parse instructionFile "(unknown)" input + +parseIline :: String -> Either ParseError Instruction +parseIline input = parse instructionLine "(unknown)" input + +successfulParse :: Either ParseError [a] -> [a] +successfulParse (Left _) = [] +successfulParse (Right a) = a diff --git a/adventofcode1624/adventofcode1624.cabal b/adventofcode1624/adventofcode1624.cabal index f016db1..f6a3a25 100644 --- a/adventofcode1624/adventofcode1624.cabal +++ b/adventofcode1624/adventofcode1624.cabal @@ -36,7 +36,7 @@ test-suite adventofcode1624-test hs-source-dirs: test main-is: Spec.hs build-depends: base - , adventofcode1601 + , adventofcode1624 , adventofcode16 , containers , astar diff --git a/stack.yaml b/stack.yaml index cf9451a..d3fc849 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,6 +4,27 @@ packages: - adventofcode16 - adventofcode1601 - adventofcode1602 +- adventofcode1603 +- adventofcode1604 +- adventofcode1605 +- adventofcode1606 +- adventofcode1607 +- adventofcode1608 +- adventofcode1609 +- adventofcode1610 +- adventofcode1611 +- adventofcode1612 +- adventofcode1613 +- adventofcode1614 +- adventofcode1615 +- adventofcode1616 +- adventofcode1617 +- adventofcode1618 +- adventofcode1619 +- adventofcode1620 +- adventofcode1621 +- adventofcode1622 +- adventofcode1623 - adventofcode1624 - adventofcode1625 system-ghc: true