advent04.hs

   1 module Main(main) where
   2
   3 import Data.List (last, intersperse, sortBy, intercalate, isInfixOf, init)
   4 import Data.List.Split (splitOn)
   5 import Data.Char (isLetter, ord, chr)
   6 import qualified Data.Map.Lazy as Map
   7
   8 data Room = Room { name :: String
   9                  , sector :: Int
  10                  , checksum :: String
  11                  } deriving (Show)
  12
  13 main :: IO ()
  14 main = do
  15         instrText <- readFile "advent04.txt"
  16         let rooms = map (parseLine) $ lines instrText
  17         part1 rooms
  18         part2 rooms
  19
  20
  21 part1 :: [Room] -> IO ()
  22 part1 rooms = do
  23     print $ sum $ map (sector) validRooms
  24     where
  25         validChecksum room = (checksum room) == makeChecksum (name room)
  26         validRooms = filter (validChecksum) rooms
  27
  28 part2 :: [Room] -> IO ()
  29 part2 rooms = do
  30     print $ fst $ head $ filter (\sn -> isInfixOf "north" (snd sn)) sectorNames
  31     where
  32         validChecksum room = (checksum room) == makeChecksum (name room)
  33         validRooms = filter (validChecksum) rooms
  34         sectorNames = [((sector r),
  35             shiftWord (sector r) (name r)) | r <- validRooms]
  36
  37
  38 parseLine :: String -> Room
  39 parseLine line = Room {name=name, sector=sector, checksum=checksum}
  40     where components = splitOn "-" line
  41           name = intercalate "-" $ init components
  42           sector = read $ head $ splitOn "[" $ last components
  43           checksum = filter (isLetter) $ last components
  44
  45 countedLetters :: String -> [(Char, Int)]
  46 countedLetters name = sortBy sortCLetter $ unsortedCountedLetters name
  47     where unsortedCountedLetters name =
  48             Map.toList $ Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name]
  49
  50 sortCLetter :: (Char, Int) -> (Char, Int) -> Ordering
  51 sortCLetter (l1, n1) (l2, n2)
  52     | n1 < n2 = GT
  53     | n1 > n2 = LT
  54     | n1 == n2 = compare l1 l2
  55
  56 makeChecksum :: String -> String
  57 makeChecksum name = [l | (l, _) <- take 5 $ countedLetters name]
  58
  59
  60 shiftWord :: Int -> String -> String
  61 shiftWord shift letters = map (shiftLetter shift) letters
  62
  63 shiftLetter :: Int -> Char -> Char
  64 shiftLetter shift letter
  65     | isLetter letter = chr $ (ord letter - ord 'a' + shift) `mod` 26 + ord 'a'
  66     | otherwise = ' '