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