Tidying, especially the parser
[advent-of-code-16.git] / adventofcode16 / app / 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 "data/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 = ' '