Initial commit

src/Day1Lib.hs

@@ -0,0 +1,28 @@
+module Day1Lib
+    ( day1,
+      day1Two,
+      convertToString
+    ) where
+
+import Data.List
+import Data.List.Split
+
+convertToInt :: [String] -> [Int]
+convertToInt = map read
+
+convertToString :: Int -> String
+convertToString = show
+
+day1 :: String -> Int
+day1 input = foldl max 0 summedList
+    where
+         summedList = map sum splitInputAsInt
+         splitInputAsInt = map (map read) splitInput :: [[Int]]
+         splitInput = map words $ splitOn "\n\n" input
+
+day1Two :: String -> Int
+day1Two input = sum $ take 3 $ reverse $ sort summedList
+    where
+         summedList = map sum splitInputAsInt
+         splitInputAsInt = map (map read) splitInput :: [[Int]]
+         splitInput = map words $ splitOn "\n\n" input

src/Day2Lib.hs

@@ -0,0 +1,81 @@
+module Day2Lib
+    ( day2,
+      day2Alternate
+    ) where
+
+import Data.List.Split
+
+data RPSMove = Rock | Paper | Scissors deriving Eq
+data WinState = Lose | Draw | Win 
+type RoundResult = (RPSMove, WinState)
+
+scoreMove :: RPSMove -> Int
+scoreMove Rock     = 1
+scoreMove Paper    = 2
+scoreMove Scissors = 3
+
+scoreWinState :: WinState -> Int
+scoreWinState Lose = 0
+scoreWinState Draw = 3
+scoreWinState Win  = 6
+
+scoreRound :: RoundResult -> Int
+scoreRound (move, winstate) = scoreMove move + scoreWinState winstate
+
+playRound :: (RPSMove, RPSMove) -> RoundResult
+playRound (theirMove, myMove)
+    | theirMove == myMove = (myMove, Draw)
+    | theirMove == Paper    && myMove == Scissors = (myMove, Win)
+    | theirMove == Rock     && myMove == Paper = (myMove, Win)
+    | theirMove == Scissors && myMove == Rock = (myMove, Win)
+    | otherwise = (myMove, Lose)
+
+winRound :: (RPSMove, WinState) -> RoundResult
+winRound (theirMove, Win)
+    | theirMove == Rock = (Paper, Win)
+    | theirMove == Paper = (Scissors, Win)
+    | theirMove == Scissors = (Rock, Win)
+winRound (theirMove, Lose)
+    | theirMove == Rock = (Scissors, Lose)
+    | theirMove == Paper = (Rock, Lose)
+    | theirMove == Scissors = (Paper, Lose)
+winRound (theirMove, Draw) = (theirMove, Draw)
+
+parseMoves :: (String, String) -> (RPSMove, RPSMove)
+parseMoves (a, x) = (parseTheirMove a, parseMyMove x)
+
+parseTheirMove :: String -> RPSMove
+parseTheirMove a
+    | a == "A" = Rock
+    | a == "B" = Paper
+    | a == "C" = Scissors
+
+parseMyMove :: String -> RPSMove
+parseMyMove x 
+    | x == "X" = Rock
+    | x == "Y" = Paper
+    | x == "Z" = Scissors
+
+parseMoveAndDesiredWinState :: (String, String) -> (RPSMove, WinState)
+parseMoveAndDesiredWinState (a, x) = (parseTheirMove a, parseMyDesiredWinState x)
+
+parseMyDesiredWinState :: String -> WinState
+parseMyDesiredWinState x
+    | x == "X" = Lose
+    | x == "Y" = Draw
+    | x == "Z" = Win
+
+tuplify2 :: [a] -> (a,a)
+tuplify2 [x,y] = (x,y)
+
+parseInput :: String -> [(RPSMove, RPSMove)]
+parseInput i = map (parseMoves) $ map tuplify2 $ map (splitOn " ") $ lines i
+
+parseInputAlternate :: String -> [(RPSMove, WinState)]
+parseInputAlternate i = map (parseMoveAndDesiredWinState) $ map tuplify2 $ map (splitOn " ") $ lines i
+
+day2 :: String -> Int
+day2 input = sum $ map scoreRound $ map playRound $ parseInput input
+
+day2Alternate :: String -> Int
+day2Alternate input  = sum $ map scoreRound $ map winRound $ parseInputAlternate input

