WIP AOC 2022 & 2023

2026-01-14 13:59:51 +01:00 · 2023-12-18 20:31:56 +01:00
parent d040b97bc8
commit 9eab62f7f8
46 changed files with 1355 additions and 0 deletions
--- a/AOC2023/.gitignore
+++ b/AOC2023/.gitignore
@@ -0,0 +1,5 @@
+.stack-work/
+.idea
+out/
+*.iml
+*~
--- a/AOC2023/CHANGELOG.md
+++ b/AOC2023/CHANGELOG.md
@@ -0,0 +1,11 @@
+# Changelog for `AOC2023`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD
--- a/AOC2023/LICENSE
+++ b/AOC2023/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2023
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- a/AOC2023/README.md
+++ b/AOC2023/README.md
@@ -0,0 +1 @@
+# AOC2023
--- a/AOC2023/Setup.hs
+++ b/AOC2023/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/AOC2023/app/Main.hs
+++ b/AOC2023/app/Main.hs
@@ -0,0 +1,54 @@
+module Main (main) where
+
+import System.Environment
+
+import Day01
+import Day02
+import Day03
+import Day04
+import Day05
+import Day06
+import Day07
+import Day08
+import Day09
+import Day10
+import Day11
+import Day12
+import Day13
+import Day14
+import Day15
+import Day16
+import Day17
+import Day18
+import Day19
+import Day20
+
+
+main :: IO ()
+main = do
+  args <- getArgs
+  dayPicker args
+
+dayPicker :: [String] -> IO ()
+dayPicker [] = putStrLn "Usage: script [day]"
+dayPicker ("01":_) = day01
+dayPicker ("02":_) = day02
+dayPicker ("03":_) = day03
+dayPicker ("04":_) = day04
+dayPicker ("05":_) = day05
+dayPicker ("06":_) = day06
+dayPicker ("07":_) = day07
+dayPicker ("08":_) = day08
+dayPicker ("09":_) = day09
+dayPicker ("10":_) = day10
+dayPicker ("11":_) = day11
+dayPicker ("12":_) = day12
+dayPicker ("13":_) = day13
+dayPicker ("14":_) = day14
+dayPicker ("15":_) = day15
+dayPicker ("16":_) = day16
+dayPicker ("17":_) = day17
+dayPicker ("18":_) = day18
+dayPicker ("19":_) = day19
+dayPicker ("20":_) = day20
+dayPicker _ = putStrLn "Unavailable date"
--- a/AOC2023/package.yaml
+++ b/AOC2023/package.yaml
@@ -0,0 +1,62 @@
+name:                AOC2023
+version:             0.1.0.0
+github:              "githubuser/AOC2023"
+license:             BSD-3-Clause
+author:              "Author name here"
+maintainer:          "example@example.com"
+copyright:           "2023 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 <https://github.com/githubuser/AOC2023#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- containers
+- split
+- parsec
+
+ghc-options:
+- -Wall
+- -Wcompat
+- -Widentities
+- -Wincomplete-record-updates
+- -Wincomplete-uni-patterns
+- -Wmissing-export-lists
+- -Wmissing-home-modules
+- -Wpartial-fields
+- -Wredundant-constraints
+
+library:
+  source-dirs: src
+
+executables:
+  AOC2023-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - AOC2023
+
+tests:
+  AOC2023-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - AOC2023
--- a/AOC2023/src/Day01.hs
+++ b/AOC2023/src/Day01.hs
@@ -0,0 +1,50 @@
+module Day01 (day01) where
+
+import Data.Char (digitToInt, isDigit)
+
+getNumberFromDigits :: [Int] -> Int
+getNumberFromDigits nums = head nums * 10 + last nums
+
+extractDataP1 :: String -> Int
+extractDataP1 input = getNumberFromDigits $ map digitToInt (filter isDigit input)
+
+extractDataP2 :: String -> Int
+extractDataP2 input = getFirst input * 10 + getSecond (reverse input)
+  where
+    getFirst ('o':'n':'e':_) = 1
+    getFirst ('t':'w':'o':_) = 2
+    getFirst ('t':'h':'r':'e':'e':_) = 3
+    getFirst ('f':'o':'u':'r':_) = 4
+    getFirst ('f':'i':'v':'e':_) = 5
+    getFirst ('s':'i':'x':_) = 6
+    getFirst ('s':'e':'v':'e':'n':_) = 7
+    getFirst ('e':'i':'g':'h':'t':_) = 8
+    getFirst ('n':'i':'n':'e':_) = 9
+    getFirst (c:t)
+      | isDigit c = digitToInt c
+      | otherwise = getFirst t
+    getFirst [] = 0    
+    getSecond ('e':'n':'o':_) = 1
+    getSecond ('o':'w':'t':_) = 2
+    getSecond ('e':'e':'r':'h':'t':_) = 3
+    getSecond ('r':'u':'o':'f':_) = 4
+    getSecond ('e':'v':'i':'f':_) = 5
+    getSecond ('x':'i':'s':_) = 6
+    getSecond ('n':'e':'v':'e':'s':_) = 7
+    getSecond ('t':'h':'g':'i':'e':_) = 8
+    getSecond ('e':'n':'i':'n':_) = 9
+    getSecond (c:t)
+      | isDigit c = digitToInt c
+      | otherwise = getSecond t
+    getSecond [] = 0    
+
+day01 :: IO ()
+day01 = do
+   putStrLn "AOC 2023 day 01"
+   input <- getContents
+   putStrLn "Part1"
+   let resP1 = map extractDataP1 $ lines input
+   print $ sum resP1
+   putStrLn "Part2"
+   let resP2 = map extractDataP2 $ lines input
+   print resP2
--- a/AOC2023/src/Day02.hs
+++ b/AOC2023/src/Day02.hs
@@ -0,0 +1,60 @@
+module Day02 (day02) where
+
+import Data.List as List
+import Data.List.Split (splitOn)
+
+import Data.Char (digitToInt, isDigit)
+
+data Play = Play Int Int Int deriving (Show, Eq)
+instance Ord Play where
+  compare (Play r1 g1 b1) (Play r2 g2 b2) =
+    let cr = compare r1 r2
+        cg = compare g1 g2
+        cb = compare b1 b2
+    in case (cr, cg, cb) of
+      (GT, _, _) -> GT
+      (_, GT, _) -> GT
+      (_, _, GT) -> GT
+      _ -> LT
+
+
+data Game = Game { gameNb :: Int, plays :: [Play] } deriving Show
+
+parsePlay :: String -> Play
+parsePlay input = foldl parseItem (Play 0 0 0) parts
+  where parts = map ((\e -> (head e, e !! 1)) . splitOn " ") (", " `splitOn` input)
+        parseItem (Play r g b) (n, "red") = Play (r + read n) g b
+        parseItem (Play r g b) (n, "green") = Play r (g + read n) b
+        parseItem (Play r g b) (n, "blue") = Play r g (b + read n)
+        parseItem p _ = p
+
+getGameNb :: String -> Int
+getGameNb input = read $ ps !! 1
+  where ps = " " `splitOn` input
+
+parseLine :: String -> Game
+parseLine input = Game gameNb plays
+  where parts = ": " `splitOn` input
+        gameNb = getGameNb $ head parts
+        plays = map parsePlay $ "; " `splitOn` (parts !! 1)
+
+runP1 :: Play -> Game -> Bool
+runP1 limit (Game _ ps) = all (<= limit) ps
+
+runP2 :: Game -> Int
+runP2 (Game _ ps) = rs * gs * bs
+  where acc = foldl accumulate (Play 0 0 0) ps
+        accumulate (Play r1 g1 b1) (Play r2 g2 b2) = Play (max r1 r2) (max g1 g2) (max b1 b2)
+        (Play rs gs bs) = acc
+
+day02 :: IO ()
+day02 = do
+   putStrLn "AOC 2023 day 02"
+   input <- getContents
+   let parsed = map parseLine (lines input)
+   putStrLn "Part1"
+   let resP1 = filter (runP1 (Play 12 13 14)) parsed
+   print $ sum $ map gameNb resP1
+   putStrLn "Part2"
+   let resP2 = sum $ map runP2 parsed
+   print resP2
--- a/AOC2023/src/Day03.hs
+++ b/AOC2023/src/Day03.hs
@@ -0,0 +1,51 @@
+module Day03 (day03) where
+
+import Data.Char (isDigit, digitToInt)
+
+import qualified Data.Map as Map
+
+data Pos = Pos Int Int deriving (Show, Ord, Eq)
+
+data Symbol = Symbol { symbolChar :: Char, symbolPos :: Pos } deriving (Show, Eq)
+
+data Part = Part { pos :: Pos, partNb :: Int, partSymbols :: [Symbol] } deriving (Show)
+
+isNeighbor :: Pos -> Pos -> Bool
+isNeighbor (Pos x1 y1) (Pos x2 y2) = (abs (x2 - x1) <= 1) && (abs (y2 - y1) <= 1)
+
+getNeighborSymbols :: [Symbol] -> Pos -> [Symbol]
+getNeighborSymbols symbols p = filter (\(Symbol _ ps) -> isNeighbor p ps) symbols
+
+getAccNumbers :: [Symbol] -> [Part] -> (Pos, Int) -> [Part]
+getAccNumbers allSymbols [] (curPos, curNb) = [Part curPos curNb neighborSymbols]
+    where neighborSymbols = getNeighborSymbols allSymbols curPos
+getAccNumbers allSymbols (curPart@(Part (Pos accX accY) accInt symbols):t) (curPos@(Pos curX curY), curInt)
+  | accX == curX && accY == curY - 1 = Part curPos (accInt * 10 + curInt) (neighborSymbols ++ symbols) : t
+  | otherwise = Part curPos curInt neighborSymbols : curPart : t
+    where neighborSymbols = getNeighborSymbols allSymbols curPos
+
+getParts :: Map.Map Pos Int -> [Symbol] -> [Part]
+getParts numbers symbols = foldl accNumber [] (Map.toList numbers)
+  where accNumber = getAccNumbers symbols
+
+
+parseInput :: String -> ([Part], [Symbol])
+parseInput input = (parts, symbols)
+  where chars = [ (Pos x y, c) | (x, row) <- zip [0..] (lines input), (y, c) <- zip [0..] row, c /= '.' ]
+        numbers = Map.fromList $ map (\(k, v) -> (k, digitToInt v)) $ filter (\(_, v) -> isDigit v) chars :: Map.Map Pos Int
+        symbols = map (\(k, v) -> Symbol v k) $ filter (\(_, v) -> not $ isDigit v) chars  :: [Symbol]
+        parts = getParts numbers symbols
+
+
+day03 :: IO ()
+day03 = do
+   putStrLn "AOC 2023 day 03"
+   input <- getContents
+   let (parts, symbols) = parseInput input
+   putStrLn "Part1"
+   let part1 = sum $ map partNb $ filter (not . null . partSymbols) parts
+   print part1
+   putStrLn "Part2"
+   let allStars = filter ((== '*') . symbolChar) symbols
+   let part2 = sum $ map (\ps -> head ps * ps !! 1) $ filter ((== 2) . length) $ map (\s -> map partNb $ filter (elem s . partSymbols) parts) allStars
+   print part2
--- a/AOC2023/src/Day04.hs
+++ b/AOC2023/src/Day04.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE TupleSections #-}
+
+module Day04 (day04) where
+
+import Data.List (intersect)
+import Data.List.Split (splitOn)
+import qualified Data.Map as Map
+
+parseLine :: String -> Int
+parseLine input = length matchingNumbers
+  where (leftSide: part3: _) = splitOn " | " input
+        (_: part2: _) = splitOn ": " leftSide
+        winningNumbers =  filter (not . null) $ splitOn " " part2
+        cardNumbers = filter (not . null) $ splitOn " " part3
+        matchingNumbers = winningNumbers `intersect` cardNumbers
+
+computeCardScore :: Int -> Int
+computeCardScore 0 = 0
+computeCardScore nbMatching = 2 ^ nbMatching - 1
+
+winCards :: ([Int], [(Int, Int)]) -> Int -> ([Int], [(Int, Int)])
+winCards (cardsQty, []) _ = (cardsQty, [])
+winCards (cardsQty, (nb, matching):t) _ = (nb:cardsQty, updatedNext)
+  where updatedNext = if matching == 0 then t else (map (\(qty, m) -> (qty + nb, m)) $ take matching t) ++ drop matching t
+
+
+day04 :: IO ()
+day04 = do
+   putStrLn "AOC 2023 day 04"
+   input <- getContents
+   let cards = map parseLine $ lines input
+   let resP1 = sum $ map computeCardScore cards
+   putStrLn "Part1"
+   print resP1
+   let cardsWithQty = map (1,) cards
+   putStrLn "Part2"
+   let resP2 = sum $ fst $ foldl winCards ([], cardsWithQty) cards
+   print resP2
--- a/AOC2023/src/Day05.hs
+++ b/AOC2023/src/Day05.hs
@@ -0,0 +1,68 @@
+module Day05 (day05) where
+import Debug.Trace (trace)
+
+import Data.List.Split (splitOn, chunksOf)
+
+type Mapping = [(Int, Int, Int)]
+type Mappings = [Mapping]
+
+browseMappings :: Mappings -> Int -> Int
+browseMappings [] i = i
+browseMappings ([]:t) i = browseMappings t i
+browseMappings (((to, from, len):t):tt) i
+  | i >= from, i <= from + len =  browseMappings tt $ i - from + to
+  | otherwise = browseMappings (t:tt) i
+
+revBrowseMappings :: Mappings -> Int -> Int
+revBrowseMappings [] i = i
+revBrowseMappings ([]:t) i = browseMappings t i
+revBrowseMappings (((from, to, len):t):tt) i
+  | i >= from, i <= from + len = browseMappings tt $ i - from + to
+  | otherwise = browseMappings (t:tt) i
+
+parseMapping :: String -> Mapping
+parseMapping input = numbers
+  where
+    input_ = tail $ lines input
+    numbers = map ((\nbs -> (read $ head nbs, read $ nbs !! 1, read $ nbs !! 2)) . splitOn " ") input_
+
+parseSeedId :: String -> [Int]
+parseSeedId input = map read $ splitOn " " $ splitOn ": " input !! 1
+
+parseInput :: String -> ([Int], Mappings)
+parseInput input = (seedsId_, mappings)
+  where
+    seedsId_ = parseSeedId $ head split
+    mappings = map parseMapping $ tail split
+    split = splitOn "\n\n" input
+
+switchSeedIdToRanges :: [Int] -> [(Int, Int)]
+switchSeedIdToRanges input = map (\c -> (head c, head c + last c)) chunks
+  where chunks = chunksOf 2 input
+
+isInRanges :: [(Int, Int)] -> Int -> Bool
+isInRanges [] _ = False
+isInRanges ((a, b):t) v
+  | v >= a && v <= b = True
+  | otherwise = isInRanges t v
+
+reverseSearchMapping :: Mappings -> [(Int, Int)] -> Int -> Int
+reverseSearchMapping mappings seedRanges start
+  | isInRanges seedRanges endValue = start
+  | otherwise = reverseSearchMapping mappings seedRanges (start + 1)
+  where endValue = revBrowseMappings mappings start
+
+day05 :: IO ()
+day05 = do
+  putStrLn "AOC 2023 day 05"
+  input <- getContents
+  let (seeds, mappings) = parseInput input
+  putStrLn "Part1"
+  let resP1 = minimum $ map (browseMappings mappings) seeds
+  print resP1
+  putStrLn "Part2"
+  putStrLn "Not working..."
+  print $ mappings
+  print $ reverse mappings
+  let resP2 = reverseSearchMapping (reverse mappings) (switchSeedIdToRanges seeds) 0
+  print resP2
--- a/AOC2023/src/Day06.hs
+++ b/AOC2023/src/Day06.hs
@@ -0,0 +1,34 @@
+module Day06 (day06) where
+
+import Data.List.Split (splitOn)
+
+parseInput :: [String] -> [(Int, Int)]
+parseInput input = zip (head cleaned) (cleaned !! 1)
+  where input_ = map (last . splitOn ":") input :: [String]
+        cleanPart i = map read $ filter (/= "") $ splitOn " " i :: [Int]
+        cleaned = map cleanPart input_ :: [[Int]]
+
+parseInputP2 :: [String] -> (Int, Int)
+parseInputP2 input = (head cleaned, cleaned !! 1)
+  where input_ = map (last . splitOn ":") input :: [String]
+        cleanPart i = read $ filter (/= ' ') i :: Int
+        cleaned = map cleanPart input_ :: [Int]
+
+runDistances :: Int -> [(Int, Int)]
+runDistances totalTime = forChargeTime totalTime
+  where forChargeTime 0 = [(0, 0)]
+        forChargeTime n = (n, (totalTime - n) * n) : forChargeTime (n - 1)
+
+day06 :: IO ()
+day06 = do
+  putStrLn "AOC 2023 day 06"
+  input <- getContents
+  let inputP1 = parseInput $ lines input
+  let winningRuns = map (\i -> filter (\(_, d) -> d > snd i) $ runDistances $ fst i) inputP1
+  putStrLn "Part1"
+  let resP1 = product $ map length winningRuns
+  print resP1
+  putStrLn "Part2"
+  let inputP2 = parseInputP2 $ lines input
+  let resP2 = length $ filter (\(_, d) -> d > snd inputP2) $ runDistances $ fst inputP2
+  print resP2
--- a/AOC2023/src/Day07.hs
+++ b/AOC2023/src/Day07.hs
@@ -0,0 +1,102 @@
+module Day07 (day07) where
+
+import Data.List (sort, sortBy, group)
+import Data.List.Split (splitOn)
+
+
+data HandScore = HandScore { typeValue :: Int, highCard1 :: Int, highCard2 :: Int, highCard3 :: Int, highCard4 :: Int, highCard5 :: Int } deriving (Show, Eq, Ord)
+
+type Hand = [Int]
+type Bid = Int
+
+-- HandScore      typeValue     highCard1       highCard2
+-- 5 of a kind        10        card value      0
+-- 4 of a kind         9        card value      remaining
+-- full house          8        3 card value    2 card value
+-- 3 of a kind         7        3 card value    remaining best
+-- 2 pairs             6        2 card value1   2 card value2
+-- 1 pair              5        2 card value    remaining best
+-- high card           1        best value      2nd best
+--getHandScore :: Hand -> HandScore
+--getHandScore cards = score
+--  where grouped = group cards
+
+compareGroupOfCards :: [Int] -> [Int] -> Ordering
+compareGroupOfCards x y
+  | lengths == EQ = vals
+  | otherwise = lengths
+  where lengths = compare (length y) (length x)
+        vals = compare (head y) (head x)
+
+
+getHandScore :: Hand -> HandScore
+getHandScore cards
+  | length grouped == 1 = HandScore 10 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length grouped == 2 && length (head grouped) == 4 = HandScore 9 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length grouped == 2 && length (head grouped) == 3 = HandScore 8 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length grouped == 3 && length (head grouped) == 3 = HandScore 7 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length grouped == 3 && length (head grouped) == 2 = HandScore 6 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length grouped == 4 = HandScore 5 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | otherwise = HandScore 1 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  where grouped = sortBy compareGroupOfCards $ group $ sort cards
+
+getHandScoreP2 :: Hand -> HandScore
+getHandScoreP2 cards
+  | length newGrouped == 1 = HandScore 10 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length newGrouped == 2 && length (head newGrouped) == 4 = HandScore 9 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length newGrouped == 2 && length (head newGrouped) == 3 = HandScore 8 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length newGrouped == 3 && length (head newGrouped) == 3 = HandScore 7 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length newGrouped == 3 && length (head newGrouped) == 2 = HandScore 6 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | length newGrouped == 4 = HandScore 5 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  | otherwise = HandScore 1 (head cards) (cards !! 1) (cards !! 2) (cards !! 3) (cards !! 4)
+  where grouped = sortBy compareGroupOfCards $ group $ sort cards
+        groupOf1 = filter (\gc -> head gc == 1) grouped
+        jokers = if (length groupOf1) > 0 then head groupOf1 else []
+        groupDiff1 = filter (\gc -> head gc /= 1) grouped
+        newGrouped = (head groupDiff1 ++ jokers) : (if length groupDiff1 > 0 then tail groupDiff1 else []) 
+
+charToCard :: Char -> Int
+charToCard '2' = 2
+charToCard '3' = 3
+charToCard '4' = 4
+charToCard '5' = 5
+charToCard '6' = 6
+charToCard '7' = 7
+charToCard '8' = 8
+charToCard '9' = 9
+charToCard 'T' = 10
+charToCard 'J' = 11
+charToCard 'Q' = 12
+charToCard 'K' = 13
+charToCard 'A' = 14
+charToCard _   = 0
+
+parseLine :: String -> (String, Hand, Bid, HandScore)
+parseLine input = (head input', hand, bid, getHandScore hand)
+  where input' = splitOn " " input          :: [String]
+        hand = map charToCard (head input') :: [Int]
+        bid = read $ last input'            :: Bid
+
+mapForP2 :: (Int, String, Hand, Bid, HandScore) -> (String, Hand, Bid, HandScore)
+mapForP2 (_, str, h1, bid, _) = (str, h2, bid, s2)
+  where h2 = map (\c -> if c == 11 then 1 else c) h1
+        s2 = getHandScoreP2 h2
+
+addRank :: [(String, Hand, Bid, HandScore)] -> [(Int, String, Hand, Bid, HandScore)]
+addRank entries = map (\(rank, (str, hand, bid, score)) -> (rank, str, hand, bid, score)) entriesWithRank
+  where entriesWithRank = zip [1..] sortedEntries
+        sortedEntries = sortBy (\(_, _, _, s1) (_, _, _, s2) -> compare s1 s2) entries 
+
+day07 :: IO ()
+day07 = do
+  putStrLn "AOC 2023 day 07"
+  input <- getContents
+  let hands = addRank $ map parseLine $ lines input
+  let resP1 = sum $ map (\(rank, _, _, bid, _) -> rank * bid) hands
+  putStrLn "Part1"
+  print resP1
+  let handP2 = addRank $ map mapForP2 hands
+  putStrLn "Part2"
+  mapM_ print handP2
+  let resP2 = sum $ map (\(rank, _, _, bid, _) -> rank * bid) handP2
+  print resP2
--- a/AOC2023/src/Day08.hs
+++ b/AOC2023/src/Day08.hs
@@ -0,0 +1,47 @@
+module Day08 (day08) where
+
+import Debug.Trace (trace)
+
+import qualified Data.Map.Strict as M
+
+import Data.List.Split (splitOn)
+import Data.Maybe (fromJust)
+
+parseLine :: String -> (String, (String, String))
+parseLine input = (from, (toleft, toright))
+  where from = take 3 input
+        toleft = take 3 . drop 7 $ input
+        toright = take 3 . drop 12 $ input
+
+walkP1 :: M.Map String (String, String) -> String -> Int -> String -> Int
+walkP1 theMap (curDir:nextDir) c curZone
+  | curZone == "ZZZ" = c
+  | curDir == 'L' = walkP1 theMap nextDir (c + 1) toLeft
+  | curDir == 'R' = walkP1 theMap nextDir (c + 1) toRight
+  where Just(toLeft, toRight) = M.lookup curZone theMap
+
+walkP2 :: M.Map String (String, String) -> String -> Int -> [String] -> Int
+walkP2 theMap (curDir:nextDir) c curZones
+  | all endWithZ curZones = c
+  | curDir == 'L' = walkP2 theMap nextDir (c + 1) $ map goToLeft curZones
+  | curDir == 'R' = walkP2 theMap nextDir (c + 1) $ map goToRight curZones
+  where endWithZ s = last s == 'Z'
+        goToLeft z = fst $ fromJust $ M.lookup z theMap
+        goToRight z = snd $ fromJust $ M.lookup z theMap
+
+day08 :: IO ()
+day08 = do
+  putStrLn "AOC 2023 day 08"
+  input <- getContents
+  let inputParts = splitOn "\n\n" input
+  let moveSequence = cycle $ head inputParts
+  let theMap = M.fromList $ map parseLine $ lines $ last inputParts
+  print $ take 10 moveSequence
+  print theMap
+  putStrLn "Part1"
+  let resP1 = walkP1 theMap moveSequence 0 "AAA"
+  print resP1
+  putStrLn "Part2"
+  let entranceP2 = filter (\s -> last s == 'A') $ M.keys theMap
+  let resP2 = walkP2 theMap moveSequence 0 entranceP2
+  print resP2
--- a/AOC2023/src/Day09.hs
+++ b/AOC2023/src/Day09.hs
@@ -0,0 +1,39 @@
+module Day09 (day09) where
+
+import Data.List.Split (splitOn)
+
+parseLine :: String -> [Int]
+parseLine i = map read $ splitOn " " i
+
+getDifferences :: [Int] -> [Int]
+getDifferences [] = []
+getDifferences [_] = []
+getDifferences (h:t@(th:_)) = (th - h) : getDifferences t
+
+listIsZeros :: [Int] -> Bool
+listIsZeros = all (== 0)
+
+getIterations :: [Int] -> [[Int]]
+getIterations a = takeWhile (not . listIsZeros) $ iterate getDifferences a
+
+getNextItem :: [Int] -> Int -> Int
+getNextItem l incr = last l + incr
+
+getNextItems :: [[Int]] -> Int
+getNextItems = foldr getNextItem 0
+
+getPrevItem :: [Int] -> Int -> Int
+getPrevItem l incr = head l - incr
+
+getPrevItems :: [[Int]] -> Int
+getPrevItems = foldr getPrevItem 0
+
+day09 :: IO ()
+day09 = do
+  putStrLn "AOC 2023 day 09"
+  input <- getContents
+  let input' = map parseLine $ lines input
+  putStrLn "Part1"
+  print $ sum $ map (getNextItems . getIterations) input'
+  putStrLn "Part2"
+  print $ sum $ map (getPrevItems . getIterations) input'
--- a/AOC2023/src/Day10.hs
+++ b/AOC2023/src/Day10.hs
@@ -0,0 +1,87 @@
+module Day10 (day10) where
+
+import Debug.Trace (trace)
+
+
+pos2xy :: Int -> Int -> (Int, Int)
+pos2xy width pos = (curX, curY)
+  where curX   = mod pos width
+        curY   = pos `div` width
+
+xy2pos :: Int -> (Int, Int) -> Int
+xy2pos width (x, y) = x + width * y
+
+getNeighbors :: (Int, Int) -> Int -> [Int]
+getNeighbors (w, h) p = map (xy2pos w) $ filter (\(x', y') -> x' >= 0 && x' < (w - 1) && y' >= 0 && y' < h) candidates
+  where candidates = [(x, y - 1), (x - 1, y), (x + 1, y), (x, y + 1)]
+        p' = pos2xy w p
+        x = fst p'
+        y = snd p'
+
+getStartPos :: String -> Int
+getStartPos input = head sPos
+  where charPos = zip input [0..]
+        sPos = map snd $ filter (\(c, _) -> c == 'S') charPos
+
+computeDiff :: (Int, Int) -> (Int, Int) -> (Int, Int)
+computeDiff (x1, y1) (x2, y2) = (x2 - x1, y2 - y1)
+
+opening :: Char -> (Int, Int) -> Bool
+opening 'S' _ = True
+opening 'F' (1, 0) = True
+opening 'F' (0, 1) = True
+opening 'L' (1, 0) = True
+opening 'L' (0, -1) = True
+opening 'J' (-1, 0) = True
+opening 'J' (0, -1) = True
+opening '7' (-1, 0) = True
+opening '7' (0, 1) = True
+opening '-' (_, 0) = True
+opening '|' (0, _) = True
+opening _ _ = False
+
+walkable :: String -> Int -> Int -> Bool
+walkable mapData curPos destPos
+  | destChar == '.' = False
+  | otherwise = canLeaveCur && canArriveTo
+  where lined       = lines mapData
+        width       = 1 + length (head lined)
+        curChar     = mapData !! curPos
+        destChar    = mapData !! destPos
+        dirFrom     = computeDiff (pos2xy width curPos) (pos2xy width destPos)
+        dirTo       = computeDiff (pos2xy width destPos) (pos2xy width curPos)
+        canLeaveCur = opening curChar dirFrom
+        canArriveTo = opening destChar dirTo
+
+getWalkableNeighbors :: String -> Int -> [Int]
+getWalkableNeighbors mapData pos = filter (walkable mapData pos) $ getNeighbors (mapWidth, mapHeight) pos
+  where lined     = lines mapData
+        mapWidth  = 1 + length (head lined)
+        mapHeight = length lined
+
+walkNode :: String -> ([(Int, Int)], [(Int, Int)]) -> ([(Int, Int)], [(Int, Int)])
+walkNode _ t@([], _) = t
+walkNode mapData (cur@(pos,distance):t, walked) = walkNode mapData (t ++ filteredWalkableNeighbors, cur:walked)
+  where walkableNeighbors = getWalkableNeighbors mapData pos
+        filteredWalkableNeighbors = map (\p -> (p, distance + 1)) $ filter (\p -> p `notElem` map fst (t ++ walked)) walkableNeighbors
+
+cleanInput :: [Int] -> [(Int, Char)] -> String
+cleanInput _ [] = []
+cleanInput ps ((_, '\n'):t) = '\n':cleanInput ps t
+cleanInput ps ((p, c):t)
+  | p `elem` ps = c:cleanInput ps t
+  | otherwise = ' ':cleanInput ps t
+
+day10 :: IO ()
+day10 = do
+  putStrLn "AOC 2023 day 10"
+  input <- getContents
+  putStrLn "Part1"
+  mapM_ print $ lines input
+  let startPos = getStartPos input
+  let (_, computedLoop) = walkNode input ([(startPos, 0)], [])
+  print $ snd $ head computedLoop
+  putStrLn "Part2"
+  let loopPos = map fst computedLoop
+  let cleaned = cleanInput loopPos (zip [0..] input)
+  mapM_ print $ lines cleaned
--- a/AOC2023/src/Day11.hs
+++ b/AOC2023/src/Day11.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE TupleSections #-}
+module Day11 (day11) where
+import Data.List (elemIndices)
+
+getRowsToExpand :: [String] -> [Int]
+getRowsToExpand input = filter (\i -> all (== '.') (input !! i)) [0..(length input - 1)]
+
+getColsToExpand :: [String] -> [Int]
+getColsToExpand input = filter (all (== '.') . byCol) [0..(length (head input) - 1)]
+  where byCol n = map (!! n) input
+
+getGalaxiesPos :: [String] -> [(Int, Int)]
+getGalaxiesPos input = concatMap getGalaxiesAtLine [0..(length input - 1)]
+  where getGalaxiesAtLine n = map (, n) (elemIndices '#' (input !! n))
+
+getPairs :: [a] -> [(a, a)]
+getPairs [] = []
+getPairs (h:t) = map (h,) t ++ getPairs t
+
+getDistance :: [Int] -> [Int] -> Int -> (Int, Int) -> (Int, Int) -> Int
+getDistance cols rows factor (x1, y1) (x2, y2) = abs (y2 - y1) + abs (x2 - x1) + ((rowsExpansion + colsExpansion) * factor)
+  where rowsExpansion = length $ filter (\i -> i > minimum [y1, y2] && i < maximum [y1, y2]) rows
+        colsExpansion = length $ filter (\i -> i > minimum [x1, x2] && i < maximum [x1, x2]) cols
+
+day11 :: IO ()
+day11 = do
+  putStrLn "AOC 2023 day 11"
+  input <- getContents
+  let input' = lines input
+  let colsToExpand = getColsToExpand input'
+  let rowsToExpand = getRowsToExpand input'
+  let galaxiesPos = getGalaxiesPos input'
+  let pairs = getPairs galaxiesPos
+  putStrLn "Part1"
+  print $ sum $ map (uncurry (getDistance colsToExpand rowsToExpand 1)) pairs
+  putStrLn "Part2"
+  print $ sum $ map (uncurry (getDistance colsToExpand rowsToExpand (1000000 - 1))) pairs
--- a/AOC2023/src/Day12.hs
+++ b/AOC2023/src/Day12.hs
@@ -0,0 +1,43 @@
+module Day12 (day12) where
+
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
+
+parseLine :: String -> (String, [Int])
+parseLine input = (head parts, parsedPart2)
+  where parts = splitOn " " input
+        parsedPart2 = map read (splitOn "," $ parts !! 1)
+
+computeLine :: String -> [Int]
+computeLine input = reverse $ snd $ foldl accumulate ('.', []) input
+  where accumulate (_, counts) '.' = ('.', counts)
+        accumulate ('#', h:t) '#' = ('#', h + 1:t)
+        accumulate (_, counts) '#' = ('#', 1:counts)
+        accumulate (_, counts) c = (c, counts)
+
+bruteforceQmarks :: String -> [String]
+bruteforceQmarks "" = [""]
+bruteforceQmarks ('?':t) = [ c:xs | c <- ['.', '#'], xs <- bruteforceQmarks t]
+bruteforceQmarks (h:t) = [ h:xs | xs <- bruteforceQmarks t]
+
+getPossibleEntries :: String -> [Int] -> [String]
+getPossibleEntries input check = filter ((== check) . computeLine) possibilities
+  where possibilities = bruteforceQmarks input
+
+adaptForP2 :: (String, [Int]) -> (String, [Int])
+adaptForP2 (str, check) = (repeatedStr, repeatedCheck)
+  where repeatedStr = intercalate "?" $ replicate 5 str
+        repeatedCheck = concat $ replicate 5 check
+
+day12 :: IO ()
+day12 = do
+  putStrLn "AOC 2023 day 12"
+  input <- getContents
+  let input' = map parseLine $ lines input
+  putStrLn "Part1"
+  let computedPossibilities = map (\(str, check) -> length (getPossibleEntries str check)) input'
+  print $ sum computedPossibilities
+  putStrLn "Part2"
+  let inputP2 = map adaptForP2 input'
+  let possP2 = map (\(str, check) -> length (getPossibleEntries str check)) inputP2
+  print $ sum possP2
--- a/AOC2023/src/Day13.hs
+++ b/AOC2023/src/Day13.hs
@@ -0,0 +1,9 @@
+module Day13 (day13) where
+
+day13 :: IO ()
+day13 = do
+  putStrLn "AOC 2023 day 13"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/src/Day14.hs
+++ b/AOC2023/src/Day14.hs
@@ -0,0 +1,9 @@
+module Day14 (day14) where
+
+day14 :: IO ()
+day14 = do
+  putStrLn "AOC 2023 day 14"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/src/Day15.hs
+++ b/AOC2023/src/Day15.hs
@@ -0,0 +1,9 @@
+module Day15 (day15) where
+
+day15 :: IO ()
+day15 = do
+  putStrLn "AOC 2023 day 15"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/src/Day16.hs
+++ b/AOC2023/src/Day16.hs
@@ -0,0 +1,9 @@
+module Day16 (day16) where
+
+day16 :: IO ()
+day16 = do
+  putStrLn "AOC 2023 day 16"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/src/Day17.hs
+++ b/AOC2023/src/Day17.hs
@@ -0,0 +1,8 @@
+module Day17 (day17) where
+
+day17 :: IO ()
+day17 = do
+  putStrLn "AOC 2023 day 17"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
--- a/AOC2023/src/Day18.hs
+++ b/AOC2023/src/Day18.hs
@@ -0,0 +1,8 @@
+module Day18 (day18) where
+
+day18 :: IO ()
+day18 = do
+  putStrLn "AOC 2023 day 18"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
--- a/AOC2023/src/Day19.hs
+++ b/AOC2023/src/Day19.hs
@@ -0,0 +1,9 @@
+module Day19 (day19) where
+
+day19 :: IO ()
+day19 = do
+  putStrLn "AOC 2023 day 19"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/src/Day20.hs
+++ b/AOC2023/src/Day20.hs
@@ -0,0 +1,9 @@
+module Day20 (day20) where
+
+day20 :: IO ()
+day20 = do
+  putStrLn "AOC 2023 day 20"
+  input <- getContents
+  putStrLn "Part1"
+  putStrLn "Part2"
+  
--- a/AOC2023/stack.yaml
+++ b/AOC2023/stack.yaml
@@ -0,0 +1,67 @@
+# 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-21.13
+# resolver: nightly-2023-09-24
+# resolver: ghc-9.6.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/2023-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.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: []
+
+# 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.13"
+#
+# 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
--- a/AOC2023/stack.yaml.lock
+++ b/AOC2023/stack.yaml.lock
@@ -0,0 +1,13 @@
+# 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: []
+snapshots:
+- completed:
+    sha256: afd5ba64ab602cabc2d3942d3d7e7dd6311bc626dcb415b901eaf576cb62f0ea
+    size: 640060
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.yaml
+  original:
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.yaml
--- a/AOC2023/test/Spec.hs
+++ b/AOC2023/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"