🏡 index : ~doyle/aoc.git

fb40454939d0a45a9d1915053bd1f2fa78d4ac77 [patch]

02ae6846303dca73181d4a79699771b80ac47de1

6e1811614adc1fdea520bd47d71dcc0b0997b107

fb40454939d0a45a9d1915053bd1f2fa78d4ac77.tar.gz

Add 2022 day 1

Diff

 .gitignore         |   1 +
 1.hs               |  68 --------------------------------------------------------------------
 2.hs               |  84 --------------------------------------------------------------------------------
 3.hs               |  87 --------------------------------------------------------------------------------
 4.hs               |  81 --------------------------------------------------------------------------------
 5.rs               | 257 --------------------------------------------------------------------------------
 6.hs               |  53 -----------------------------------------------------
 7.hs               | 115 --------------------------------------------------------------------------------
 8.hs               |  90 --------------------------------------------------------------------------------
 9.hs               |  76 ----------------------------------------------------------------------------
 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 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2022/1/default.nix |  17 +++++++++++++++++
 2022/1/main.f90    |  90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 21 files changed, 1019 insertions(+), 911 deletions(-)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b2be92b 100644
--- /dev/null
+++ a/.gitignore
@@ -1,0 +1,1 @@
result
diff --git a/1.hs b/1.hs
deleted file mode 100755
index 1676ab4..0000000 100755
--- a/1.hs
+++ /dev/null
@@ -1,68 +1,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 100755
--- a/2.hs
+++ /dev/null
@@ -1,84 +1,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<string, int> 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/3.hs b/3.hs
deleted file mode 100755
index b3a1d06..0000000 100755
--- a/3.hs
+++ /dev/null
@@ -1,87 +1,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 100755
--- a/4.hs
+++ /dev/null
@@ -1,81 +1,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 100755
--- a/5.rs
+++ /dev/null
@@ -1,257 +1,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>) -> 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<u64>, mut ranges: Vec<Range<u64>>) -> Vec<Range<u64>> {
    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<u64>,
    maps: HashMap<Translation, RangeMap<u64, u64>>,
}

/// 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<u64, u64>)> {
    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>, 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 100755
--- a/6.hs
+++ /dev/null
@@ -1,53 +1,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 100755
--- a/7.hs
+++ /dev/null
@@ -1,115 +1,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 100755
--- a/8.hs
+++ /dev/null
@@ -1,90 +1,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 100755
--- a/9.hs
+++ /dev/null
@@ -1,76 +1,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 ' '
diff --git a/2023/1.hs b/2023/1.hs
new file mode 100755
index 0000000..1676ab4 100755
--- /dev/null
+++ a/2023/1.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/2.hs
@@ -1,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<string, int> 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 100755
--- /dev/null
+++ a/2023/3.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/4.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/5.rs
@@ -1,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>) -> 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<u64>, mut ranges: Vec<Range<u64>>) -> Vec<Range<u64>> {
    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<u64>,
    maps: HashMap<Translation, RangeMap<u64, u64>>,
}

/// 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<u64, u64>)> {
    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>, 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 100755
--- /dev/null
+++ a/2023/6.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/7.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/8.hs
@@ -1,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 100755
--- /dev/null
+++ a/2023/9.hs
@@ -1,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/2022/1/default.nix b/2022/1/default.nix
new file mode 100644
index 0000000..9916b23 100644
--- /dev/null
+++ a/2022/1/default.nix
@@ -1,0 +1,17 @@
{ pkgs ? import <nixpkgs> {} }:

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 100644
--- /dev/null
+++ a/2022/1/main.f90
@@ -1,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