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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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 = ' '
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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]
--- /dev/null
+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
--- /dev/null
+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)
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+
--- /dev/null
+-- 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
+
--- /dev/null
+-- 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
+
--- /dev/null
+-- 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
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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)
+
--- /dev/null
+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
--- /dev/null
+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)
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+{-# 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
--- /dev/null
+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
--- /dev/null
+{-# 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
--- /dev/null
+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
--- /dev/null
+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
hs-source-dirs: test
main-is: Spec.hs
build-depends: base
- , adventofcode1601
+ , adventofcode1624
, adventofcode16
, containers
, astar
- 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
projects / advent-of-code-16.git / commitdiff