From 5eb58ad076f2cd435b11b140820da224b60b73d5 Mon Sep 17 00:00:00 2001 From: Aria Date: Mon, 2 Jan 2023 21:58:56 +0000 Subject: initial commit --- 2021/day23/Setup.hs | 2 + 2021/day23/app/Main.hs | 138 +++++++++++++++++++++++++++++++++++++++++++++ 2021/day23/day23.cabal | 52 +++++++++++++++++ 2021/day23/package.yaml | 40 +++++++++++++ 2021/day23/src/Lib.hs | 6 ++ 2021/day23/stack.yaml | 68 ++++++++++++++++++++++ 2021/day23/stack.yaml.lock | 20 +++++++ 7 files changed, 326 insertions(+) create mode 100644 2021/day23/Setup.hs create mode 100644 2021/day23/app/Main.hs create mode 100644 2021/day23/day23.cabal create mode 100644 2021/day23/package.yaml create mode 100644 2021/day23/src/Lib.hs create mode 100644 2021/day23/stack.yaml create mode 100644 2021/day23/stack.yaml.lock (limited to '2021/day23') diff --git a/2021/day23/Setup.hs b/2021/day23/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/2021/day23/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/2021/day23/app/Main.hs b/2021/day23/app/Main.hs new file mode 100644 index 0000000..fbce993 --- /dev/null +++ b/2021/day23/app/Main.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +module Main where + +import Algorithm.Search (dijkstraAssoc) +import qualified Data.Text as T +import Data.Maybe (listToMaybe, catMaybes) +import Data.List (intercalate, transpose) +import Data.Char (isLetter) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Set (Set) +import qualified Data.Set as S + +data Species = Am | Br | Co | De deriving (Show, Eq, Ord) +type Coord = (Int, Int) +type Board = Map Coord Species + +toSpecies :: Char -> Species +toSpecies 'A' = Am +toSpecies 'B' = Br +toSpecies 'C' = Co +toSpecies 'D' = De + +cost :: Species -> Int +cost Am = 1 +cost Br = 10 +cost Co = 100 +cost De = 1000 + +roomX :: Species -> Int +roomX Am = 1 +roomX Br = 3 +roomX Co = 5 +roomX De = 7 + +isRoomX :: Int -> Bool +isRoomX 1 = True +isRoomX 3 = True +isRoomX 5 = True +isRoomX 7 = True +isRoomX _ = False + +lowerBound = (-1) +upperBound = 9 +lowestY = 4 + +inBounds :: Coord -> Bool +inBounds (x, _) = x >= lowerBound && x <= upperBound + +parseFile :: String -> Board +parseFile s = foldl insertRoom M.empty rooms + where letters = transpose $ map (map toSpecies . filter isLetter . T.unpack) $ T.splitOn "\n" (T.pack s) + rooms = zip [Am, Br, Co, De] letters + insertRoom m (s, cs) = (M.fromList [((roomX s, y), c) | (y, c) <- zip [1..] cs]) `M.union` m + +topOfRoom :: Board -> Int -> Maybe Coord +topOfRoom b x = listToMaybe $ filter (`M.member` b) [(x, y) | y <- [1..lowestY]] + +availableHallwaySpaces :: Board -> Int -> [Coord] +availableHallwaySpaces b sx = (exploreWith (+ 1) sx) ++ (exploreWith (+ (-1)) (sx - 1)) + where exploreWith f x | isRoomX x = exploreWith f (f x) + | not (inBounds (x, 0)) = [] + | (x, 0) `M.member` b = [] + | otherwise = (x, 0) : exploreWith f (f x) + +pathToRoom :: Coord -> Species -> [Coord] +pathToRoom (sx, _) es | sx <= ex = map (, 0) [sx + 1..ex] + | otherwise = map (, 0) [ex..sx - 1] + where ex = roomX es + +pathClear :: Board -> [Coord] -> Bool +pathClear b path = all (`M.notMember` b) path + +toTopOfRoom :: Int -> Int +toTopOfRoom x = x - 1 + +movingFromRoom :: Board -> Species -> [(Board, Int)] +movingFromRoom b s = case topOfRoom b (roomX s) of + Just (x, y) -> let withoutTop = (x, y) `M.delete` b + extraCost = toTopOfRoom y + Just movingOut = (x, y) `M.lookup` b + in [(M.insert c movingOut withoutTop, (abs ((fst c) - x) + 1 + extraCost) * cost movingOut) | c <- availableHallwaySpaces b x] + Nothing -> [] + +roomPositions = [1..lowestY] + +movingIntoRoom :: Board -> [(Board, Int)] +movingIntoRoom b = concatMap attemptMoveToRoom [((c, 0), (c, 0) `M.lookup` b) | c <- [lowerBound..upperBound]] + where attemptMoveToRoom (_, Nothing) = [] + attemptMoveToRoom (c, Just s) | not clear = [] + | otherwise = [(b', (length p + 1 + extraCost) * (cost s))] + where p = pathToRoom c s + clear = pathClear b p && hasSpace && isCorrect + occupants = catMaybes [(roomX s, y) `M.lookup` b | y <- roomPositions] + hasSpace = length occupants < lowestY + isCorrect = all (== s) occupants + y' = lowestY - (length occupants) + extraCost = toTopOfRoom y' + c' = (roomX s, y') + b' = M.insert c' s $ M.delete c b + +species = [Am, Br, Co, De] + +nextMoves :: Board -> [(Board, Int)] +nextMoves b = (concatMap (movingFromRoom b) species) ++ movingIntoRoom b + +isFinished :: Board -> Bool +isFinished b = all id [(M.lookup (roomX s, rp) b) == Just s | s <- species, rp <- roomPositions] + +solve :: Board -> Maybe (Int, [Board]) +solve = dijkstraAssoc nextMoves isFinished + +printBoard :: Board -> String +printBoard b = intercalate "\n" [printLine l | l <- [0..lowestY]] + where printLine l = [toChar ((x, l) `M.lookup` b) | x <- [lowerBound..upperBound]] + toChar Nothing = ' ' + toChar (Just Am) = 'A' + toChar (Just Br) = 'B' + toChar (Just Co) = 'C' + toChar (Just De) = 'D' + +printNexts :: [(Board, Int)] -> IO [()] +printNexts = sequence . map printNext + +printNext :: (Board, Int) -> IO () +printNext (b, c) = do + putStrLn $ printBoard b + print c + +main :: IO () +main = do + input <- readFile "./input" + let parsed = parseFile input + let Just (cost, path) = solve parsed + putStrLn $ intercalate "\n---\n" $ map printBoard path + print path + print cost diff --git a/2021/day23/day23.cabal b/2021/day23/day23.cabal new file mode 100644 index 0000000..51b4ad5 --- /dev/null +++ b/2021/day23/day23.cabal @@ -0,0 +1,52 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.5. +-- +-- see: https://github.com/sol/hpack + +name: day23 +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/day23#readme +bug-reports: https://github.com/githubuser/day23/issues +author: Author name here +maintainer: example@example.com +copyright: 2021 Author name here +license: BSD3 +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/githubuser/day23 + +library + exposed-modules: + Lib + other-modules: + Paths_day23 + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , containers + , search-algorithms + , text + default-language: Haskell2010 + +executable day23-exe + main-is: Main.hs + other-modules: + Paths_day23 + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , containers + , day23 + , search-algorithms + , text + default-language: Haskell2010 diff --git a/2021/day23/package.yaml b/2021/day23/package.yaml new file mode 100644 index 0000000..a41ad1f --- /dev/null +++ b/2021/day23/package.yaml @@ -0,0 +1,40 @@ +name: day23 +version: 0.1.0.0 +github: "githubuser/day23" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2021 Author name here" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- containers +- text +- search-algorithms + +library: + source-dirs: src + +executables: + day23-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - day23 diff --git a/2021/day23/src/Lib.hs b/2021/day23/src/Lib.hs new file mode 100644 index 0000000..d36ff27 --- /dev/null +++ b/2021/day23/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/2021/day23/stack.yaml b/2021/day23/stack.yaml new file mode 100644 index 0000000..920ab59 --- /dev/null +++ b/2021/day23/stack.yaml @@ -0,0 +1,68 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/20.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +extra-deps: + - search-algorithms-0.3.2 + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/2021/day23/stack.yaml.lock b/2021/day23/stack.yaml.lock new file mode 100644 index 0000000..1f94557 --- /dev/null +++ b/2021/day23/stack.yaml.lock @@ -0,0 +1,20 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: search-algorithms-0.3.2@sha256:9d224b9c6b5875598e6fc91497a178f3ca6e45768c637d07d4f874e6211a331b,2203 + pantry-tree: + size: 557 + sha256: 43e9d4344d57a3bad78f67d085156531e0a9b38a14dce9f5137940561fdb3582 + original: + hackage: search-algorithms-0.3.2 +snapshots: +- completed: + size: 586106 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/20.yaml + sha256: 8699812d2b2c1f83d6ad1261de9cf628ed36a1cfc14f19d67188e005e7a3a39d + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/20.yaml -- cgit v1.2.3