src/Day3Lib.hs

@@ -0,0 +1,48 @@
+module Day3Lib
+    ( day3,
+      day3Alternate
+    ) where
+
+import Data.List (elemIndex, intersect, nub)
+import Data.Maybe
+
+type RucksackItems = [Char]
+type RucksackItem = Char
+type ElfGroup = (RucksackItems, RucksackItems, RucksackItems)
+
+priority :: RucksackItem -> Int
+priority i 
+    | i `elem` lowercases = (fromJust $ elemIndex i lowercases) + 1
+    | i `elem` uppercases = (fromJust $ elemIndex i uppercases) + 27
+    | otherwise = 0
+    where
+        lowercases = "abcdefghijklmnopqrstuvwxyz"
+        uppercases = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+intersectingItems :: (RucksackItems, RucksackItems) -> RucksackItems
+intersectingItems (r1, r2) = r1 `intersect` r2
+
+parseLine :: String -> (RucksackItems, RucksackItems)
+parseLine l = (take halfLength l, drop halfLength l)
+    where
+        halfLength = length l `div` 2
+
+parseInput :: String -> [(RucksackItems, RucksackItems)]
+parseInput i = map parseLine $ lines i
+
+day3 :: String -> Int
+day3 input = sum $ map priority $ concat $ map nub $ map intersectingItems $ parseInput input
+
+
+parseInputAlternate :: String -> [ElfGroup]
+parseInputAlternate i = breakIntoGroups $ lines i
+
+breakIntoGroups :: [String] -> [ElfGroup]
+breakIntoGroups [] = []
+breakIntoGroups (a:b:c:rest) = (a, b, c) : breakIntoGroups rest
+
+processCommonItems :: Eq a => ([a], [a], [a]) -> [a]
+processCommonItems (a,b,c) = intersect c $ intersect a b
+
+day3Alternate :: String -> Int
+day3Alternate input = sum $ map priority $ concat $ map nub $ map processCommonItems $ parseInputAlternate input

src/Day4Lib.hs

@@ -0,0 +1,45 @@
+module Day4Lib
+    ( day4,
+      day4Alternate
+    ) where
+
+import Data.List (intersect, isSubsequenceOf)
+import Data.List.Split (splitOn)
+
+type SectionId = Int
+type Range = (SectionId, SectionId)
+type RangePair = (Range, Range)
+
+checkRangePairForPartialOverlap :: RangePair -> Bool
+checkRangePairForPartialOverlap (r1, r2) = intersection
+    where
+        processedR1 = processRange r1
+        processedR2 = processRange r2
+        -- Get the intersection, convert it into a bool based on if it's empty, then negate the bool
+        intersection = not $ null $ processedR1 `intersect` processedR2
+
+checkRangePairForFullOverlap :: RangePair -> Bool
+checkRangePairForFullOverlap (r1, r2) = processedR1 `isSubsequenceOf` processedR2 || processedR2 `isSubsequenceOf` processedR1
+    where
+        processedR1 = processRange r1
+        processedR2 = processRange r2
+
+processRange :: Range -> [SectionId]
+processRange (s, e) = [s..e]
+
+tuplify2 :: [a] -> (a,a)
+tuplify2 [x,y] = (x, y)
+
+parseInput :: String -> [RangePair]
+parseInput i = map tuplify2 $ map (map tuplify2) $ map (map (map readAsInt)) $ map (map splitOnDash) $ map splitOnComma $ lines i
+    where
+        inputAsLines = lines i
+        splitOnComma = splitOn ","
+        splitOnDash = splitOn "-"
+        readAsInt r = read r :: Int
+
+day4 :: String -> Int
+day4 input = sum $ map fromEnum $ map checkRangePairForFullOverlap $ parseInput input
+
+day4Alternate :: String -> Int
+day4Alternate input = sum $ map fromEnum $ map checkRangePairForPartialOverlap $ parseInput input

src/Day5Lib.hs

@@ -0,0 +1,102 @@
+module Day5Lib where
+
+import Data.List (transpose)
+import Data.List.Split
+import Data.Char (isAlpha, isDigit)
+
+type Crate = Char
+type CrateStack = [Char]
+
+type Quantity = Int
+type CrateStackId = Int
+type Instruction = (Quantity, CrateStackId, CrateStackId)
+
+type Problem = ([CrateStack], [Instruction])
+
+applyInstruction :: [CrateStack] -> Instruction -> [CrateStack]
+applyInstruction cs (0, csi1, csi2) = cs
+applyInstruction cs (q, csi1, csi2) = applyInstruction finalList (q - 1, csi1, csi2)
+  where
+    prior1 = fst $ splitAt (csi1 - 1) cs
+    post1  = snd $ splitAt (csi1) cs
+    -- Decrement by one to account for zero indexing
+    newCsi1 =  tail (cs !! (csi1 - 1))
+    movedCrate = head (cs !! (csi1 - 1))
+    removedList = prior1 ++ (newCsi1 : post1)
+
+    prior2 = fst $ splitAt (csi2 - 1) removedList
+    post2 = snd $ splitAt (csi2) removedList
+    newCsi2 =  movedCrate : (cs !! (csi2 - 1))
+    finalList = prior2 ++ (newCsi2 : post2)
+
+applyInstructionAlternate :: [CrateStack] -> Instruction -> [CrateStack]
+applyInstructionAlternate cs (q, csi1, csi2) = finalList
+  where
+    prior1 = fst $ splitAt (csi1 - 1) cs
+    post1  = snd $ splitAt (csi1) cs
+    -- Decrement by one to account for zero indexing
+    newCsi1 =  drop q (cs !! (csi1 - 1))
+    movedCrates = take q (cs !! (csi1 - 1))
+    removedList = prior1 ++ (newCsi1 : post1)
+
+    prior2 = fst $ splitAt (csi2 - 1) removedList
+    post2 = snd $ splitAt (csi2) removedList
+    newCsi2 =  movedCrates ++ (removedList !! (csi2 - 1))
+    finalList = prior2 ++ (newCsi2 : post2)
+
+
+solveProblem :: Problem -> [CrateStack]
+solveProblem (cs, []) = cs
+solveProblem (cs, (ins:inss)) = solveProblem ((applyInstruction cs ins), inss)
+
+solveProblemAlternate :: Problem -> [CrateStack]
+solveProblemAlternate (cs, []) = cs
+solveProblemAlternate (cs, (ins:inss)) = solveProblemAlternate ((applyInstructionAlternate cs ins), inss)
+
+getTopCrates :: [CrateStack] -> String
+getTopCrates cs = map myBespokeHead cs
+
+-- better head, because I'm better lmao
+myBespokeHead :: [Char] -> Char
+myBespokeHead [] = ' '
+myBespokeHead (x:_) = x
+
+processInstruction :: String -> Instruction
+processInstruction i = tuplify3 $ map convertToInt filteredString
+  where
+    -- Filter the string to only numeric characters, which compose the instruction and appear in order
+    filteredString = filter (all isDigit) $ words i
+
+stringIsNumber :: String -> Bool
+stringIsNumber s = all isDigit s
+
+convertToInt :: String -> Int
+convertToInt s = read s :: Int
+
+tuplify3 :: [a] -> (a,a,a)
+tuplify3 [x,y,z] = (x, y, z)
+
+processCrates :: String -> [CrateStack]
+processCrates i = map (filter isAlpha) $ filter validLine $ transpose $ lines i
+  where
+    -- After transposing this function is used to filter for valid lines
+    validLine x = not $ null $ filter isDigit x
+
+parseInput :: String -> Problem
+parseInput i = (processCrates crates, map processInstruction instructions)
+  where
+    splitInput = splitOn "\n\n" i
+    crates = head splitInput
+    instructions = concat $ map lines $ tail splitInput
+
+day5 :: String -> String
+day5 input = getTopCrates solvedState
+  where
+    parsedInput = parseInput input
+    solvedState = solveProblem parsedInput
+
+day5Alternate :: String -> String
+day5Alternate input = getTopCrates solvedState
+  where
+    parsedInput = parseInput input
+    solvedState = solveProblemAlternate parsedInput