From fb40454939d0a45a9d1915053bd1f2fa78d4ac77 Mon Sep 17 00:00:00 2001 From: Jordan Doyle Date: Sun, 10 Dec 2023 00:29:27 +0000 Subject: [PATCH] Add 2022 day 1 --- .gitignore | 1 + 1.hs | 68 -------------------------------------------------------------------- 2.hs | 84 ------------------------------------------------------------------------------------ 2022/1/default.nix | 17 +++++++++++++++++ 2022/1/main.f90 | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/1.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/2.hs | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/3.hs | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/4.hs | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/5.rs | 257 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/6.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/7.hs | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/8.hs | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2023/9.hs | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3.hs | 87 --------------------------------------------------------------------------------------- 4.hs | 81 --------------------------------------------------------------------------------- 5.rs | 257 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 6.hs | 53 ----------------------------------------------------- 7.hs | 115 ------------------------------------------------------------------------------------------------------------------- 8.hs | 90 ------------------------------------------------------------------------------------------ 9.hs | 76 ---------------------------------------------------------------------------- 21 files changed, 1019 insertions(+), 911 deletions(-) create mode 100644 .gitignore delete mode 100755 1.hs delete mode 100755 2.hs create mode 100644 2022/1/default.nix create mode 100644 2022/1/main.f90 create mode 100755 2023/1.hs create mode 100755 2023/2.hs create mode 100755 2023/3.hs create mode 100755 2023/4.hs create mode 100755 2023/5.rs create mode 100755 2023/6.hs create mode 100755 2023/7.hs create mode 100755 2023/8.hs create mode 100755 2023/9.hs delete mode 100755 3.hs delete mode 100755 4.hs delete mode 100755 5.rs delete mode 100755 6.hs delete mode 100755 7.hs delete mode 100755 8.hs delete mode 100755 9.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b2be92b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +result diff --git a/1.hs b/1.hs deleted file mode 100755 index 1676ab4..0000000 --- a/1.hs +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" -import Data.List (find, isInfixOf) -import Data.Maybe (catMaybes) - -{- https://adventofcode.com/2023/day/1 -} - -main = print =<< run 0 - --- recursively read each line from stdin, concatenating first and last digits and folding the result into a sum -run :: Int -> IO Int -run acc = do - line <- getLine - if null line - then return acc - else do - let x = concatFirstLastDigitsInString line - run $ acc + x - --- read first and last digit in a string and concatenate the two together -concatFirstLastDigitsInString :: String -> Int -concatFirstLastDigitsInString s = - case catMaybes [findDigitFromLeft "" s, findDigitFromRight "" s] of - [x, y] -> x * 10 + y - [x] -> x * 11 - _ -> 0 - --- find the first digit in the string, searching from the left hand side -findDigitFromLeft :: String -> String -> Maybe Int -findDigitFromLeft acc "" = findDigit acc -findDigitFromLeft acc (x : xs) = case findDigit acc of - Just v -> Just v - Nothing -> findDigitFromLeft (acc ++ [x]) xs - --- find the last digit in the string, searching from the right hand side -findDigitFromRight :: String -> String -> Maybe Int -findDigitFromRight acc "" = findDigit acc -findDigitFromRight acc xs = case findDigit acc of - Just v -> Just v - Nothing -> findDigitFromRight (last xs : acc) (init xs) - --- finds a digit in either textual or numeric form and returns it as an int -findDigit :: String -> Maybe Int -findDigit s = case find (`isInfixOf` s) digitAsText of - Just textual -> lookup textual digitMap - Nothing -> Nothing - where - digitMap = - [ ("eight", 8), - ("seven", 7), - ("three", 3), - ("nine", 9), - ("four", 4), - ("five", 5), - ("two", 2), - ("one", 1), - ("six", 6), - ("1", 1), - ("2", 2), - ("3", 3), - ("4", 4), - ("5", 5), - ("6", 6), - ("7", 7), - ("8", 8), - ("9", 9) - ] - digitAsText = map fst digitMap diff --git a/2.hs b/2.hs deleted file mode 100755 index 68ba85b..0000000 --- a/2.hs +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Control.Applicative ((<*)) -import Data.Map (Map, elems, fromListWith) -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -{- https://adventofcode.com/2023/day/2 -} - -main = do - input <- getContents - case parseString input of - Left err -> print err - Right games -> do - part1PrintValidGamesMaxCubes games - part2PrintMinimumRequiredCubes games - --- print the sum of game ids that can be played with `cubesAllowed` cubes -part1PrintValidGamesMaxCubes :: [Game] -> IO () -part1PrintValidGamesMaxCubes games = do - print $ sum $ map gameId (filter checkGameIsValid games) - --- print the sum of the "power" required to play each game (which is just the product of max(amount) per colour) -part2PrintMinimumRequiredCubes :: [Game] -> IO () -part2PrintMinimumRequiredCubes games = do - print $ sum $ map (product . elems . getMinimumCubesRequiredForGame) games - --- fold every round in a game into map where string is a colour and int is the max cubes for the colour -getMinimumCubesRequiredForGame :: Game -> Map String Int -getMinimumCubesRequiredForGame game = fromListWith max $ concat (rounds game) - --- check if every colourset pulled within a game is within the bounds of `cubesAllowed` -checkGameIsValid :: Game -> Bool -checkGameIsValid game = all (all isCubeAmountAllowed) (rounds game) - --- check if the given colour, amount tuple is within the allowed range -isCubeAmountAllowed :: (String, Int) -> Bool -isCubeAmountAllowed (colour, amount) = amount <= cubesAllowed colour - --- consts set by the task -cubesAllowed "red" = 12 -cubesAllowed "green" = 13 -cubesAllowed "blue" = 14 -cubesAllowed _ = 0 - -data Game = Game - { gameId :: Int, - rounds :: [[(String, Int)]] - } - deriving (Show) - --- parse `Game [n]: [n] [colour], [n] [colour], ...; [n] [colour]; Game [n]...` -parseString :: String -> Either ParseError [Game] -parseString = parse fullParser "" - -fullParser :: Parser [Game] -fullParser = gameParser `sepBy` char '\n' - --- parse a single game -gameParser :: Parser Game -gameParser = do - _ <- string "Game " - gameId <- many1 digit <* char ':' <* spaces - rounds <- roundParser `sepBy` (char ';' <* spaces) - - return - Game - { gameId = read gameId, - rounds - } - --- parse all the colour, count tuples in a given round -roundParser :: Parser [(String, Int)] -roundParser = cubeNumberParser `sepBy` (char ',' <* spaces) - --- parse a single colour, count tuple -cubeNumberParser :: Parser (String, Int) -cubeNumberParser = do - amount <- many1 digit <* spaces - colour <- many1 letter - return (colour, read amount) diff --git a/2022/1/default.nix b/2022/1/default.nix new file mode 100644 index 0000000..9916b23 --- /dev/null +++ b/2022/1/default.nix @@ -0,0 +1,17 @@ +{ pkgs ? import {} }: + +pkgs.stdenv.mkDerivation { + name = "aoc-2022-1"; + buildInputs = [ pkgs.gfortran ]; + + src = ./.; + + buildPhase = '' + gfortran -o aoc-2022-1 main.f90 + ''; + + installPhase = '' + mkdir -p $out/bin + cp aoc-2022-1 $out/bin/ + ''; +} diff --git a/2022/1/main.f90 b/2022/1/main.f90 new file mode 100644 index 0000000..7b415e5 --- /dev/null +++ b/2022/1/main.f90 @@ -0,0 +1,90 @@ +program day_1 + implicit none + integer, dimension(300, 20) :: result + integer, dimension(300) :: summed + integer :: eof, i, out, size + integer, external :: top3 + + eof = 0 + result = 0 + i = 0 + + ! read every block of ints from stdin + do + i = i + 1 + if (i > 300) then + print *, 'Main read overflow: more than 300 entries read.' + exit + end if + + call read_block(result(i, :), eof) + if (eof /= 0) exit + end do + + ! sum results + summed = sum(result, dim=2) + + ! print results + print *, 'Part 1: ', maxval(summed) + print *, 'Part 2: ', top3(summed) +end program day_1 + +! loops over entire input and returns the top 3 values from it +function top3(input) result(retval) + implicit none + integer, dimension(300), intent(in) :: input + integer, dimension(3) :: topValues + integer :: i, j, k, retval + + retval = 0 + topValues = 0 + + do i = 1, 300 + do j = 1, 3 + if (input(i) > topValues(j)) then + topValues(j) = input(i) + exit + end if + end do + end do + + retval = sum(topValues) +end function top3 + +! reads a single block of integers delimited by an empty line and returns +subroutine read_block(result, eof) + implicit none + integer, dimension(20), intent(out) :: result + integer, intent(out) :: eof + integer :: iostatus, n, parsedCalories + character(len=10) :: line + + result = 0 + n = 0 + eof = 0 + parsedCalories = 0 + + do + read (*, '(A)', iostat=iostatus) line + if (iostatus /= 0) then + eof = iostatus + exit + else if (trim(line) == '') then + exit + end if + + read (line, '(I8)', iostat=iostatus) parsedCalories + if (iostatus /= 0) then + print *, 'Conversion error with iostat = ', iostatus + exit + end if + + n = n + 1 + if (n > 20) then + print *, 'Read block overflow: more than 20 entries read.' + exit + end if + + result(n) = parsedCalories + end do +end subroutine read_block diff --git a/2023/1.hs b/2023/1.hs new file mode 100755 index 0000000..1676ab4 --- /dev/null +++ b/2023/1.hs @@ -0,0 +1,68 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" +import Data.List (find, isInfixOf) +import Data.Maybe (catMaybes) + +{- https://adventofcode.com/2023/day/1 -} + +main = print =<< run 0 + +-- recursively read each line from stdin, concatenating first and last digits and folding the result into a sum +run :: Int -> IO Int +run acc = do + line <- getLine + if null line + then return acc + else do + let x = concatFirstLastDigitsInString line + run $ acc + x + +-- read first and last digit in a string and concatenate the two together +concatFirstLastDigitsInString :: String -> Int +concatFirstLastDigitsInString s = + case catMaybes [findDigitFromLeft "" s, findDigitFromRight "" s] of + [x, y] -> x * 10 + y + [x] -> x * 11 + _ -> 0 + +-- find the first digit in the string, searching from the left hand side +findDigitFromLeft :: String -> String -> Maybe Int +findDigitFromLeft acc "" = findDigit acc +findDigitFromLeft acc (x : xs) = case findDigit acc of + Just v -> Just v + Nothing -> findDigitFromLeft (acc ++ [x]) xs + +-- find the last digit in the string, searching from the right hand side +findDigitFromRight :: String -> String -> Maybe Int +findDigitFromRight acc "" = findDigit acc +findDigitFromRight acc xs = case findDigit acc of + Just v -> Just v + Nothing -> findDigitFromRight (last xs : acc) (init xs) + +-- finds a digit in either textual or numeric form and returns it as an int +findDigit :: String -> Maybe Int +findDigit s = case find (`isInfixOf` s) digitAsText of + Just textual -> lookup textual digitMap + Nothing -> Nothing + where + digitMap = + [ ("eight", 8), + ("seven", 7), + ("three", 3), + ("nine", 9), + ("four", 4), + ("five", 5), + ("two", 2), + ("one", 1), + ("six", 6), + ("1", 1), + ("2", 2), + ("3", 3), + ("4", 4), + ("5", 5), + ("6", 6), + ("7", 7), + ("8", 8), + ("9", 9) + ] + digitAsText = map fst digitMap diff --git a/2023/2.hs b/2023/2.hs new file mode 100755 index 0000000..68ba85b --- /dev/null +++ b/2023/2.hs @@ -0,0 +1,84 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Control.Applicative ((<*)) +import Data.Map (Map, elems, fromListWith) +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +{- https://adventofcode.com/2023/day/2 -} + +main = do + input <- getContents + case parseString input of + Left err -> print err + Right games -> do + part1PrintValidGamesMaxCubes games + part2PrintMinimumRequiredCubes games + +-- print the sum of game ids that can be played with `cubesAllowed` cubes +part1PrintValidGamesMaxCubes :: [Game] -> IO () +part1PrintValidGamesMaxCubes games = do + print $ sum $ map gameId (filter checkGameIsValid games) + +-- print the sum of the "power" required to play each game (which is just the product of max(amount) per colour) +part2PrintMinimumRequiredCubes :: [Game] -> IO () +part2PrintMinimumRequiredCubes games = do + print $ sum $ map (product . elems . getMinimumCubesRequiredForGame) games + +-- fold every round in a game into map where string is a colour and int is the max cubes for the colour +getMinimumCubesRequiredForGame :: Game -> Map String Int +getMinimumCubesRequiredForGame game = fromListWith max $ concat (rounds game) + +-- check if every colourset pulled within a game is within the bounds of `cubesAllowed` +checkGameIsValid :: Game -> Bool +checkGameIsValid game = all (all isCubeAmountAllowed) (rounds game) + +-- check if the given colour, amount tuple is within the allowed range +isCubeAmountAllowed :: (String, Int) -> Bool +isCubeAmountAllowed (colour, amount) = amount <= cubesAllowed colour + +-- consts set by the task +cubesAllowed "red" = 12 +cubesAllowed "green" = 13 +cubesAllowed "blue" = 14 +cubesAllowed _ = 0 + +data Game = Game + { gameId :: Int, + rounds :: [[(String, Int)]] + } + deriving (Show) + +-- parse `Game [n]: [n] [colour], [n] [colour], ...; [n] [colour]; Game [n]...` +parseString :: String -> Either ParseError [Game] +parseString = parse fullParser "" + +fullParser :: Parser [Game] +fullParser = gameParser `sepBy` char '\n' + +-- parse a single game +gameParser :: Parser Game +gameParser = do + _ <- string "Game " + gameId <- many1 digit <* char ':' <* spaces + rounds <- roundParser `sepBy` (char ';' <* spaces) + + return + Game + { gameId = read gameId, + rounds + } + +-- parse all the colour, count tuples in a given round +roundParser :: Parser [(String, Int)] +roundParser = cubeNumberParser `sepBy` (char ',' <* spaces) + +-- parse a single colour, count tuple +cubeNumberParser :: Parser (String, Int) +cubeNumberParser = do + amount <- many1 digit <* spaces + colour <- many1 letter + return (colour, read amount) diff --git a/2023/3.hs b/2023/3.hs new file mode 100755 index 0000000..b3a1d06 --- /dev/null +++ b/2023/3.hs @@ -0,0 +1,87 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" +import Data.Char (isNumber) +import Data.List (findIndices) + +{- https://adventofcode.com/2023/day/3 -} + +main = do + input <- getContents + let (schematics, symbols) = takeSymbols input + print $ sum $ part1FindNumbersAdjacentToSchematic schematics symbols + print $ sum $ map product $ part2FindGearPartNumbers schematics symbols + +-- find all the part numbers (schematics that are adjacent to a symbol) +part1FindNumbersAdjacentToSchematic :: [Schematic] -> [Symbol] -> [Int] +part1FindNumbersAdjacentToSchematic schematics symbols = map partNumber $ filter (isSchematicAdjacentToAnySymbol symbols) schematics + +-- find all part numbers for gears (schematics that are adjacent to exactly two symbols) +part2FindGearPartNumbers :: [Schematic] -> [Symbol] -> [[Int]] +part2FindGearPartNumbers schematics symbols = map (map partNumber) $ filter (\inner -> length inner == 2) $ map (findSchematicsAdjacentToSymbol schematics) symbols + +-- returns all schematics that are adjacent to the given symbol +findSchematicsAdjacentToSymbol :: [Schematic] -> Symbol -> [Schematic] +findSchematicsAdjacentToSymbol schematics symbol = filter (`isSchematicAdjacent` symbol) schematics + +-- returns true, if the given schematic is adjacent to any of the given symbols +isSchematicAdjacentToAnySymbol :: [Symbol] -> Schematic -> Bool +isSchematicAdjacentToAnySymbol symbol schematic = any (isSchematicAdjacent schematic) symbol + +-- returns true, if the given schematic is directly adjacent to the given symbol +isSchematicAdjacent :: Schematic -> Symbol -> Bool +isSchematicAdjacent sc sy = isAdjacent (symbolCoords sy) (schematicCoords sc) + +-- returns true, grid position (px, py) is adjacent to single height multi column grid position (rx, ry, width) +isAdjacent :: (Int, Int) -> (Int, Int, Int) -> Bool +isAdjacent (px, py) (rx, ry, width) = + let leftX = rx + rightX = rx + width - 1 + upperY = ry + 1 + lowerY = ry - 1 + in (px >= leftX - 1 && px <= rightX + 1 && py == ry) -- adjacent horizontally + || (py == upperY || py == lowerY) && (px >= leftX && px <= rightX) -- adjacent vertically + || (px == leftX - 1 || px == rightX + 1) && (py == upperY || py == lowerY) -- adjacent diagonally + +data Schematic = Schematic + { partNumber :: Int, + schematicCoords :: (Int, Int, Int) + } + deriving (Show) + +data Symbol = Symbol + { symbolCoords :: (Int, Int), + symbolType :: Char + } + deriving (Show) + +-- parse the entire input +takeSymbols :: String -> ([Schematic], [Symbol]) +takeSymbols input = takeSymbol input Nothing (0, 0) [] [] + +-- recursively parses the input character by character +takeSymbol :: String -> Maybe Schematic -> (Int, Int) -> [Schematic] -> [Symbol] -> ([Schematic], [Symbol]) +takeSymbol "" Nothing _ schematicAcc symbolAcc = (schematicAcc, symbolAcc) +takeSymbol "" (Just inProgressSchematic) _ schematicAcc symbolAcc = (schematicAcc ++ [inProgressSchematic], symbolAcc) +takeSymbol (x : xs) inProgressSchematic (posX, posY) schematicAcc symbolAcc = + case x of + _ | isNumber x -> takeSymbol xs (Just $ appendToSchematic inProgressSchematic (posX, posY) (read [x])) (posX + 1, posY) schematicAcc symbolAcc + '.' -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) symbolAcc + '\n' -> takeSymbol xs Nothing (0, posY + 1) (maybeAppend schematicAcc inProgressSchematic) symbolAcc + _ -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) (symbolAcc ++ [buildSymbol posX posY x]) + +-- appends a character to the schematic, creating a new schematic if one isn't already instantiated +appendToSchematic :: Maybe Schematic -> (Int, Int) -> Int -> Schematic +appendToSchematic (Just schematic) _ c = + let (x, y, n) = schematicCoords schematic + currPartNumber = partNumber schematic + in schematic {partNumber = currPartNumber * 10 + c, schematicCoords = (x, y, n + 1)} +appendToSchematic Nothing (x, y) c = Schematic {partNumber = c, schematicCoords = (x, y, 1)} + +-- append a Maybe Schematic to [Schematic] +maybeAppend :: [Schematic] -> Maybe Schematic -> [Schematic] +maybeAppend out (Just new) = out ++ [new] +maybeAppend out Nothing = out + +-- easy constructor for a Symbol +buildSymbol :: Int -> Int -> Char -> Symbol +buildSymbol x y symbolType = Symbol {symbolCoords = (x, y), symbolType} diff --git a/2023/4.hs b/2023/4.hs new file mode 100755 index 0000000..28339ac --- /dev/null +++ b/2023/4.hs @@ -0,0 +1,81 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Data.List (intersect) +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +{- https://adventofcode.com/2023/day/4 -} + +main = do + cards <- readAndParseStdin [] + print $ part1 cards + print $ part2 cards + +-- sum up amount of winning numbers using the part1Score formula +part1 :: [Card] -> Int +part1 cards = sum $ map (score . length . getWinningNumbers) cards + where + score 0 = 0 + score n = 2 ^ (n - 1) + +-- calculates number of cards won in part 2 of the task +part2 :: [Card] -> Int +part2 cards = sum $ calculateCardCopies $ map (length . getWinningNumbers) cards + +-- starts with a base array of [1; n] and replicates Ns right for each `getWinningNumbers` +-- where N is the amount of card replicas +calculateCardCopies :: [Int] -> [Int] +calculateCardCopies xs = foldl replicateSingleCardWinnings (replicate (length xs) 1) (zip [0 ..] xs) + +-- helper function for calling `copyCards` within `foldl` +replicateSingleCardWinnings :: [Int] -> (Int, Int) -> [Int] +replicateSingleCardWinnings cardReplicas (idx, winningNumbers) = copyCards cardReplicas (idx + 1) idx winningNumbers + +-- copies N cards to `winningNumbers` elements right of `winningCardIdx` where N is `cardReplicas[winningCardIdx]` +copyCards :: [Int] -> Int -> Int -> Int -> [Int] +copyCards cardReplicas currIdx winningCardIdx winningNumbers + | currIdx <= length cardReplicas && winningNumbers > 0 = + let incrementedList = incrementAtIndex cardReplicas currIdx (cardReplicas !! winningCardIdx) + in copyCards incrementedList (currIdx + 1) winningCardIdx (winningNumbers - 1) + | otherwise = cardReplicas + +-- takes a list, an index and an amount to increment by +incrementAtIndex :: [Int] -> Int -> Int -> [Int] +incrementAtIndex xs idx amount = take idx xs ++ [(xs !! idx) + amount] ++ drop (idx + 1) xs + +-- gets the intersection of winning numbers and player numbers +getWinningNumbers :: Card -> [Int] +getWinningNumbers card = myNumbers card `intersect` winningNumbers card + +data Card = Card + { winningNumbers :: [Int], + myNumbers :: [Int] + } + deriving (Show) + +-- reads entirety of stdin and parses each line +readAndParseStdin :: [Card] -> IO [Card] +readAndParseStdin acc = do + line <- getLine + if null line + then return acc + else case parse cardParser "" line of + Left parseError -> error $ show parseError + Right card -> readAndParseStdin $ acc ++ [card] + +-- parses a `Card [i]: [n1] [n2] [n3] | [n4] [n5] [n6]` line +cardParser :: Parser Card +cardParser = do + _ <- string "Card" <* spaces <* many1 digit <* char ':' <* spaces + winningNumbers <- numberParser + _ <- char '|' <* spaces + myNumbers <- numberParser + + return Card {winningNumbers, myNumbers} + +-- reads a single number delimited by spaces +numberParser :: Parser [Int] +numberParser = map read <$> many1 digit `endBy` spaces diff --git a/2023/5.rs b/2023/5.rs new file mode 100755 index 0000000..65839c4 --- /dev/null +++ b/2023/5.rs @@ -0,0 +1,257 @@ +#!/usr/bin/env nix-shell +//! ```cargo +//! [dependencies] +//! rangemap = "1.4" +//! strum = { version = "0.25", features = ["derive"] } +//! nom = "7" +//! itertools = "0.12" +//! ``` +/* +#!nix-shell -i rust-script -p rustc -p rust-script -p cargo +*/ + +use itertools::Itertools; +use nom::IResult; +use rangemap::RangeMap; +use std::{collections::HashMap, io::Read, ops::Range, str::FromStr, time::Instant}; + +const TRANSLATION_PATH: &[MapKind] = &[ + MapKind::Soil, + MapKind::Fertilizer, + MapKind::Water, + MapKind::Light, + MapKind::Temperature, + MapKind::Humidity, + MapKind::Location, +]; + +fn main() { + let mut input = Vec::new(); + std::io::stdin().lock().read_to_end(&mut input).unwrap(); + let input = std::str::from_utf8(&input).unwrap(); + + let (rest, input) = parse_input(input).unwrap(); + assert!(rest.is_empty()); + + let i = Instant::now(); + let answer = part1(&input); + eprintln!("part 1: {answer} ({:?})", i.elapsed()); + + let i = Instant::now(); + let answer = part2(&input); + eprintln!("part 2: {answer} ({:?})", i.elapsed()); +} + +fn part1(input: &Input) -> u64 { + let mut lowest_location = u64::MAX; + + for seed in &input.seeds { + let mut source = *seed; + let mut from = MapKind::Seed; + + for to in TRANSLATION_PATH { + let Some(translation) = input.maps.get(&Translation { from, to: *to }) else { + panic!("invalid path {from:?} to {to:?}"); + }; + + if let Some((source_range, destination_base)) = translation.get_key_value(&source) { + source = destination_base + (source - source_range.start); + } + + from = *to; + } + + assert_eq!(from, MapKind::Location); + lowest_location = lowest_location.min(source); + } + + lowest_location +} + +fn part2(input: &Input) -> u64 { + let seed_ranges: Vec<_> = input + .seeds + .iter() + .tuples() + .map(|(start, len)| (*start)..(*start) + len) + .collect(); + + let mut lowest_bound_seen = u64::MAX; + + for seed_range in seed_ranges { + let lowest_for_seed = traverse_path(input, TRANSLATION_PATH, MapKind::Seed, seed_range); + lowest_bound_seen = lowest_bound_seen.min(lowest_for_seed); + } + + lowest_bound_seen +} + +fn traverse_path(input: &Input, path: &[MapKind], from: MapKind, source_range: Range) -> u64 { + let mut lowest_bound_seen = u64::MAX; + + let Some((next_path, rest)) = path.split_first() else { + return source_range.start; + }; + + let Some(translation) = input.maps.get(&Translation { + from, + to: *next_path, + }) else { + panic!("invalid path {from:?} to {next_path:?}"); + }; + + for (new_source_range, destination_base) in translation.overlapping(&source_range) { + // determine intersection between the source range and destination range + let start = source_range.start.max(new_source_range.start); + let end = source_range.end.min(new_source_range.end); + let offset = start.saturating_sub(new_source_range.start); + let length = end.saturating_sub(start); + + let destination_range = (*destination_base + offset)..(*destination_base + offset + length); + + let lowest_in_tree = traverse_path(input, rest, *next_path, destination_range); + + lowest_bound_seen = lowest_bound_seen.min(lowest_in_tree); + } + + // traverse any uncovered sources, which the spec allows us to use our + // destination number directly for + for uncovered_range in split_range( + source_range.clone(), + translation + .overlapping(&source_range) + .map(|v| v.0.clone()) + .collect(), + ) { + let current_range = traverse_path(input, rest, *next_path, uncovered_range); + lowest_bound_seen = lowest_bound_seen.min(current_range); + } + + lowest_bound_seen +} + +/// Splits `main_range` into multiple ranges not covered by `ranges`. +fn split_range(main_range: Range, mut ranges: Vec>) -> Vec> { + let mut non_intersecting_ranges = Vec::new(); + let mut current_start = main_range.start; + + ranges.sort_by_key(|r| r.start); + + for range in ranges { + if range.start > current_start { + non_intersecting_ranges.push(current_start..range.start); + } + + if range.end > current_start { + current_start = range.end; + } + } + + if current_start < main_range.end { + non_intersecting_ranges.push(current_start..main_range.end); + } + + non_intersecting_ranges +} + +#[derive(strum::EnumString, Copy, Clone, Debug, Hash, PartialEq, Eq)] +#[strum(serialize_all = "kebab-case")] +enum MapKind { + Seed, + Soil, + Fertilizer, + Water, + Light, + Temperature, + Humidity, + Location, +} + +#[derive(Debug, Hash, Copy, Clone, PartialEq, Eq)] +struct Translation { + from: MapKind, + to: MapKind, +} + +impl From<(MapKind, MapKind)> for Translation { + fn from((from, to): (MapKind, MapKind)) -> Self { + Self { from, to } + } +} + +#[derive(Debug)] +struct Input { + seeds: Vec, + maps: HashMap>, +} + +/// parse entire input +fn parse_input(rest: &str) -> IResult<&str, Input> { + use nom::{ + bytes::complete::tag, character::complete::digit1, combinator::map_res, + multi::separated_list1, sequence::delimited, + }; + + let (rest, seeds) = delimited( + tag("seeds: "), + separated_list1(tag(" "), map_res(digit1, u64::from_str)), + tag("\n\n"), + )(rest)?; + let (rest, maps) = separated_list1(tag("\n"), parse_single_map)(rest)?; + + Ok(( + rest, + Input { + seeds, + maps: maps.into_iter().collect(), + }, + )) +} + +/// parse header along with each map line +fn parse_single_map(rest: &str) -> IResult<&str, (Translation, RangeMap)> { + use nom::multi::many1; + + let (rest, header) = parse_header(rest)?; + let (rest, lines) = many1(parse_map_line)(rest)?; + + Ok((rest, (header, lines.into_iter().collect()))) +} + +/// parse `803774611 641364296 1132421037` line +fn parse_map_line(rest: &str) -> IResult<&str, (Range, u64)> { + use nom::{ + branch::alt, + bytes::complete::tag, + character::complete::digit1, + combinator::{eof, map_res}, + sequence::terminated, + }; + + let (rest, destination) = terminated(map_res(digit1, u64::from_str), tag(" "))(rest)?; + let (rest, source) = terminated(map_res(digit1, u64::from_str), tag(" "))(rest)?; + let (rest, size) = terminated(map_res(digit1, u64::from_str), alt((tag("\n"), eof)))(rest)?; + + Ok((rest, (source..source + size, destination))) +} + +/// parse `seed-to-soil map:` line +fn parse_header(rest: &str) -> IResult<&str, Translation> { + use nom::{ + bytes::complete::{tag, take_until}, + combinator::{map, map_res}, + sequence::{separated_pair, terminated}, + }; + + map( + terminated( + separated_pair( + map_res(take_until("-"), MapKind::from_str), + tag("-to-"), + map_res(take_until(" "), MapKind::from_str), + ), + tag(" map:\n"), + ), + Translation::from, + )(rest) +} diff --git a/2023/6.hs b/2023/6.hs new file mode 100755 index 0000000..e16fcd0 --- /dev/null +++ b/2023/6.hs @@ -0,0 +1,53 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Control.Applicative ((<*)) +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +{- https://adventofcode.com/2023/day/6 -} + +main = do + game <- readAndParseStdin + print $ part1 game + print $ part2 game + +-- returns the product of how many winning times there are per game +part1 :: [(Int, Int)] -> Int +part1 = product . map (length . getWinningTimes) + where + getWinningTimes (time, winCond) = filter (> winCond) $ map (`distance` time) [1 .. time - 1] + +-- concatenates all games into one big game and returns how many winning times +-- there are in the big game +part2 :: [(Int, Int)] -> Int +part2 game = part1 [foldl concatenate (0, 0) game] + where + concatenate (tAcc, dAcc) (t, d) = (tAcc * scale t + t, dAcc * scale d + d) + +-- calculates the "scale" of a number + 1 and returns the magnitude ie. 8 -> 10, 23 -> 100, 694 -> 1000 +scale :: Int -> Int +scale n + | n < 10 = 10 + | otherwise = 10 * scale (n `div` 10) + +-- calculates distance travelled in a game based on velocity * time minus "button pressing time" +distance :: Int -> Int -> Int +distance v t = v * (t - v) + +-- reads stdin and parses game +readAndParseStdin :: IO [(Int, Int)] +readAndParseStdin = do + content <- getContents + case parse gameParser "" content of + Left parseError -> error $ show parseError + Right game -> return game + +-- parses `Time: [n1] [n2] [n3]\nDistance:[n4] [n5] [n6]` and returns `[(n1, n4), (n2, n5), (n3, n6)]` +gameParser :: Parser [(Int, Int)] +gameParser = do + time <- map read <$> (string "Time:" *> spaces *> many1 digit `endBy` spaces) + distance <- map read <$> (string "Distance:" *> spaces *> many1 digit `endBy` spaces) + return $ zip time distance diff --git a/2023/7.hs b/2023/7.hs new file mode 100755 index 0000000..a58dcca --- /dev/null +++ b/2023/7.hs @@ -0,0 +1,115 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Data.List +import Data.Ord +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +{- https://adventofcode.com/2023/day/7 -} + +main :: IO () +main = do + games <- readAndParseStdin + print $ part1 games + print $ part2 games + +-- sums the score of each game +part1 :: [Game] -> Int +part1 games = calcScore $ sortBy gameComparator games + where + gameComparator = comparing (Down . getHandStrength . groupCards . cards) <> comparing cards + +-- maps jacks to jokers (lowest scoring card, which can transmorph itself to the highest scoring group) +-- and sums the score of each game +part2 :: [Game] -> Int +part2 games = calcScore $ sortBy gameComparator $ mapAllJacksToJokers games + where + gameComparator = comparing (Down . getHandStrength . transmorphJokers . cards) <> comparing cards + +-- transforms every jack in a game to a joker +mapAllJacksToJokers :: [Game] -> [Game] +mapAllJacksToJokers = map (\game -> game {cards = map mapJackToJoker $ cards game}) + where + mapJackToJoker Jack = Joker + mapJackToJoker a = a + +-- transmorphs jokers into whatever the highest scoring rank was +transmorphJokers :: [Rank] -> [Int] +transmorphJokers [Joker, Joker, Joker, Joker, Joker] = groupCards [Joker, Joker, Joker, Joker, Joker] +transmorphJokers cards = (head grouped + jokerCount) : tail grouped + where + cardsWithoutJokers = filter (/= Joker) cards + jokerCount = length cards - length cardsWithoutJokers + grouped = groupCards cardsWithoutJokers + +-- calculates the final score of the game +calcScore :: [Game] -> Int +calcScore game = sum $ zipWith (curry formula) [1 ..] game + where + formula (idx, game) = baseScore game * idx + +-- determines the strength of the hand based on cards in hand +getHandStrength :: [Int] -> HandStrength +getHandStrength sortedCardCount = case sortedCardCount of + [5] -> FiveOfAKind + [4, 1] -> FourOfAKind + [3, 2] -> FullHouse + (3 : _) -> ThreeOfAKind + (2 : 2 : _) -> TwoPair + (2 : _) -> OnePair + _ -> HighCard + +-- groups any ranks together, returning the amount of items per group. ie. [J, J, A, A, A, 1] would return [3, 2, 1] +groupCards :: [Rank] -> [Int] +groupCards = sortOn Down . map length . group . sort + +-- reads stdin and parses game +readAndParseStdin :: IO [Game] +readAndParseStdin = do + content <- getContents + case parse parseAllGames "" content of + Left parseError -> error $ show parseError + Right game -> return game + +-- parses each game delimited by a newline +parseAllGames :: Parser [Game] +parseAllGames = parseGame `endBy` char '\n' + +-- parses games in the format `[C][C][C] 123` +parseGame :: Parser Game +parseGame = do + cards <- many1 parseRank <* spaces + baseScore <- read <$> many1 digit + return Game {cards, baseScore} + +-- parses a single card rank +parseRank :: Parser Rank +parseRank = do + c <- oneOf "23456789TJQKA" + return $ case c of + '2' -> Two + '3' -> Three + '4' -> Four + '5' -> Five + '6' -> Six + '7' -> Seven + '8' -> Eight + '9' -> Nine + 'T' -> Ten + 'J' -> Jack + 'Q' -> Queen + 'K' -> King + 'A' -> Ace + +data Game = Game + { cards :: [Rank], + baseScore :: Int + } + deriving (Show) + +data Rank = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Enum, Show) + +data HandStrength = FiveOfAKind | FourOfAKind | FullHouse | ThreeOfAKind | TwoOfAKind | TwoPair | OnePair | HighCard deriving (Eq, Ord, Enum, Show) diff --git a/2023/8.hs b/2023/8.hs new file mode 100755 index 0000000..fa3ec83 --- /dev/null +++ b/2023/8.hs @@ -0,0 +1,90 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Data.List +import qualified Data.Map as Map +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +{- https://adventofcode.com/2023/day/8 -} + +main = do + document <- readAndParseStdin + print $ part1 document + print $ part2 document + +-- find the path from AAAA -> ZZZZ +part1 :: Document -> Int +part1 doc = traverseTreeUntilD doc (== "ZZZ") "AAA" + +-- find the length of each startingPosition loop, find least common multiple between all +part2 :: Document -> Int +part2 doc = foldl1 lcm . map (traverseTreeUntilD doc ("Z" `isSuffixOf`)) $ startingPositions + where + startingPositions = filter ("A" `isSuffixOf`) $ (Map.keys . docMap) doc + +-- helper function to call traverseTreeUntil with a document +traverseTreeUntilD :: Document -> (String -> Bool) -> String -> Int +traverseTreeUntilD doc = traverseTreeUntil (cycle $ directions doc) (docMap doc) 0 + +-- traverse the tree until the predicate is matched +traverseTreeUntil :: [Direction] -> Map.Map String (String, String) -> Int -> (String -> Bool) -> String -> Int +traverseTreeUntil (x : xs) m n predicate elem + | predicate elem = n + | otherwise = traverseTreeUntil xs m (n + 1) predicate (readNext getNode x) + where + getNode = case Map.lookup elem m of + Just a -> a + Nothing -> error (show elem) + readNext (n, _) DirectionLeft = n + readNext (_, n) DirectionRight = n + +-- parse entirety of stdin +readAndParseStdin :: IO Document +readAndParseStdin = do + content <- getContents + case parse parseDocument "" content of + Left parseError -> error $ show parseError + Right doc -> return doc + +-- parse entire document +parseDocument :: Parser Document +parseDocument = do + directions <- many1 parseDirection + _ <- string "\n\n" + nodes <- parseNode `endBy` char '\n' + return + Document + { directions, + docMap = Map.fromList nodes + } + +-- parse a single node `AAA = (BBB, CCC)` +parseNode :: Parser (String, (String, String)) +parseNode = do + node <- many1 alphaNum + _ <- spaces <* char '=' <* spaces + _ <- char '(' + left <- many1 alphaNum + _ <- char ',' <* spaces + right <- many1 alphaNum + _ <- char ')' + return (node, (left, right)) + +-- parse the direction string `LRLLLR` +parseDirection :: Parser Direction +parseDirection = do + c <- oneOf "LR" + return $ case c of + 'L' -> DirectionLeft + 'R' -> DirectionRight + +data Document = Document + { directions :: [Direction], + docMap :: Map.Map String (String, String) + } + deriving (Show) + +data Direction = DirectionLeft | DirectionRight deriving (Enum, Show) diff --git a/2023/9.hs b/2023/9.hs new file mode 100755 index 0000000..5623c9e --- /dev/null +++ b/2023/9.hs @@ -0,0 +1,76 @@ +#!/usr/bin/env nix-shell +#!nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Control.Monad (guard) +import Data.List (unfoldr) +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +main = do + input <- readAndParseStdin + print $ part1 input + print $ part2 input + +-- interpolate the next value on every input and sum them +part1 :: [[Int]] -> Int +part1 = sum . map (round . interpolateNext) + +-- interpolate the previous value on every input and sum them +part2 :: [[Int]] -> Int +part2 = sum . map (round . interpolatePrevious) + +-- helper function to call interpolatePolynomial for the next value +interpolateNext :: [Int] -> Double +interpolateNext i = interpolatePolynomial (length i) i + +-- helper function to call interpolatePolynomial for the previous value +interpolatePrevious :: [Int] -> Double +interpolatePrevious = interpolatePolynomial (-1) + +-- given an nth term and a sequence, calculate newton's polynomial and +-- interpolate the nth value for the sequence +interpolatePolynomial :: Int -> [Int] -> Double +interpolatePolynomial nth seq = + let divDiff = (dividedDifference . buildDifferenceTable) seq + initialValue = (1, 0) + (_, val) = foldl foldFunction initialValue $ zip [0 ..] (tail divDiff) + in head divDiff + val + where + foldFunction (productAcc, valueAcc) (idx, val) = + let prod = productAcc * fromIntegral (nth - idx) + in (prod, valueAcc + (val * prod)) + +-- calculate the divided differences from our table for newton's +-- polynomial +dividedDifference :: [[Int]] -> [Double] +dividedDifference table = [fromIntegral (head row) / fromIntegral (fac i) | (i, row) <- zip [0 ..] table] + where + fac i = product [1 .. i] + +-- build the difference table of each input +buildDifferenceTable :: [Int] -> [[Int]] +buildDifferenceTable input = input : unfoldr buildRow input + where + zipPairs list = zip list $ tail list + diffPairs = map $ uncurry subtract + buildRow lst = + let row = diffPairs $ zipPairs lst + in guard (not $ null row) >> Just (row, row) + +-- read and parse stdin +readAndParseStdin :: IO [[Int]] +readAndParseStdin = do + content <- getContents + case parse parseInput "" content of + Left parseError -> error $ show parseError + Right doc -> return doc + +-- parse each input line +parseInput :: Parser [[Int]] +parseInput = parseSequence `sepBy` char '\n' + +-- parse sequence of numbers +parseSequence :: Parser [Int] +parseSequence = map read <$> many1 (digit <|> char '-') `sepBy` char ' ' diff --git a/3.hs b/3.hs deleted file mode 100755 index b3a1d06..0000000 --- a/3.hs +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" -import Data.Char (isNumber) -import Data.List (findIndices) - -{- https://adventofcode.com/2023/day/3 -} - -main = do - input <- getContents - let (schematics, symbols) = takeSymbols input - print $ sum $ part1FindNumbersAdjacentToSchematic schematics symbols - print $ sum $ map product $ part2FindGearPartNumbers schematics symbols - --- find all the part numbers (schematics that are adjacent to a symbol) -part1FindNumbersAdjacentToSchematic :: [Schematic] -> [Symbol] -> [Int] -part1FindNumbersAdjacentToSchematic schematics symbols = map partNumber $ filter (isSchematicAdjacentToAnySymbol symbols) schematics - --- find all part numbers for gears (schematics that are adjacent to exactly two symbols) -part2FindGearPartNumbers :: [Schematic] -> [Symbol] -> [[Int]] -part2FindGearPartNumbers schematics symbols = map (map partNumber) $ filter (\inner -> length inner == 2) $ map (findSchematicsAdjacentToSymbol schematics) symbols - --- returns all schematics that are adjacent to the given symbol -findSchematicsAdjacentToSymbol :: [Schematic] -> Symbol -> [Schematic] -findSchematicsAdjacentToSymbol schematics symbol = filter (`isSchematicAdjacent` symbol) schematics - --- returns true, if the given schematic is adjacent to any of the given symbols -isSchematicAdjacentToAnySymbol :: [Symbol] -> Schematic -> Bool -isSchematicAdjacentToAnySymbol symbol schematic = any (isSchematicAdjacent schematic) symbol - --- returns true, if the given schematic is directly adjacent to the given symbol -isSchematicAdjacent :: Schematic -> Symbol -> Bool -isSchematicAdjacent sc sy = isAdjacent (symbolCoords sy) (schematicCoords sc) - --- returns true, grid position (px, py) is adjacent to single height multi column grid position (rx, ry, width) -isAdjacent :: (Int, Int) -> (Int, Int, Int) -> Bool -isAdjacent (px, py) (rx, ry, width) = - let leftX = rx - rightX = rx + width - 1 - upperY = ry + 1 - lowerY = ry - 1 - in (px >= leftX - 1 && px <= rightX + 1 && py == ry) -- adjacent horizontally - || (py == upperY || py == lowerY) && (px >= leftX && px <= rightX) -- adjacent vertically - || (px == leftX - 1 || px == rightX + 1) && (py == upperY || py == lowerY) -- adjacent diagonally - -data Schematic = Schematic - { partNumber :: Int, - schematicCoords :: (Int, Int, Int) - } - deriving (Show) - -data Symbol = Symbol - { symbolCoords :: (Int, Int), - symbolType :: Char - } - deriving (Show) - --- parse the entire input -takeSymbols :: String -> ([Schematic], [Symbol]) -takeSymbols input = takeSymbol input Nothing (0, 0) [] [] - --- recursively parses the input character by character -takeSymbol :: String -> Maybe Schematic -> (Int, Int) -> [Schematic] -> [Symbol] -> ([Schematic], [Symbol]) -takeSymbol "" Nothing _ schematicAcc symbolAcc = (schematicAcc, symbolAcc) -takeSymbol "" (Just inProgressSchematic) _ schematicAcc symbolAcc = (schematicAcc ++ [inProgressSchematic], symbolAcc) -takeSymbol (x : xs) inProgressSchematic (posX, posY) schematicAcc symbolAcc = - case x of - _ | isNumber x -> takeSymbol xs (Just $ appendToSchematic inProgressSchematic (posX, posY) (read [x])) (posX + 1, posY) schematicAcc symbolAcc - '.' -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) symbolAcc - '\n' -> takeSymbol xs Nothing (0, posY + 1) (maybeAppend schematicAcc inProgressSchematic) symbolAcc - _ -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) (symbolAcc ++ [buildSymbol posX posY x]) - --- appends a character to the schematic, creating a new schematic if one isn't already instantiated -appendToSchematic :: Maybe Schematic -> (Int, Int) -> Int -> Schematic -appendToSchematic (Just schematic) _ c = - let (x, y, n) = schematicCoords schematic - currPartNumber = partNumber schematic - in schematic {partNumber = currPartNumber * 10 + c, schematicCoords = (x, y, n + 1)} -appendToSchematic Nothing (x, y) c = Schematic {partNumber = c, schematicCoords = (x, y, 1)} - --- append a Maybe Schematic to [Schematic] -maybeAppend :: [Schematic] -> Maybe Schematic -> [Schematic] -maybeAppend out (Just new) = out ++ [new] -maybeAppend out Nothing = out - --- easy constructor for a Symbol -buildSymbol :: Int -> Int -> Char -> Symbol -buildSymbol x y symbolType = Symbol {symbolCoords = (x, y), symbolType} diff --git a/4.hs b/4.hs deleted file mode 100755 index 28339ac..0000000 --- a/4.hs +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Data.List (intersect) -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -{- https://adventofcode.com/2023/day/4 -} - -main = do - cards <- readAndParseStdin [] - print $ part1 cards - print $ part2 cards - --- sum up amount of winning numbers using the part1Score formula -part1 :: [Card] -> Int -part1 cards = sum $ map (score . length . getWinningNumbers) cards - where - score 0 = 0 - score n = 2 ^ (n - 1) - --- calculates number of cards won in part 2 of the task -part2 :: [Card] -> Int -part2 cards = sum $ calculateCardCopies $ map (length . getWinningNumbers) cards - --- starts with a base array of [1; n] and replicates Ns right for each `getWinningNumbers` --- where N is the amount of card replicas -calculateCardCopies :: [Int] -> [Int] -calculateCardCopies xs = foldl replicateSingleCardWinnings (replicate (length xs) 1) (zip [0 ..] xs) - --- helper function for calling `copyCards` within `foldl` -replicateSingleCardWinnings :: [Int] -> (Int, Int) -> [Int] -replicateSingleCardWinnings cardReplicas (idx, winningNumbers) = copyCards cardReplicas (idx + 1) idx winningNumbers - --- copies N cards to `winningNumbers` elements right of `winningCardIdx` where N is `cardReplicas[winningCardIdx]` -copyCards :: [Int] -> Int -> Int -> Int -> [Int] -copyCards cardReplicas currIdx winningCardIdx winningNumbers - | currIdx <= length cardReplicas && winningNumbers > 0 = - let incrementedList = incrementAtIndex cardReplicas currIdx (cardReplicas !! winningCardIdx) - in copyCards incrementedList (currIdx + 1) winningCardIdx (winningNumbers - 1) - | otherwise = cardReplicas - --- takes a list, an index and an amount to increment by -incrementAtIndex :: [Int] -> Int -> Int -> [Int] -incrementAtIndex xs idx amount = take idx xs ++ [(xs !! idx) + amount] ++ drop (idx + 1) xs - --- gets the intersection of winning numbers and player numbers -getWinningNumbers :: Card -> [Int] -getWinningNumbers card = myNumbers card `intersect` winningNumbers card - -data Card = Card - { winningNumbers :: [Int], - myNumbers :: [Int] - } - deriving (Show) - --- reads entirety of stdin and parses each line -readAndParseStdin :: [Card] -> IO [Card] -readAndParseStdin acc = do - line <- getLine - if null line - then return acc - else case parse cardParser "" line of - Left parseError -> error $ show parseError - Right card -> readAndParseStdin $ acc ++ [card] - --- parses a `Card [i]: [n1] [n2] [n3] | [n4] [n5] [n6]` line -cardParser :: Parser Card -cardParser = do - _ <- string "Card" <* spaces <* many1 digit <* char ':' <* spaces - winningNumbers <- numberParser - _ <- char '|' <* spaces - myNumbers <- numberParser - - return Card {winningNumbers, myNumbers} - --- reads a single number delimited by spaces -numberParser :: Parser [Int] -numberParser = map read <$> many1 digit `endBy` spaces diff --git a/5.rs b/5.rs deleted file mode 100755 index 65839c4..0000000 --- a/5.rs +++ /dev/null @@ -1,257 +0,0 @@ -#!/usr/bin/env nix-shell -//! ```cargo -//! [dependencies] -//! rangemap = "1.4" -//! strum = { version = "0.25", features = ["derive"] } -//! nom = "7" -//! itertools = "0.12" -//! ``` -/* -#!nix-shell -i rust-script -p rustc -p rust-script -p cargo -*/ - -use itertools::Itertools; -use nom::IResult; -use rangemap::RangeMap; -use std::{collections::HashMap, io::Read, ops::Range, str::FromStr, time::Instant}; - -const TRANSLATION_PATH: &[MapKind] = &[ - MapKind::Soil, - MapKind::Fertilizer, - MapKind::Water, - MapKind::Light, - MapKind::Temperature, - MapKind::Humidity, - MapKind::Location, -]; - -fn main() { - let mut input = Vec::new(); - std::io::stdin().lock().read_to_end(&mut input).unwrap(); - let input = std::str::from_utf8(&input).unwrap(); - - let (rest, input) = parse_input(input).unwrap(); - assert!(rest.is_empty()); - - let i = Instant::now(); - let answer = part1(&input); - eprintln!("part 1: {answer} ({:?})", i.elapsed()); - - let i = Instant::now(); - let answer = part2(&input); - eprintln!("part 2: {answer} ({:?})", i.elapsed()); -} - -fn part1(input: &Input) -> u64 { - let mut lowest_location = u64::MAX; - - for seed in &input.seeds { - let mut source = *seed; - let mut from = MapKind::Seed; - - for to in TRANSLATION_PATH { - let Some(translation) = input.maps.get(&Translation { from, to: *to }) else { - panic!("invalid path {from:?} to {to:?}"); - }; - - if let Some((source_range, destination_base)) = translation.get_key_value(&source) { - source = destination_base + (source - source_range.start); - } - - from = *to; - } - - assert_eq!(from, MapKind::Location); - lowest_location = lowest_location.min(source); - } - - lowest_location -} - -fn part2(input: &Input) -> u64 { - let seed_ranges: Vec<_> = input - .seeds - .iter() - .tuples() - .map(|(start, len)| (*start)..(*start) + len) - .collect(); - - let mut lowest_bound_seen = u64::MAX; - - for seed_range in seed_ranges { - let lowest_for_seed = traverse_path(input, TRANSLATION_PATH, MapKind::Seed, seed_range); - lowest_bound_seen = lowest_bound_seen.min(lowest_for_seed); - } - - lowest_bound_seen -} - -fn traverse_path(input: &Input, path: &[MapKind], from: MapKind, source_range: Range) -> u64 { - let mut lowest_bound_seen = u64::MAX; - - let Some((next_path, rest)) = path.split_first() else { - return source_range.start; - }; - - let Some(translation) = input.maps.get(&Translation { - from, - to: *next_path, - }) else { - panic!("invalid path {from:?} to {next_path:?}"); - }; - - for (new_source_range, destination_base) in translation.overlapping(&source_range) { - // determine intersection between the source range and destination range - let start = source_range.start.max(new_source_range.start); - let end = source_range.end.min(new_source_range.end); - let offset = start.saturating_sub(new_source_range.start); - let length = end.saturating_sub(start); - - let destination_range = (*destination_base + offset)..(*destination_base + offset + length); - - let lowest_in_tree = traverse_path(input, rest, *next_path, destination_range); - - lowest_bound_seen = lowest_bound_seen.min(lowest_in_tree); - } - - // traverse any uncovered sources, which the spec allows us to use our - // destination number directly for - for uncovered_range in split_range( - source_range.clone(), - translation - .overlapping(&source_range) - .map(|v| v.0.clone()) - .collect(), - ) { - let current_range = traverse_path(input, rest, *next_path, uncovered_range); - lowest_bound_seen = lowest_bound_seen.min(current_range); - } - - lowest_bound_seen -} - -/// Splits `main_range` into multiple ranges not covered by `ranges`. -fn split_range(main_range: Range, mut ranges: Vec>) -> Vec> { - let mut non_intersecting_ranges = Vec::new(); - let mut current_start = main_range.start; - - ranges.sort_by_key(|r| r.start); - - for range in ranges { - if range.start > current_start { - non_intersecting_ranges.push(current_start..range.start); - } - - if range.end > current_start { - current_start = range.end; - } - } - - if current_start < main_range.end { - non_intersecting_ranges.push(current_start..main_range.end); - } - - non_intersecting_ranges -} - -#[derive(strum::EnumString, Copy, Clone, Debug, Hash, PartialEq, Eq)] -#[strum(serialize_all = "kebab-case")] -enum MapKind { - Seed, - Soil, - Fertilizer, - Water, - Light, - Temperature, - Humidity, - Location, -} - -#[derive(Debug, Hash, Copy, Clone, PartialEq, Eq)] -struct Translation { - from: MapKind, - to: MapKind, -} - -impl From<(MapKind, MapKind)> for Translation { - fn from((from, to): (MapKind, MapKind)) -> Self { - Self { from, to } - } -} - -#[derive(Debug)] -struct Input { - seeds: Vec, - maps: HashMap>, -} - -/// parse entire input -fn parse_input(rest: &str) -> IResult<&str, Input> { - use nom::{ - bytes::complete::tag, character::complete::digit1, combinator::map_res, - multi::separated_list1, sequence::delimited, - }; - - let (rest, seeds) = delimited( - tag("seeds: "), - separated_list1(tag(" "), map_res(digit1, u64::from_str)), - tag("\n\n"), - )(rest)?; - let (rest, maps) = separated_list1(tag("\n"), parse_single_map)(rest)?; - - Ok(( - rest, - Input { - seeds, - maps: maps.into_iter().collect(), - }, - )) -} - -/// parse header along with each map line -fn parse_single_map(rest: &str) -> IResult<&str, (Translation, RangeMap)> { - use nom::multi::many1; - - let (rest, header) = parse_header(rest)?; - let (rest, lines) = many1(parse_map_line)(rest)?; - - Ok((rest, (header, lines.into_iter().collect()))) -} - -/// parse `803774611 641364296 1132421037` line -fn parse_map_line(rest: &str) -> IResult<&str, (Range, u64)> { - use nom::{ - branch::alt, - bytes::complete::tag, - character::complete::digit1, - combinator::{eof, map_res}, - sequence::terminated, - }; - - let (rest, destination) = terminated(map_res(digit1, u64::from_str), tag(" "))(rest)?; - let (rest, source) = terminated(map_res(digit1, u64::from_str), tag(" "))(rest)?; - let (rest, size) = terminated(map_res(digit1, u64::from_str), alt((tag("\n"), eof)))(rest)?; - - Ok((rest, (source..source + size, destination))) -} - -/// parse `seed-to-soil map:` line -fn parse_header(rest: &str) -> IResult<&str, Translation> { - use nom::{ - bytes::complete::{tag, take_until}, - combinator::{map, map_res}, - sequence::{separated_pair, terminated}, - }; - - map( - terminated( - separated_pair( - map_res(take_until("-"), MapKind::from_str), - tag("-to-"), - map_res(take_until(" "), MapKind::from_str), - ), - tag(" map:\n"), - ), - Translation::from, - )(rest) -} diff --git a/6.hs b/6.hs deleted file mode 100755 index e16fcd0..0000000 --- a/6.hs +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Control.Applicative ((<*)) -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -{- https://adventofcode.com/2023/day/6 -} - -main = do - game <- readAndParseStdin - print $ part1 game - print $ part2 game - --- returns the product of how many winning times there are per game -part1 :: [(Int, Int)] -> Int -part1 = product . map (length . getWinningTimes) - where - getWinningTimes (time, winCond) = filter (> winCond) $ map (`distance` time) [1 .. time - 1] - --- concatenates all games into one big game and returns how many winning times --- there are in the big game -part2 :: [(Int, Int)] -> Int -part2 game = part1 [foldl concatenate (0, 0) game] - where - concatenate (tAcc, dAcc) (t, d) = (tAcc * scale t + t, dAcc * scale d + d) - --- calculates the "scale" of a number + 1 and returns the magnitude ie. 8 -> 10, 23 -> 100, 694 -> 1000 -scale :: Int -> Int -scale n - | n < 10 = 10 - | otherwise = 10 * scale (n `div` 10) - --- calculates distance travelled in a game based on velocity * time minus "button pressing time" -distance :: Int -> Int -> Int -distance v t = v * (t - v) - --- reads stdin and parses game -readAndParseStdin :: IO [(Int, Int)] -readAndParseStdin = do - content <- getContents - case parse gameParser "" content of - Left parseError -> error $ show parseError - Right game -> return game - --- parses `Time: [n1] [n2] [n3]\nDistance:[n4] [n5] [n6]` and returns `[(n1, n4), (n2, n5), (n3, n6)]` -gameParser :: Parser [(Int, Int)] -gameParser = do - time <- map read <$> (string "Time:" *> spaces *> many1 digit `endBy` spaces) - distance <- map read <$> (string "Distance:" *> spaces *> many1 digit `endBy` spaces) - return $ zip time distance diff --git a/7.hs b/7.hs deleted file mode 100755 index a58dcca..0000000 --- a/7.hs +++ /dev/null @@ -1,115 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Data.List -import Data.Ord -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -{- https://adventofcode.com/2023/day/7 -} - -main :: IO () -main = do - games <- readAndParseStdin - print $ part1 games - print $ part2 games - --- sums the score of each game -part1 :: [Game] -> Int -part1 games = calcScore $ sortBy gameComparator games - where - gameComparator = comparing (Down . getHandStrength . groupCards . cards) <> comparing cards - --- maps jacks to jokers (lowest scoring card, which can transmorph itself to the highest scoring group) --- and sums the score of each game -part2 :: [Game] -> Int -part2 games = calcScore $ sortBy gameComparator $ mapAllJacksToJokers games - where - gameComparator = comparing (Down . getHandStrength . transmorphJokers . cards) <> comparing cards - --- transforms every jack in a game to a joker -mapAllJacksToJokers :: [Game] -> [Game] -mapAllJacksToJokers = map (\game -> game {cards = map mapJackToJoker $ cards game}) - where - mapJackToJoker Jack = Joker - mapJackToJoker a = a - --- transmorphs jokers into whatever the highest scoring rank was -transmorphJokers :: [Rank] -> [Int] -transmorphJokers [Joker, Joker, Joker, Joker, Joker] = groupCards [Joker, Joker, Joker, Joker, Joker] -transmorphJokers cards = (head grouped + jokerCount) : tail grouped - where - cardsWithoutJokers = filter (/= Joker) cards - jokerCount = length cards - length cardsWithoutJokers - grouped = groupCards cardsWithoutJokers - --- calculates the final score of the game -calcScore :: [Game] -> Int -calcScore game = sum $ zipWith (curry formula) [1 ..] game - where - formula (idx, game) = baseScore game * idx - --- determines the strength of the hand based on cards in hand -getHandStrength :: [Int] -> HandStrength -getHandStrength sortedCardCount = case sortedCardCount of - [5] -> FiveOfAKind - [4, 1] -> FourOfAKind - [3, 2] -> FullHouse - (3 : _) -> ThreeOfAKind - (2 : 2 : _) -> TwoPair - (2 : _) -> OnePair - _ -> HighCard - --- groups any ranks together, returning the amount of items per group. ie. [J, J, A, A, A, 1] would return [3, 2, 1] -groupCards :: [Rank] -> [Int] -groupCards = sortOn Down . map length . group . sort - --- reads stdin and parses game -readAndParseStdin :: IO [Game] -readAndParseStdin = do - content <- getContents - case parse parseAllGames "" content of - Left parseError -> error $ show parseError - Right game -> return game - --- parses each game delimited by a newline -parseAllGames :: Parser [Game] -parseAllGames = parseGame `endBy` char '\n' - --- parses games in the format `[C][C][C] 123` -parseGame :: Parser Game -parseGame = do - cards <- many1 parseRank <* spaces - baseScore <- read <$> many1 digit - return Game {cards, baseScore} - --- parses a single card rank -parseRank :: Parser Rank -parseRank = do - c <- oneOf "23456789TJQKA" - return $ case c of - '2' -> Two - '3' -> Three - '4' -> Four - '5' -> Five - '6' -> Six - '7' -> Seven - '8' -> Eight - '9' -> Nine - 'T' -> Ten - 'J' -> Jack - 'Q' -> Queen - 'K' -> King - 'A' -> Ace - -data Game = Game - { cards :: [Rank], - baseScore :: Int - } - deriving (Show) - -data Rank = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Enum, Show) - -data HandStrength = FiveOfAKind | FourOfAKind | FullHouse | ThreeOfAKind | TwoOfAKind | TwoPair | OnePair | HighCard deriving (Eq, Ord, Enum, Show) diff --git a/8.hs b/8.hs deleted file mode 100755 index fa3ec83..0000000 --- a/8.hs +++ /dev/null @@ -1,90 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Data.List -import qualified Data.Map as Map -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -{- https://adventofcode.com/2023/day/8 -} - -main = do - document <- readAndParseStdin - print $ part1 document - print $ part2 document - --- find the path from AAAA -> ZZZZ -part1 :: Document -> Int -part1 doc = traverseTreeUntilD doc (== "ZZZ") "AAA" - --- find the length of each startingPosition loop, find least common multiple between all -part2 :: Document -> Int -part2 doc = foldl1 lcm . map (traverseTreeUntilD doc ("Z" `isSuffixOf`)) $ startingPositions - where - startingPositions = filter ("A" `isSuffixOf`) $ (Map.keys . docMap) doc - --- helper function to call traverseTreeUntil with a document -traverseTreeUntilD :: Document -> (String -> Bool) -> String -> Int -traverseTreeUntilD doc = traverseTreeUntil (cycle $ directions doc) (docMap doc) 0 - --- traverse the tree until the predicate is matched -traverseTreeUntil :: [Direction] -> Map.Map String (String, String) -> Int -> (String -> Bool) -> String -> Int -traverseTreeUntil (x : xs) m n predicate elem - | predicate elem = n - | otherwise = traverseTreeUntil xs m (n + 1) predicate (readNext getNode x) - where - getNode = case Map.lookup elem m of - Just a -> a - Nothing -> error (show elem) - readNext (n, _) DirectionLeft = n - readNext (_, n) DirectionRight = n - --- parse entirety of stdin -readAndParseStdin :: IO Document -readAndParseStdin = do - content <- getContents - case parse parseDocument "" content of - Left parseError -> error $ show parseError - Right doc -> return doc - --- parse entire document -parseDocument :: Parser Document -parseDocument = do - directions <- many1 parseDirection - _ <- string "\n\n" - nodes <- parseNode `endBy` char '\n' - return - Document - { directions, - docMap = Map.fromList nodes - } - --- parse a single node `AAA = (BBB, CCC)` -parseNode :: Parser (String, (String, String)) -parseNode = do - node <- many1 alphaNum - _ <- spaces <* char '=' <* spaces - _ <- char '(' - left <- many1 alphaNum - _ <- char ',' <* spaces - right <- many1 alphaNum - _ <- char ')' - return (node, (left, right)) - --- parse the direction string `LRLLLR` -parseDirection :: Parser Direction -parseDirection = do - c <- oneOf "LR" - return $ case c of - 'L' -> DirectionLeft - 'R' -> DirectionRight - -data Document = Document - { directions :: [Direction], - docMap :: Map.Map String (String, String) - } - deriving (Show) - -data Direction = DirectionLeft | DirectionRight deriving (Enum, Show) diff --git a/9.hs b/9.hs deleted file mode 100755 index 5623c9e..0000000 --- a/9.hs +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" - -import Control.Monad (guard) -import Data.List (unfoldr) -import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.Combinator -import Text.Parsec.String (Parser) - -main = do - input <- readAndParseStdin - print $ part1 input - print $ part2 input - --- interpolate the next value on every input and sum them -part1 :: [[Int]] -> Int -part1 = sum . map (round . interpolateNext) - --- interpolate the previous value on every input and sum them -part2 :: [[Int]] -> Int -part2 = sum . map (round . interpolatePrevious) - --- helper function to call interpolatePolynomial for the next value -interpolateNext :: [Int] -> Double -interpolateNext i = interpolatePolynomial (length i) i - --- helper function to call interpolatePolynomial for the previous value -interpolatePrevious :: [Int] -> Double -interpolatePrevious = interpolatePolynomial (-1) - --- given an nth term and a sequence, calculate newton's polynomial and --- interpolate the nth value for the sequence -interpolatePolynomial :: Int -> [Int] -> Double -interpolatePolynomial nth seq = - let divDiff = (dividedDifference . buildDifferenceTable) seq - initialValue = (1, 0) - (_, val) = foldl foldFunction initialValue $ zip [0 ..] (tail divDiff) - in head divDiff + val - where - foldFunction (productAcc, valueAcc) (idx, val) = - let prod = productAcc * fromIntegral (nth - idx) - in (prod, valueAcc + (val * prod)) - --- calculate the divided differences from our table for newton's --- polynomial -dividedDifference :: [[Int]] -> [Double] -dividedDifference table = [fromIntegral (head row) / fromIntegral (fac i) | (i, row) <- zip [0 ..] table] - where - fac i = product [1 .. i] - --- build the difference table of each input -buildDifferenceTable :: [Int] -> [[Int]] -buildDifferenceTable input = input : unfoldr buildRow input - where - zipPairs list = zip list $ tail list - diffPairs = map $ uncurry subtract - buildRow lst = - let row = diffPairs $ zipPairs lst - in guard (not $ null row) >> Just (row, row) - --- read and parse stdin -readAndParseStdin :: IO [[Int]] -readAndParseStdin = do - content <- getContents - case parse parseInput "" content of - Left parseError -> error $ show parseError - Right doc -> return doc - --- parse each input line -parseInput :: Parser [[Int]] -parseInput = parseSequence `sepBy` char '\n' - --- parse sequence of numbers -parseSequence :: Parser [Int] -parseSequence = map read <$> many1 (digit <|> char '-') `sepBy` char ' ' -- libgit2 1.7.2