aoc-2018/aoc-2/main.hs

import Data.Map (Map)
import qualified Data.Map as Map


charCounts :: String -> Map Char Int
charCounts (x:xs) = Map.insertWith (+) x 1 (charCounts xs)
charCounts []     = Map.empty

processId :: [(Char, Int)] -> (Bool, Bool)
processId xs = foldr f (False, False) m
               where m :: [(Bool, Bool)]
                     m = map (\(c, i) -> (i == 2, i == 3)) xs

                     f :: (Bool, Bool) -> (Bool, Bool) -> (Bool, Bool)
                     f (a1, a2) (b1, b2) = (a1 || b1, a2 || b2)

collect :: [(Bool, Bool)] -> (Int, Int)
collect xs = foldr f (0, 0) xs
             where f :: (Bool, Bool) -> (Int, Int) -> (Int, Int)
                   f (a1, a2) (b1, b2)
                       | a1 && a2  = (b1 + 1, b2 + 1)
                       | a1        = (b1 + 1, b2)
                       | a2        = (b1, b2 + 1)
                       | otherwise = (b1, b2)

calculateChecksum :: [String] -> Int
calculateChecksum input = a * b
                          where (a, b) = collect [ (processId . Map.toList . charCounts) s | s <- input ]

sameChars :: String -> String -> Int
sameChars (x:xs) (y:ys) 
    | x == y    = 1 + sameChars xs ys
    | otherwise = sameChars xs ys
sameChars [] [] = 0

getCorrectBoxes :: [String] -> [String]
getCorrectBoxes xs = [ x | x <- xs, y <- xs, (length x - (sameChars x y)) == 1 ]

removeDiffChars :: [String] -> String
removeDiffChars xs = foldr f (last xs) xs
                     where f :: String -> String -> String
                           f (x:xs) (y:ys)
                               | x == y    = x:(f xs ys)
                               | otherwise = f xs ys
                           f [] [] = []

main = do
    input <- readFile "inputs.txt"
    putStrLn ("[Part 1] Checksum: " ++ (show . calculateChecksum) (lines input))
    putStrLn ("[Part 2] ID: " ++ (removeDiffChars . getCorrectBoxes) (lines input))