| Hosted by CoCalc | Download
Kernel: Haskell

Advent of Code 2020 in Haskell

Day 1: Report Repair

Part 1

In the first part of the first day of AoC, we are asked to find from a list, the two elements which sum to 2020, and report their product. In mathematical notation, this would be: {x.yxL,yL,x+y==2020} \{x.y \mid x \in L, y \in L, x + y == 2020\}

Assuming we have somehow managed to parse the input as a list of integers [Int], we can translate the notation directly to Haskell using a list comprehension:

solve_d1p1 :: [Int] -> Int solve_d1p1 list = head [x*y | x <- list, y <- list, x + y == 2020] -- we take the first element since there could be multiple matches

To parse the input as [Int]:

inp <- readFile "day1.txt" expenses = map read $ lines inp :: [Int]

We used readFile :: FilePath -> IO String to read the contents of the file, applied lines :: String -> [String] to split it line by line, and finally mapped read to convert to [Int]. To actually solve the problem:

solve_d1p1 expenses

Part 2

Part 2 does a simple twist, it wants us to find THREE elements satisfying the same condition. We just change the list comprehension to include a third element z and the condition to x + y + z == 2020

solve_d1p2 :: [Int] -> Int solve_d1p2 list = head [x*y*z | x <- list, y <- list, z <- list, x + y + z == 2020] solve_d1p2 expenses

Day 2: Password Philosophy

Part 1

Day 2 gives us a password policy, and asks us the find how many passwords are valid given their policy. Each line is in the form:

m-n c: p

requiring that the given password p must contain c at least m times and at most n times. For example given the list:

1-3 a: abcde 1-3 b: cdefg 2-9 c: ccccccccc

We see that 2 passwords are valid. The middle password, cdefg, is not; it contains no instances of b, but needs at least 1. The first and third passwords are valid: they contain one a or nine c, both within the limits of their respective policies.

Let's start by defining a data class Password to contain the policy and the password for each line:

data Password = Password { m :: Int, n :: Int, c :: Char, p :: String } deriving (Show)

We will worry about parsing the string later, and focus on the algorithm. To determine if a password is valid, we have to check the number of occurrences of c in password p (using countChar)and check if it is in the range [m, n] (using isIn).

countChar = undefined isIn = undefined isValid :: Password -> Bool isValid (Password m n c p) = (countChar c p) `isIn` (m, n)

isIn is simple, for x to be in the range [a,b][a, b], it has to be "bigger than or equal to a" AND "smaller than or equal to b". The reason I put the limits a and b into their own tuple is because I want to be able to use it in infix form like "x isIn (a,b)".

isIn :: Int -> (Int, Int) -> Bool isIn x (a, b) = (x >= a) && (x <= b)

Counting the occurrences is a bit trickier: basically we want to filter the elements of a list checking their equality to a given element. For example:

filter (=='a') "abcdaa"

Then to calculate the number of occurrences, we simply determine how many elements we are left with:

length $ filter (=='a') "abcdaa"

Thus:

countChar :: Char -> String -> Int countChar _ [] = 0 countChar ch str = length $ filter (== ch) str

Re-defining the isValid now that we wrote the others:

isValid :: Password -> Bool isValid (Password m n c p) = (countChar c p) `isIn` (m, n)

Let's check if it works:

print $ isValid Password{m=1, n=3, c='a', p="abcde"} -- 1-3 a: abcde print $ isValid Password{m=1, n=3, c='b', p="cdefg"} -- 1-3 b: cdefg print $ isValid Password{m=2, n=9, c='c', p="ccccccccc"} -- 2-9 c: ccccccccc print "YAY"

I have told you that we would worry about the parsing later: now let's worry! While we could use regex or even multiple split operations to extract the data we want from the given string, I have taken this challenge as an opportunity to learn parsing in Haskell. I used the famous library parsec*. Note that using a parser for this specific task is probably an overkill, but hey, aren't we here for learning new things?

To install parsec using stack:

stack install parsec

Let's import it:

import qualified Text.Parsec as Pr -- Parsec

Notice how we used a qualified and aliased import. This is mainly because we don't want to pollute our name space with pesty 3rd party libraries ! 😃

Now parsec is a full-fledged parser library, which you can use to parse very complicated languages: we will be using it to parse a simple string without any nested complicated structures or anything, so we will mainly limit ourselves to the mini parsers in Text.Parsec.Char*, which parse characters one at a time.

The main type of a parser in Parsec is Parsec s () a, which parses a type s into a type a (it actually parses it into an Either, but we will deal with that later). So our function passwordParser will have the type:

passwordParser :: P.Parsec String () Password

to parse from a String to our very own Password type.

Notice that the string we want to parse is in the form:

N-N C: S

where N is an integer, C is a character and S is a string. Then corresponding to these types, we will use the the mini parsers digit, letter, anyChar and the modifier many. As the names imply, digit and letter parse digits and letters, whereas anyChar matches any character. many applies the given mini-parser zero or more times, and returns the resulting [Char].

Finally, Parsec lets us define the password in a do block, binding the results using <- and then returning the type we want from the results. This will hopefully make sense then:

passwordParser :: Pr.Parsec String () Password passwordParser = do m <- Pr.many Pr.digit Pr.anyChar n <- Pr.many Pr.digit Pr.anyChar c <- Pr.letter Pr.anyChar Pr.anyChar p <- Pr.many Pr.letter return $ Password (read m :: Int) (read n :: Int) c p

To test our parser, Parsec helpfully gives us parseTest:

Pr.parseTest passwordParser "1-3 a: abcde" Pr.parseTest passwordParser "1-3 b: cdefg" Pr.parseTest passwordParser "2-9 c: ccccccccc"

YAY! There is only one slight problem remaining, the parseTest function is intended for tests only, and the real parse function is an Either type, containing a ParseError (Left) if there is an error, or the value we want (Right). Being good coders, we care about error handling, so we won't use parseTest to actually parse.

If there is no error, parse returns:

Pr.parse passwordParser "" "1-3 a: abcde"

To extract the real value, we can use fromRight or a case analysis. fromRight is more concise, we simply give a default value to be outputted in the case on an error (Left), and it automatically extracts the value for us.

import Data.Either(fromRight) -- note that this was relatively recently introduced in 8.2.1 (Jul 2017).
ps = Pr.parse passwordParser "" "1-3 a: abcde" fromRight (Password{m=0, n=0, c=' ', p=" "}) ps

Thus the main function to convert the given string to Password is simply:

parsePassword :: String -> Password parsePassword pswd = fromRight (Password{m=0, n=0, c=' ', p=" "}) (Pr.parse passwordParser "" pswd)

Phew! As last steps: let's read all the lines from the file and convert them into Passwords:

inp <- readFile "day2.txt" passwords = map parsePassword $ lines inp head passwords

It appears to be working ! Now let's filter them using isValid and find how many of them satisfy their password policies.

solve_d2p1 :: [Password] -> Int solve_d2p1 passwords = length $ filter isValid passwords solve_d2p1 passwords -- 😈

Part 2

Part 2 gives us another password policy: it now requires "exactly one of these positions must contain the given letter". Then, given

m-n c: p

the policy requires either p[m] or p[n] to be c, but not both! The operation "a or b but not both" is known as the exclusive-or (XOR) function. We can simply define it as:

xor :: Bool -> Bool -> Bool xor x y = (x || y) && (not(x && y))

and use it infix:

False `xor` False False `xor` True True `xor` False True `xor` True

Now all we have to do is check both locations to see if they are the character c, and xor the results. We are warned however:

(Be careful; Toboggan Corporate Policies have no concept of "index zero"!)

Thus here are the relevant isValid and solve functions:

isValidP2 :: Password -> Bool isValidP2 (Password m n c p) = (p !! (m-1) == c) `xor` (p !! (n-1) == c) solve_d2p2 :: [Password] -> Int solve_d2p2 passwords = length $ filter isValidP2 passwords solve_d2p2 passwords

Day 4

Part 1

import Data.List ((\\)) import Data.Either (isLeft, isRight, fromRight) import Data.List.Split (splitOn) -- split import Data.List.Utils (replace) -- MissingH import Foreign.Marshal.Utils (fromBool)
inp <- readFile "day4.txt" solution = sum (map (fromBool . null . (["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"] \\) . map (take 3) . words . replace "\n" " ") (splitOn "\n\n" inp)) solution

Part 2

import Text.Regex.TDFA -- regex-tdfa import Data.Tuple.Select(sel4)
inp <- readFile "day4.txt" passports = map (replace "\n" " ")(splitOn "\n\n" inp) byrR = "byr:([0-9]{4})( |$)" iyrR = "iyr:([0-9]{4})( |$)" eyrR = "eyr:([0-9]{4})( |$)" hgtR = "hgt:([0-9]+)(cm|in)( |$)" hclR = "hcl:#([0-9]|[a-f]){6}( |$)" eclR = "ecl:(amb|blu|brn|gry|grn|hzl|oth)( |$)" pidR = "pid:[0-9]{9}( |$)" rules = [byrR, iyrR, eyrR, hgtR, hclR, eclR, pidR] isIn :: Int -> (Int, Int) -> Bool isIn x (a, b) = (x >= a) && (x <= b) isMatch :: String -> String -> Bool isMatch str rule = str =~ rule isCorrect :: String -> Bool isCorrect p = let byr = getYear p byrR iyr = getYear p iyrR eyr = getYear p eyrR hgt = getHeight p in byr `isIn` (1920, 2002) && iyr `isIn` (2010, 2020) && eyr `isIn` (2020, 2030) && isHeightCorrect hgt isValid :: String -> Bool isValid p = (all (isMatch p) rules) && (isCorrect p) getYear :: String -> String -> Int getYear str rule = read (head $ sel4 (str =~ rule :: (String, String, String, [String]))) :: Int getHeight :: String -> (Int, String) getHeight str = let ls = take 2 $ sel4 (str =~ hgtR :: (String, String, String, [String])) in (read (head ls) :: Int, last ls) isHeightCorrect :: (Int, String) -> Bool isHeightCorrect (h, "cm") = h `isIn` (150 ,193) isHeightCorrect (h, "in") = h `isIn` (59 ,76) isHeightCorrect (_, _) = False length $ filter isValid passports
byr (Birth Year) - four digits; at least 1920 and at most 2002. iyr (Issue Year) - four digits; at least 2010 and at most 2020. eyr (Expiration Year) - four digits; at least 2020 and at most 2030. hgt (Height) - a number followed by either cm or in: If cm, the number must be at least 150 and at most 193. If in, the number must be at least 59 and at most 76. hcl (Hair Color) - a # followed by exactly six characters 0-9 or a-f. ecl (Eye Color) - exactly one of: amb blu brn gry grn hzl oth. pid (Passport ID) - a nine-digit number, including leading zeroes. cid (Country ID) - ignored, missing or not.

Day 5

Part 1

inp <- readFile "day5.txt" tickets = lines inp tickets
["FFFBFBFLRR","FFBBFFFRLL","FBFBFFBRLR","FFFBBFBRRL","BFFFBBFRRL","FFBFBFFLLR","FBFBBFFRLL","FFBBFBBLLL","BFFFBBFLLR","FBBFFBBRLR","FBFBBBBLLL","BFFBBBFLLR","BBFFBFBLRR","FBBBFFBRRL","FFFBFBBLRL","FFBFBFBRLR","FBBBBFFRRL","FBBBBFBLLR","BFBBBBFRRR","BFBFFBBLRL","FBBFBBFRLL","FFBBBFBRLR","FBBFFFBRLL","FBFBBFBLRR","FFFBBBFLLL","FBFFBBFLRL","BFFFBFFLLR","FBFBBBBLRL","FBBFBFFRLR","FBFBBBBRLL","FFBFFBFLLR","BFFBFFBRLL","FBBBBFFLRL","BFFBFBBRLR","FFBFFFFLLR","BBFFBBFRLR","BFBFBBBRRL","BFFBBBBLRR","FFBBBBBRLL","FFFBBFFRLR","BBFFFFBLRL","BFBBFBFRRL","BBFFBBFRRL","FBFFFFBRLR","FBBFBBBRLR","BBFBFFFLLL","BFBFBBBRLL","BFFFFFFLRL","FBFBFBFRRR","BBFFFFFLRR","FFFBBFBLLR","FBFFBFBRLL","BFBBFBFLLR","FFBFBFFLRL","BFBFFBFRRR","FBBBBBFRLR","FBBFFBBLLR","FBFBBFFLRL","FBFFFBFRRL","BFFBFFFLRR","FFBFBFBLRL","FBFFBBBLRR","BFBBFFFLLR","FBFBBBBRLR","FBFFFBBRRL","FFFBBBFRRL","FBBBBBBLRR","FBBBFBBRRL","FBBBFBBRRR","BFFFBFBLRL","FBBBFFBRLR","BFBFFFBRRR","BFBBFBBLRL","BBFFBBFLRR","FFFBFBFLLR","FFBBBBFRRL","BFBFBFFRRR","FBFBBBBRRR","BFFFBFFRLL","BFBBFBBLLL","FBFBFBBRLR","BFFFBFBRLL","FFBBFFBRLL","FBFFBBFRLL","FBFBFFFRRR","FFBFBBBLLL","BBFFBBBLRR","FBBFFBBRLL","BFFFFFBRRL","FBBFFBFLLL","FBFBFBFLRL","BFFFFBBLRL","BFFBBFBRLL","BFBFFBFRRL","BFBFFFFLRR","FBFFFBFRRR","BBFFBBBLLR","FBFBFBFRRL","BFFBFBBLRL","FFFBFBBRLR","BBFFFBFLRL","BFBFFBFLLR","BBFFBFBRRL","FBBFFFBRRL","FFBFFFFLLL","BFBFBFFLLL","BFBFFFBLRR","FBBBFFBLRR","FFBBFFBLLR","BBFFFBBLRR","BBFBFFBLRL","BFFFBBFRLL","FBFFBFFRRR","FFBBBFBLRL","FFBFBFFRRR","BFFFFFFLLR","BFFFFBBRRL","FBFBBBFLRL","BFFFFBFLRL","FBFBBBFRLL","FFBFBFBRRR","FFFBFBBRRR","FBBBFFBRLL","FBFFBBFRLR","FFBFBBFRLR","FBBFFFBLLL","BBFFBBBRLR","FBBFFFFLRR","BBFFFBFRLL","FBBBBBBRLR","BFBBFFBLLR","BFBFBBBLRR","FFBBFBBRLL","FFFBFBBLLL","BFBBBFFRLR","FBFBFFFLRL","BFFBBFBLLR","BFBBFFFLRL","BFBBFFBLRR","FBFFFFBLRL","FBFBFBFLRR","FBBFFFFLRL","FFBFBBBLLR","FBFBFBBRRR","BFBBBBFLRL","BFBFBFBLRL","BFFBFBFLRL","BBFFFFBRRL","FFBFFFBLRR","BBFBFFBRRL","FFBBBFFLRR","BFFBBBBLRL","FBBBFFFLLR","FFFBBBFRLR","BBFBFBFLLR","BFBFBFFRRL","FBFBFFBRRR","FBFFBFFLRL","FFBBFFFLLL","BFFBBFBLLL","BBFFFFFLRL","FFBFBBBRRR","FFBFFBFLLL","FFBBBBFLRL","FFBBFFFRLR","BFBFFFBLLL","FBFFFFFRRR","FBBFFBBLRL","BFFFFBFRRL","BFFFFBFRLR","FFBFBFFRLL","BBFFBFFRRL","FBFFBBBRRR","FFBBBFFRRR","BFFBBBBRLR","FFBBFBBRLR","BFBBFBBRLR","FBFFBBBLLR","BFFFFBBLRR","FBBFBFBRRL","FBBFBFBRLR","FBBBBFFLRR","FBFFFFBLRR","FFBFBBFLLL","FBBFFBBLRR","FBFBFFFLLL","FBFFFBBLRR","FBBFBFFLLL","FBBBFBFRLL","FFBBFBBLRL","BFBFFBBRRR","BFFBBBBLLR","FBFFBFBLRR","FBBBBBBLLR","FBBFBBFLRL","BFBFBFBRLR","FBBFFFFRLR","BFFBFBBLLL","BFBFFFBRLL","BFFBBBBRLL","BFBFBBFLLR","FBFFBFFRLR","BFFBBFBRRR","FBBBFFFLLL","BFFBFBFRRL","FBFFBFFRLL","FFBBBFFLRL","FBFFBFFRRL","BBFFBFBRLR","FBBFBBBRLL","FBFBBFBRRL","FBFBBFFLLR","BFFBFFBLRR","FFBBFBFRRR","BFFBBBFRRL","FFBFBFBRRL","BBFFBFFLLR","FBBBBFFLLR","FBBFBFBLLL","BFBBBBFRLL","FFBBBBFLLL","FBBBFBBRLL","BFFBFBFLLR","FBFFFFFLLR","FBBFBFBRLL","FBFBBBFLLR","FBFBFBBLLL","FFFBBBBLLR","FFBBBBFRRR","FBBFFFBLRL","BBFFBFBLLR","BFBBFFFRLR","BBFBFFBRLL","BFBBBFBLRL","BFBBBFFRRL","FBFBFFBRLL","BBFBFFFLRL","BFBFBFBRRL","BFFFBFFLLL","FBFFFFFLLL","FBFBBBBRRL","FBFFBFBRRL","BFBFBFFRLR","FBFBFFFRRL","BFBBBBFLLR","FBBBBBFLRL","FBBBFFBLLL","FBBBFFFRRL","BBFBFBFRRR","FFBFFBBRRL","FFBFBBFRRR","BBFFFBFLLL","BBFFBFBRRR","BFFBBBFLRR","FBFFFFBRLL","FBFFBBBLLL","FFFBBBFLLR","BBFBFFBLLL","FBFBFBFRLR","BFBFBFBLLL","BBFFFFBRRR","FBBBBFBRRR","FBFFFBBRLR","FFFBBFFLLL","FBBFFBFLRR","BFFFBBBRLL","FBBFBFBLRL","FFBFFFFLRL","FFBFFFBLLR","FBBFBBBRRL","BFBBFBFRLL","FFBBBBBLRR","BFFBBFFLRR","FFBFFFBRRR","BFFFFFFRLL","BFFBFFBRRR","FFFBBBFLRL","FFBFBFBRLL","BBFFBBBRRL","BBFBFFFRRR","BBFBFBFLRL","FBBFBBBLRR","FFBBFBFRLR","BFBFBFBLRR","FFFBBBBRRL","BFFFFBBLLL","FFFBBBFLRR","FFBBFFBRRL","FBFFBFFLRR","FBFFBBFRRL","BFBBFBBRRL","BBFFBFBRLL","FBBFFFFRRL","FFBBFFBRLR","BBFFFFBRLR","BBFBFBFRLL","FBBFBBBRRR","BFFBBBBRRL","BFFBBBBLLL","BFBBFBBRLL","BFFBBBFLRL","FBFFBFBLRL","BFFBBFFLLL","BFBFBBFRLL","FBBFFFBRRR","FFBFFBFLRL","FFBFFFFRLR","BFBBFBBLLR","BFBFBFBRRR","FBBFFFFLLR","FFBBFBBRRL","BFFBFFFRRL","FBFBBBFRRL","FBBFFFFLLL","BFFFFFFRRL","BFBFFFBLLR","BFBBFFBRRR","BFFBFFFLLR","FFBBBFBLLL","BFFBBBFLLL","FBFFFBBRRR","FBBBBBFLLL","BFBFFFFRRL","FFBBFFBRRR","BFBFBFFLLR","FFFBFBBLLR","BFBBFFBLRL","FBFBBFFRRR","BFBBBFFLLR","FBBFFFBLLR","BFFFBBFLRR","BFFFFBBRLR","FBFFFBBLRL","BFBBBFBLRR","FBFFBFBLLR","BFBBFFFRLL","FFBBFBFLLL","FFBFFFBRRL","FFBBFBBLRR","FFBFBBFLRL","FFFBBFFRRR","BFBFFBFLRR","BBFFFFBLRR","FFBFBBFLRR","FFFBBFFRLL","FBBBFBBRLR","BBFFFBBRRL","FFFBFBFRRL","FBBBBBBRRR","FFBBBFBLRR","FBBFBFFLRL","FBBBFFFRRR","FBBFFBBRRR","BFFFFBBRRR","FBBFFBFRLR","BFFBFBFRLR","BFBBBFFLRR","FFBFFBFLRR","BFBFFFBLRL","BFFBFBFRLL","FBBBBFBLLL","BBFBFFFRRL","FFBBFFBLLL","FFBFFBBRLR","FFBBBFBRRL","FFBBFFFLRR","BBFFBFFLRR","BFFFBFFRRL","FBFBBFBRRR","FBFFFBFLRL","BBFBFFBLRR","BFFBFBFRRR","BFFFFFFLLL","FBBBFFBLRL","FBBBFBFRRL","BFFBFFBRLR","BFBBBFFRRR","BFFBFFFRRR","FFFBBBBLLL","FFBBBFBRRR","FFBBFBFLLR","BFBBBFBLLL","FBBFBBBLLL","BBFBFBFLLL","BFBBBFBRRR","BFBFBBFRLR","FBFFBFBRLR","BFFBFFFRLL","BFBBFFBRRL","FFBBFBFLRR","FFBBBFBLLR","BBFBFFFRLR","FFBBFBBLLR","FBFFFBBLLR","FBBFBFBLLR","FFBBFBFRLL","BFFFFFBLLR","BFBFBFBLLR","BFBBFFBLLL","FBBBBFBLRR","BFBBBBFLLL","BFFBBFFLLR","FBFBFFFRLL","FBBBBBFLLR","BBFBFFBLLR","BFBFBFFLRR","FBBBBFFRLR","FFFBFBBRRL","FFFBBFBLLL","BFBBBBFLRR","BFBBBBBLRR","FBBFBBFLLL","BFFFBFBRLR","FBBFBFFLRR","FBFFFBBRLL","BFFFFFBRRR","BFFBBBFRLL","FFBFBFBLLL","BFBBFBFLRL","FBBBBFFLLL","FBBFBFFRRR","FFFBBBBRLR","BFBFBFFLRL","FFBBBFFRRL","BBFFBFFLRL","BFFFBBBRRL","FBFFFFFLRL","BBFFBFFRLL","BFFFBBFRLR","BFBFFBBRLR","FBFBFBBLLR","FBBFFBBRRL","BBFFBFFRLR","FFBFFBBRRR","BBFFFBBRLL","BFBFBFBRLL","FBFBBBBLLR","FBFBFBFLLL","FFBFBBBLRL","BFFBFBBLRR","BBFFFFFRRR","FFFBBFFLRL","BBFFFBFLRR","FFBFFBFRLL","FBFFBBFLLR","FBFFFFBLLR","FFBBBBFRLL","FFFBBFFLRR","BBFFFFFLLL","BBFBFBFLRR","FFBBBBFRLR","BBFFFBBLLL","FFBFBBFRLL","BFFFFFFLRR","FFBFFFBRLL","FBFFFFFRRL","BBFFFBBLLR","FFFBBFBRLR","BFFBBFFRRL","FBBBBFFRLL","BFBBFFBRLR","BFFFBFBLRR","BFBFFBBLLR","BFFBFBBRRR","BBFFFBFRRR","FFBBBFFRLL","BFBBFBBRRR","FFBBBBBRLR","BFFFBBBRLR","BFFFBBFLLL","FFBFFBBLRL","FFBBFBFLRL","FBFBFBBLRL","BFFBBFBRLR","FBBBBFBRRL","FBFBBBFRRR","BBFBFFBRRR","BBFBFBFRRL","FBBBBFBRLL","FBFFFBBLLL","BFBFBBFLLL","FBBBBFFRRR","FBBFBBFLRR","FFBFFFFRRL","FFFBFBFRLL","FBFBBFBRLR","FFBBBFFLLR","FBFFBBFLLL","FFFBBBBRRR","BFFFFBFRRR","BFBFFFFLRL","FBFBFFBLLL","BFFBBBBRRR","BFFBFBFLLL","FBFBBFFLLL","FBBFBBFLLR","FBBFBFFLLR","BBFFBFFRRR","FBBBBBFLRR","FFBFBBBRLL","FBBBBBBLLL","BFBBFBBLRR","FBFBFFFRLR","FFBBBBBRRL","FBFFFFBRRR","FBBFFBFRRR","FFFBBBBRLL","FBBFFFFRRR","BFFBFFBLRL","FFFBBBBLRR","BFBBBBFRRL","BFFFFBBLLR","BFFFFFFRLR","BFFBBFFRLR","BFFBBFBLRL","BBFFFFBLLL","BFFFFBBRLL","FBBFFBFRLL","FFFBBFBLRR","BBFBFFBRLR","BFFFBBBLRL","BFBBFFFRRL","BFBFFBFRLL","BFFBFBBRRL","FBFFBFFLLL","BFBBFFBRLL","BFBBBFFLRL","FFFBFBFRLR","BFFBFFBLLR","BBFFFFBLLR","FFBBFBBRRR","FBBFBBFRRR","FFBBBFFLLL","BFBBFFFLRR","FFBFFBFRRR","FBBFBBFRLR","FBFBFFBLRL","BBFFBFBLRL","BFFFFBFLRR","FBBBFFFRLL","FFFBBFFRRL","FFBFBFFRLR","FFBBBBBLLR","BFFBBFBRRL","BFFBFBFLRR","FFFBFBBRLL","FBFBBBBLRR","BFBFFFBRRL","FFBFBBBRRL","FFBFBFFLRR","FFBFBFBLRR","BFFBBFBLRR","FFFBFBFLRL","BFFBFBBRLL","BFFBFFFRLR","FFBBFFBLRR","FBBBBBFRLL","FBFBFBFRLL","BFBBBBBRRR","BBFBFFFLLR","FFBFFFFRLL","FFFBBFFLLR","BFBBFFFRRR","FBBBFBFLLR","BFBBBBBRRL","FBBBBBBLRL","FBBBFBFLLL","BFFBFFBLLL","BFFBFFBRRL","FBFFBFBRRR","FBFBFBBLRR","BFFFBFFRLR","FBFBFBBRRL","BFBBBBBLLL","FBFFBBFLRR","BBFFFBBRRR","FFFBFBBLRR","FBBFFBBLLL","BFFFFFBRLL","BBFBFBFRLR","BFFFBFFLRR","FBFBFFBLRR","BFBBBFBRLR","BBFFBFBLLL","FFBBBBFLLR","FBBBFBFRLR","FBBBBBFRRL","FBBBFFBRRR","FFBBBBFLRR","BBFFBBBRRR","BFFFFBFLLR","FBFFBBFRRR","BBFFFFFRRL","BBFFBBBRLL","FBFFFFBRRL","FBFFBBBLRL","BFFFFFFRRR","BFFFBBBLLR","FBFBBFBLRL","BFBFBBBLRL","FFBBFBFRRL","FBFFBBBRLR","BFFBBBFRLR","FFBFBBBLRR","BFFBFFFLLL","FBBBFFBLLR","BFBFBBFRRL","FFBFFBBLRR","BBFFFBBRLR","FFBFFBBRLL","FBFFFFFRLR","FBBBFBBLRL","BBFFFBFLLR","FBBFFFFRLL","BFFFBBFLRL","BFBBBBBRLR","BFFBFBBLLR","FFBBFFBLRL","BFBBBFBRLL","BFBBFBFRRR","FFBBFFFLRL","FFBFFFBLLL","FFBFFBBLLR","BBFFFBFRRL","BFFBBFFLRL","FBBFFBFLRL","BFFFBBBRRR","FFBBFFFRRL","FFBFBFFRRL","FBBBBFBLRL","BBFFBBFLLR","FBBBBFBRLR","BFBFFBFRLR","FFBFFBBLLL","FFBBBBBLLL","BFBFBBFRRR","BBFFFFFRLL","FBFFFBFRLR","BFBBBBFRLR","FBBFFFBRLR","BFFFFFBLRR","FBFFBBBRRL","FBBBFBFLRL","BFFFBFFLRL","BFBFBBFLRR","BFBBFBFRLR","FFBFFBFRLR","BBFFFBBLRL","BFBFFBFLLL","BBFFBBFRLL","FBBBBBBRRL","FFBBFFFLLR","FFFBBBBLRL","BBFFBFFLLL","FBBBFFFLRR","FBFBFBFLLR","FFBFBFFLLL","FFBFFFBLRL","BFBFFBBLLL","FBFBFFFLRR","BBFFBBFLRL","BFFFBFFRRR","FBFFBBBRLL","FFFBBBFRLL","FBFFFBFLLL","BBFFFBFRLR","BBFFBBFLLL","BBFBFFFRLL","BBFFBBBLLL","FBFBBFBLLL","FBBFBBBLRL","FBFFFFFLRR","FBFBBFBRLL","FFFBBFBRLL","FBBBFBFLRR","FBFBFFFLLR","FFBFFFFRRR","BFFBBFFRLL","BBFFFFBRLL","BFBBBFBLLR","BFBBFBFLLL","FBBBBBFRRR","FFBFBBBRLR","BFFFFBFLLL","BFFFFFBRLR","BFBFFFFLLL","BFBFFBBRRL","FFBFFBFRRL","FBBBFBBLRR","BFBFFBFLRL","FBBBBBBRLL","FFFBBFBLRL","FFBFBBFLLR","BFBFBBBLLR","FBFBBFFRLR","FBFBFFBLLR","BBFFBBBLRL","BFBFFBBLRR","FFBBFFFRRR","FBFBBBFRLR","BFBBFBFLRR","FBBFBFFRRL","FBFBBFFLRR","FBBFBFBRRR","FBFBBBFLRR","BFBBBBBLLR","FBFFFBFLLR","FBFBBFBLLR","FFBFFFFLRR","BFBFBBBRLR","FBFFFFFRLL","FFBBBBBLRL","BFBBBFFLLL","BBFFFFFLLR","BFFFBBFRRR","FBFBFFBRRL","FFFBBFBRRR","FBBBFBBLLR","BFFFFBFRLL","BFBFBFFRLL","BFBFBBFLRL","FFBBBFFRLR","BFBFBBBLLL","BFFFBBBLRR","BFBBFFFLLL","FBFBFBBRLL","BFFFFFBLLL","BBFBFFFLRR","BFBFFBBRLL","FFBFBBFRRL","FBFBBBFLLL","FBFFFFBLLL","FBFFBFFLLR","FBBFBBFRRL","BBFFBBFRRR","BFFFBFBRRL","BFBFFFBRLR","FBBFFBFLLR","BFBFFFFRLL","BFBFBBBRRR","BFBFFFFRLR","FFBFBFBLLR","FBFFFBFLRR","FFBBBBBRRR","FBBFFFBLRR","FFBFFFBRLR","BFFFBFBRRR","FBBFBBBLLR","BFBBBBBLRL","FBBBFFFLRL","BFFBBFFRRR","BFBBBFFRLL","BFBFFFFLLR","BFFBFFFLRL","BFBFFFFRRR","BBFFFFFRLR","FBFFFBFRLL","FFFBBBFRRR","BFFFBFBLLR","FBBFBFFRLL","FBBBFBBLLL","BFBBBBBRLL","BFFBBBFRRR","FFFBFBFRRR","BFBBBFBRRL","FBFFBFBLLL","FBBBFFFRLR","FBFBBFFRRL","FBBFFBFRRL","FBBFBFBLRR","BFFFFFBLRL","FBBBFBFRRR","BFFFBBBLLL","FFBBBFBRLL"]
import Data.List.Utils (replace) import Data.Char(digitToInt) import Data.List ((\\))
-- chars = "FBLR" -- vals = "0101" dec2bin :: String -> Int dec2bin = foldl (\acc x -> acc * 2 + digitToInt x) 0 subst :: String -> String subst = replace "R" "1" . replace "L" "0" . replace "B" "1" . replace "F" "0" ticketNos = map (dec2bin . subst) tickets maximum ticketNos
855

Part 2

(mn, mx) = (minimum ticketNos, maximum ticketNos) allTickets = [mn..mx] allTickets \\ ticketNos
[552]

Day 6

Part 1

inp <- readFile "day6.txt"
import Data.List.Split (splitOn) -- split import Data.List.Utils (replace) -- MissingH import Data.Set(fromList, size, intersection) import Data.List ((\\))
sum $ map (size . fromList . replace "\n" "") (splitOn "\n\n" inp)
6335

Part 2

inp <- readFile "day6.txt"
sum $ map (size . foldl1 intersection . map fromList . splitOn "\n") (splitOn "\n\n" inp)
3392

Day 7

Part 1

import Data.Set(Set, fromList, size, intersection) import Data.String.Utils (strip, split) -- MissingH import qualified Data.Graph as G
{-# LANGUAGE QuasiQuotes #-} import Text.RE.Replace -- regex import Text.RE.TDFA.String -- regex
inp_raw <- readFile "day7test.txt" inp = lines inp_raw
cleanStr :: String -> String cleanStr src = strip $ replaceAll "" $ src *=~ [re|(bag(s)?)|([0-9]*)|(\.)|( )|] --remove bag(s), numbers, (.), whitespace.
extractRule :: String -> (String, [String]) extractRule r = let r0 = split "contain" r rl = cleanStr (head r0) rh = map cleanStr $ head $ map (split "," . cleanStr) (drop 1 r0) in (rl, rh)
extractRule "light red bags contain 1 bright white bag, 2 muted yellow bags."
("lightred",["brightwhite","mutedyellow"])
rules = map extractRule inp rules
[("lightred",["brightwhite","mutedyellow"]),("darkorange",["brightwhite","mutedyellow"]),("brightwhite",["shinygold"]),("mutedyellow",["shinygold","fadedblue"]),("shinygold",["darkolive","vibrantplum"]),("darkolive",["fadedblue","dottedblack"]),("vibrantplum",["fadedblue","dottedblack"]),("fadedblue",["noother"]),("dottedblack",["noother"])]
mapM_ print rules
("lightred",["brightwhite","mutedyellow"]) ("darkorange",["brightwhite","mutedyellow"]) ("brightwhite",["shinygold"]) ("mutedyellow",["shinygold","fadedblue"]) ("shinygold",["darkolive","vibrantplum"]) ("darkolive",["fadedblue","dottedblack"]) ("vibrantplum",["fadedblue","dottedblack"]) ("fadedblue",["noother"]) ("dottedblack",["noother"])
G.buildG

.

.

.

.

.

.

.

.

.

.

.