Advent of Haskell, Part 2
Tags: adventofcode, haskell, functional
Published: 2020-12-22 19:49:56

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](https://adventofcode.com/2020/day/2)

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](https://gabebw.com/blog/2015/10/11/regular-expressions-in-haskell) 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:

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

From there on things went smoothly.

**Part 1**: Just some range checking

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

**Part 2**: Just some good old XOR

```haskell
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.

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

Finally, plugging it all together:

```haskell
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](https://github.com/weph/advent-of-code-2020/blob/main/app/Day02.hs)

## Day 3
[Puzzle description](https://adventofcode.com/2020/day/3)

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.

```haskell
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](https://github.com/weph/advent-of-code-2020/blob/main/app/Day03.hs)

## Day 4
[Puzzle description](https://adventofcode.com/2020/day/4)

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).

```haskell
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`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v:elem). `isPid` checks the string length and validates characters using a combination of [`all`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v:all) and [`isDigit`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-Char.html#v:isDigit). `isHexColor` is basically the same, except that it checks the characters using [`isHexDigit`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-Char.html#v:isHexDigit) and that the string starts with `#`.

```haskell
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`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v:takeWhile)/
[`dropWhile`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v:dropWhile) in combination with `isDigit`. Although this solution isn't as strict as a proper regex, it did the job for this puzzle.

```haskell
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`](https://hackage.haskell.org/package/split-0.2.3.4/docs/Data-List-Split.html#v:splitOneOf) to split the fields by either space or newline. All fields will then be splitted into key/value pairs using [`splitOn`](https://hackage.haskell.org/package/split-0.2.3.4/docs/Data-List-Split.html#v:splitOn) and mapped to a tuple which is needed for `Map.fromList`.

```haskell
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. 

```haskell
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`.

```haskell
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: 

```haskell
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](https://github.com/weph/advent-of-code-2020/blob/main/app/Day04.hs)

## Day 5
[Puzzle description](https://adventofcode.com/2020/day/5)

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.

```haskell
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`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Prelude.html#v: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.

```haskell
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](https://github.com/weph/advent-of-code-2020/blob/main/app/Day05.hs)

## Day 6
[Puzzle description](https://adventofcode.com/2020/day/6)

**Part 1**: [`nub`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v: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.

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

**Part 2**: I used [`foldl1`](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-List.html#v: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!

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

Nothing unexpected to see here

```haskell
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](https://github.com/weph/advent-of-code-2020/blob/main/app/Day06.hs)

## 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.