adventofcode.com

AdventOfCode.hs

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