Advent of Haskell, Part 2

It's already been more than two weeks since I started my little Advent of Code + Haskell adventure. So it's time for a little update. Here's what I got done.

Day 2

Puzzle description

Regular expressions are often my first choice when I have to parse something. Like in this case, to get the values easily out of strings like 6-8 b: bbbnvbbb. How hard can that be? Harder than I thought. After spending quite some in the docs and repl I was close to giving up. But then I found an article that really helped. So, I finally got a working parse function that returns the four values of a given line as a list of strings:

parse :: String -> [String]
parse input = drop 1 (getAllTextSubmatches $ input =~ "(.+)-(.+) (.): (.+)" :: [String])

From there on things went smoothly.

Part 1: Just some range checking

policy1 min max char str = cnt >= min && cnt <= max
  where cnt = length (filter (==char) str)

Part 2: Just some good old XOR

charAt p str = if length str > p then str !! p else ' '

policy2 p1 p2 char str = (charAt (p1 - 1) str == char) /= (charAt (p2 - 1) str == char)

But wait. How do I pass the list of strings to the policy functions? I introduced a little helper that does all the destructuring, conversion and execution.

isValid policy [min, max, char, str] = policy (read min :: Int) (read max :: Int) (head char) str

Finally, plugging it all together:

validCount xs = length (filter (==True) xs)

solve input = do
  let pwData = map parse (lines input)

  putStrLn ("Part 1: " ++ (show (validCount (map (isValid policy1) pwData))))
  putStrLn ("Part 2: " ++ (show (validCount (map (isValid policy2) pwData))))

Full source on github

Day 3

Puzzle description

This one was really easy and there isn't much I have to say. The only thing I had to look up was how to do a modulo. The rest was pretty straight forward.

tree x map = if (map !! (x `mod` (length map))) == '#' then 1 else 0

traverseMap :: [String] -> Int -> Int -> Int -> Int
traverseMap [] px right down = 0
traverseMap (x:xs) px right down = tree px x + traverseMap (drop (down - 1) xs) (px + right) right down

solve input = do
  let traverse = traverseMap (lines input) 0

  putStrLn ("Part 1: " ++ (show (traverse 3 1)))
  putStrLn ("Part 2: " ++ (show ((traverse 1 1) * (traverse 3 1) * (traverse 5 1) * (traverse 7 1) * (traverse 1 2))))

Full source on github

Day 4

Puzzle description

In the solution for this puzzle I wrote in PHP I used multiple regexes. After my previous struggle with regexes in Haskell, I tried to avoid them this time.

I wanted to have a structure that could be used to solve both parts of the puzzle. A map seemed like a good fit for both, the passport data (field names and values) and the schema (field names and validator functions).

passportSchema = Map.fromList [
  ("byr", isBetween 1920 2002),
  ("iyr", isBetween 2010 2020),
  ("eyr", isBetween 2020 2030),
  ("hgt", isValidHeight),
  ("hcl", isHexColor),
  ("ecl", isEyeColor),
  ("pid", isPid)
  ]

isBetween and isEyeColor verify that a value is part of a given set using elem. isPid checks the string length and validates characters using a combination of all and isDigit. isHexColor is basically the same, except that it checks the characters using isHexDigit and that the string starts with #.

isBetween min max v = (read v :: Int) `elem` [min..max]

isEyeColor v = v `elem` ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]

isPid v = length v == 9 && all isDigit v

isHexColor v = hash == '#' && length values == 6 && all isHexDigit values
  where (hash:values) = v

Implementing isValidHeight was a little bit trickier.
The function splits the numeric value from the unit by using takeWhile/
dropWhile in combination with isDigit. Although this solution isn't as strict as a proper regex, it did the job for this puzzle.

isValidHeight v =
  let unit = dropWhile isDigit v
      value = takeWhile isDigit v
  in (unit == "cm" && between 150 193 value) || (unit == "in" && between 59 76 value)

To convert a single passport from the puzzle input to the map structure I use splitOneOf to split the fields by either space or newline. All fields will then be splitted into key/value pairs using splitOn and mapped to a tuple which is needed for Map.fromList.

toPassport input = Map.fromList (map (\x -> (head x, last x)) (map (splitOn ":") (splitOneOf " \n" input)))

Part 1: A passport is valid if it has at least all fields defined in the schema.

hasAllRequiredFields schema passport = length ((Map.keys schema) \\ (Map.keys passport)) == 0

Part 2: A passport is valid if all values can be validated. If a field is missing in a passport, the Nothing clause in the case expression will make sure that the validation result is False.

isFieldValid passport field isValid = case Map.lookup field passport of
  Nothing -> False
  Just x -> isValid x

allFieldsValid schema passport = Map.foldrWithKey (\field validator acc -> acc && (isFieldValid passport field validator)) True schema

Applying it to all passports and counting the results:

countValid l = length (filter (==True) l)

solve :: String -> IO ()
solve input = do
  let passports = map toPassport (splitOn "\n\n" input)

  putStrLn ("Part 1: " ++ (show (countValid (map (hasAllRequiredFields passportSchema) passports))))
  putStrLn ("Part 2: " ++ (show (countValid (map (allFieldsValid passportSchema) passports))))

Full source on github

Day 5

Puzzle description

This one's puzzle input is just a bunch of binary strings in disguise. No fancy stuff needed. Just folding it down bit by bit.

charToBit x | x `elem` "FL" = 0 | x `elem` "BR" = 1

seatId input = foldl (\acc x -> acc * 2 + (charToBit x)) 0 input

Part 1: The maximum function is all that's needed to find the highest seat number

Part 2: To find the empty seat, I filter down the list of seat ids to the one that has its next id missing, but the one after next exists. Adding one gives us the empty seat id.

emptySeat seatIds = (head (filter (\x -> ((x + 1) `notElem` seatIds) && ((x + 2) `elem` seatIds)) seatIds)) + 1

solve input = do
  let seatIds = map seatId (lines input)

  putStrLn ("Part 1: " ++ (show (maximum seatIds)))
  putStrLn ("Part 2: " ++ (show (emptySeat seatIds)))

Full source on github

Day 6

Puzzle description

Part 1: nub already returns the unique elements of a list. Only thing left to do: Removing everything that's not an alpha character using a filter so newlines doesn't count.

countAny group = length (nub (filter isAlpha group))

Part 2: I used foldl1 to build the intersection of all answers within a group.
foldl1 is just like foldl except that it starts with the first element in the accumulator already. Perfect for the job!

countAll group = length (foldl1 (\acc x -> acc `intersect` x) (lines group))

Nothing unexpected to see here

solve input = do
  let groups = splitOn "\n\n" input

  putStrLn ("Part 1: " ++ (show (sum (map countAny groups))))
  putStrLn ("Part 2: " ++ (show (sum (map countAll groups))))

Full source on github

That's it

Well, I really haven't gotten that far. It's not that I'm lazy - at least not that lazy. I'm still solving the puzzles every day in PHP but my plan to catch up with Haskell afterwards hasn't worked out that well. The advent isn't yet over, though. Let's see what I can squeeze into the last few days.

Is there something I did overly complicated or goofy? Let me know. I'm still a Haskell novice and looking to improve.