Created
December 3, 2021 16:34
-
-
Save netsamir/adcce718351cc75acb9de08ddd30968c to your computer and use it in GitHub Desktop.
adventofcode.com
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import qualified Data.List as L | |
import System.IO | |
------------ ------------ ------------ | |
-- Day 1 | |
------------ ------------ ------------ | |
input1_test = [199, 200, 208, 210, 200, 207, 240, 269, 260, 263] | |
measurements :: [Integer] -> Integer | |
measurements (_:[]) = 0 | |
measurements (x:y:xs) = if x < y then 1 + measurements (y:xs) else measurements (y:xs) | |
mytriples :: [Integer] -> [[Integer]] | |
mytriples (a:b:c:[]) = [[a, b, c]] | |
mytriples (_:_:[]) = [] | |
mytriples (_:[]) = [] | |
mytriples (a:b:c:xs) = [[a, b, c]] ++ mytriples (b:c:xs) | |
------------ ------------ ------------ | |
-- Day 2 | |
------------ ------------ ------------ | |
input2_test = [Forward 5, Down 5, Forward 8, Up 3, Down 8, Forward 2] | |
type Unit = Integer | |
type Horizontal = Integer | |
type Deep = Integer | |
type Position = (Horizontal, Deep) | |
data SubmarineMovement = Forward Unit | Down Unit | Up Unit deriving (Show) | |
class MyRead a where | |
myread :: String -> a | |
instance MyRead SubmarineMovement where | |
myread input = | |
let valueConstructor = L.words input !! 0 | |
value = read $ L.words input !! 1 :: Integer | |
in | |
case valueConstructor of | |
"forward" -> Forward value | |
"down" -> Down value | |
"up" -> Up value | |
-- PART I | |
moveSubmarine :: [SubmarineMovement] -> Position | |
moveSubmarine xs = foldr (\x acc -> move x acc) (0, 0) xs | |
where | |
move :: SubmarineMovement -> Position -> Position | |
move (Forward u) (h, d) = (h + u, d) | |
move (Down u ) (h, d) = (h, d + u) | |
move (Up u) (h, d) = (h, d - u) | |
main_day2_part1 = do | |
handle <- openFile "adventofcode_input2.txt" ReadMode | |
contents <- hGetContents handle | |
let values = [myread v :: SubmarineMovement | v <- L.lines contents] | |
let final_position = moveSubmarine values | |
print final_position | |
print $ fst final_position * snd final_position | |
hClose handle | |
-- PART II | |
type Aim = Integer | |
type NewPosition = (Horizontal, Deep, Aim) | |
moveSubmarine' :: [SubmarineMovement] -> NewPosition | |
moveSubmarine' xs = foldl (\acc x -> move x acc) (0, 0, 0) xs | |
where | |
move :: SubmarineMovement -> NewPosition -> NewPosition | |
move (Forward u) (h, d, a) = (h + u, d + u * a, a) | |
move (Down u ) (h, d, a) = (h, d, a + u) | |
move (Up u) (h, d, a) = (h, d, a - u) | |
main_day2_part2 = do | |
handle <- openFile "adventofcode_input2.txt" ReadMode | |
contents <- hGetContents handle | |
let values = [myread v :: SubmarineMovement | v <- L.lines contents] | |
let final_position = moveSubmarine' values | |
print final_position | |
let (h, d, a) = final_position | |
print $ h * d | |
hClose handle | |
------------ ------------ ------------ | |
--- Day 3: Binary Diagnostic --- | |
------------ ------------ ------------ | |
-- PART I | |
test_input3 = ["00100", "11110", "10110", "10111", "10101", "01111", "00111", "11100", "10000", "11001", "00010", "01010"] | |
data Bit a = Bit0 a | Bit1 a deriving (Show) | |
instance Functor Bit where | |
fmap f (Bit0 x) = Bit0 (f x) | |
fmap f (Bit1 x) = Bit1 (f x) | |
binaryDiag :: [String] -> Integer | |
binaryDiag xs = gammaRate * epsilonRate | |
where | |
epsilonRate = rate snd | |
gammaRate = rate fst | |
rate f = toDecimal . map untranspose_bit . map f . map maxPartition $ map most_common transpose_bit | |
transpose_bit = L.transpose xs | |
most_common = foldl (\(a, b) x -> if x == '0' then (fmap (+1) a, b) else (a, fmap (+1) b)) (Bit0 0, Bit1 0) | |
maxPartition (Bit0 x, Bit1 y) = if x >= y then (Bit0 x, Bit1 y) else (Bit1 y, Bit0 x) | |
untranspose_bit b = case b of | |
Bit0 _ -> 0 | |
Bit1 _ -> 1 | |
toDecimal = foldl1 ((+) . (2*)) | |
main_day3_part1 = do | |
handle <- openFile "adventofcode_input3.txt" ReadMode | |
contents <- hGetContents handle | |
let values = L.words contents | |
let result = binaryDiag values | |
print result | |
hClose handle | |
-- PART II | |
lifeSupport :: [String] -> Integer | |
lifeSupport xs = (oxygenSupport 0 xs) * (co2Support 0 xs) | |
where | |
oxygenSupport :: Int -> [String] -> Integer | |
oxygenRating :: Int -> [String] -> [String] | |
co2Support :: Int -> [String] -> Integer | |
co2Rating :: Int -> [String] -> [String] | |
selectCandidates :: Char -> Int -> [String] -> [String] | |
candidates :: Int -> [String] -> (Bit Integer, Bit Integer) | |
max :: (Bit Integer, Bit Integer) -> Char | |
oxygenSupport _ (x:[]) = toDecimal x | |
oxygenSupport n xs = oxygenSupport (n + 1) (oxygenRating n xs) | |
co2Support _ (x:[]) = toDecimal x | |
co2Support n xs = co2Support (n + 1) (co2Rating n xs) | |
oxygenRating n xs = selectCandidates (max $ candidates n xs) n xs | |
co2Rating n xs = selectCandidates (min $ candidates n xs) n xs | |
selectCandidates c n xs = filter (\x -> (x !! n) == c) xs | |
candidates n xs = foldl ( \(a, b) x -> if (x !! n) == '0' | |
then (fmap (+1) a, b) | |
else (a, fmap (+1) b)) (Bit0 0, Bit1 0) xs | |
max (Bit0 x, Bit1 y) = if y >= x then '1' else '0' | |
min (Bit0 x, Bit1 y) = if x <= y then '0' else '1' | |
toDecimal xs = foldl1 ((+) . (2*)) $ foldr (\x acc -> (read [x] :: Integer):acc) [] xs | |
main_day3_part2 = do | |
handle <- openFile "adventofcode_input3.txt" ReadMode | |
contents <- hGetContents handle | |
let values = L.words contents | |
let result = lifeSupport values | |
print result | |
hClose handle |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment