2020-04 in haskell

2020/04-Passport_Processing/example

@@ -0,0 +1,14 @@
+ecl:gry pid:860033327 eyr:2020 hcl:#fffffd
+byr:1937 iyr:2017 cid:147 hgt:183cm
+
+iyr:2013 ecl:amb cid:350 eyr:2023 pid:028048884
+hcl:#cfa07d byr:1929
+
+hcl:#ae17e1 iyr:2013
+eyr:2024
+ecl:brn pid:760753108 byr:1931
+hgt:179cm
+
+hcl:#cfa07d eyr:2025 pid:166559648
+iyr:2011 ecl:brn hgt:59in
+

2020/04-Passport_Processing/first.hs

@@ -0,0 +1,74 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+
+import Control.Applicative.Permutations
+import Control.Monad (void, when)
+import Data.Maybe (catMaybes)
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 2
+
+data Passport = Passport { byr :: String
+                         , iyr :: String
+                         , eyr :: String
+                         , hgt :: String
+                         , hcl :: String
+                         , ecl :: String
+                         , pid :: String
+                         } deriving (Show)
+
+type Parser = Parsec Void String
+
+parseString :: String -> Parser String
+parseString key = do
+  void $ string key
+  void $ char ':'
+  void (optional $ char '#')
+  some alphaNumChar
+
+spaces = char ' ' <|> char '\n'
+
+parsePassport :: Parser (Maybe Passport)
+parsePassport = do
+  (byr, iyr, eyr, hgt, hcl, ecl, pid, cid) <- runPermutation $
+    (,,,,,,,) <$> toPermutationWithDefault Nothing (Just <$> parseString "byr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "iyr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "eyr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "hgt" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "hcl" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "ecl" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "pid" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "cid" <* spaces)
+  void (char '\n')
+  return $ makePassport byr iyr eyr hgt hcl ecl pid cid
+
+makePassport :: Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe Passport
+makePassport (Just byr) ( Just iyr) (Just eyr) (Just hgt) (Just hcl) (Just ecl) (Just pid) _ = Just $ Passport { byr=byr, iyr=iyr, eyr=eyr, hgt=hgt, hcl=hcl, ecl=ecl, pid=pid }
+makePassport _ _ _ _ _ _ _ _ = Nothing
+
+parsePassports :: Parser [Passport]
+parsePassports = do
+  passports <- some (parsePassport)
+  eof
+  return $ catMaybes passports
+
+parseInput :: String -> IO [Passport]
+parseInput filename = do
+  input <- readFile filename
+  case runParser parsePassports filename input of
+    Left bundle -> die $ errorBundlePretty bundle
+    Right passports -> return passports
+
+compute :: [Passport]-> Int
+compute passports = length passports
+
+main :: IO ()
+main = do
+  example <- parseInput "example"
+  let exampleOutput = compute example
+  when  (exampleOutput /= exampleExpectedOutput)  (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+  input <- parseInput "input"
+  print $ compute input

2020/04-Passport_Processing/graou.hs

@@ -0,0 +1,74 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+
+import Control.Applicative.Permutations
+import Control.Monad (void, when)
+import Data.Maybe (catMaybes)
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 2
+
+data Passport = Passport { byr :: String
+                         , iyr :: String
+                         , eyr :: String
+                         , hgt :: String
+                         , hcl :: String
+                         , ecl :: String
+                         , pid :: String
+                         } deriving (Show)
+
+type Parser = Parsec Void String
+
+parseString :: String -> Parser String
+parseString key = do
+  void $ string key
+  void $ char ':'
+  void (optional $ char '#')
+  some alphaNumChar
+
+spaces = char ' ' <|> char '\n'
+
+parsePassport :: Parser (Maybe Passport)
+parsePassport = do
+  (byr, iyr, eyr, hgt, hcl, ecl, pid, cid) <- runPermutation $
+    (,,,,,,,) <$> toPermutationWithDefault Nothing (Just <$> parseString "byr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "iyr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "eyr" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "hgt" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "hcl" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "ecl" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "pid" <* spaces)
+              <*> toPermutationWithDefault Nothing (Just <$> parseString "cid" <* spaces)
+  void (char '\n')
+  return $ makePassport byr iyr eyr hgt hcl ecl pid cid
+
+makePassport :: Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe Passport
+makePassport (Just byr) ( Just iyr) (Just eyr) (Just hgt) (Just hcl) (Just ecl) (Just pid) _ = Just $ Passport { byr=byr, iyr=iyr, eyr=eyr, hgt=hgt, hcl=hcl, ecl=ecl, pid=pid }
+makePassport _ _ _ _ _ _ _ _ = Nothing
+
+parsePassports :: Parser [Passport]
+parsePassports = do
+  passports <- some (parsePassport)
+  eof
+  return $ catMaybes passports
+
+parseInput :: String -> IO [Passport]
+parseInput filename = do
+  input <- readFile filename
+  case runParser parsePassports filename input of
+    Left bundle -> die $ errorBundlePretty bundle
+    Right passports -> return passports
+
+compute :: [Passport]-> Int
+compute passports = length passports
+
+main :: IO ()
+main = do
+  example <- parseInput "example"
+  let exampleOutput = compute example
+  when  (exampleOutput /= exampleExpectedOutput)  (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+  input <- parseInput "input"
+  print $ compute input

2020/04-Passport_Processing/second.hs

@@ -0,0 +1,153 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+
+import Control.Applicative.Permutations
+import Control.Monad (void, when)
+import Data.Maybe (catMaybes)
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+-- import Text.Megaparsec.Debug
+import System.Exit (die)
+
+exampleExpectedOutput = 2
+
+data Passport = Passport { byr :: Int
+                         , iyr :: Int
+                         , eyr :: Int
+                         , hgt :: Int
+                         , hcl :: String
+                         , ecl :: String
+                         , pid :: Int
+                         } deriving (Show)
+
+type Parser = Parsec Void String
+
+parseKey :: String -> Parser ()
+parseKey key = do
+  void (string key)
+  void (char ':')
+
+parseColor :: String -> Parser (Maybe String)
+parseColor key = do
+  value <- try (do
+                   parseKey key
+                   void $ char '#'
+                   v <- some hexDigitChar
+                   spaceBetween
+                   return $ Just v
+               ) <|> skipString key
+  case value of
+    Just v -> if length v == 6 then return value else return Nothing
+    _ -> return Nothing
+
+parseEyeColor :: String -> Parser (Maybe String)
+parseEyeColor key = do
+  parseKey key
+  value <- (Just <$> ( string "amb"
+                     <|> string "blu"
+                     <|> string "brn"
+                     <|> string "gry"
+                     <|> string "grn"
+                     <|> string "hzl"
+                     <|> string "oth"
+           )) <|> ((some $ alphaNumChar <|> char '#') *> return Nothing)
+  spaceBetween
+  return value
+
+parseHeight :: String -> Parser (Maybe Int)
+parseHeight key = do
+  vu <- try (do
+                parseKey key
+                v <- some digitChar
+                u <- string "cm" <|> string "in"
+                spaceBetween
+                return $ Just (v, u)
+            ) <|> skipString key *> return Nothing
+  case vu of
+    Just (value, unit) -> let v = read value
+                          in case unit of
+                               "cm" -> if v >= 150 && v <= 193 then return (Just v) else return Nothing
+                               "in" -> if v >= 59 && v <= 76 then return (Just v) else return Nothing
+                               _ -> return Nothing
+    _ -> return Nothing
+
+parseInt :: String -> Int -> Int -> Parser (Maybe Int)
+parseInt key low high = do
+  parseKey key
+  value <- some digitChar
+  spaceBetween
+  let vv = read value
+  if vv >= low && vv <= high then return $ Just vv else return Nothing
+
+parsePid :: String -> Parser (Maybe Int)
+parsePid key = do
+  value <- try (do
+                   parseKey key
+                   v <- some digitChar
+                   spaceBetween
+                   return $ Just v
+               ) <|> skipString key *> return Nothing
+  case value of
+    Just v -> if length v == 9 then return (Just $ read v) else return Nothing
+    _ -> return Nothing
+
+skipInt :: String -> Parser (Maybe Int)
+skipInt key = do
+  parseKey key
+  void (some $ alphaNumChar <|> char '#')
+  spaceBetween
+  return Nothing
+
+skipString :: String -> Parser (Maybe String)
+skipString key = do
+  parseKey key
+  void (some $ alphaNumChar <|> char '#')
+  spaceBetween
+  return Nothing
+
+spaceBetween :: Parser ()
+spaceBetween = void $ char ' ' <|> char '\n'
+
+parsePassport :: Parser (Maybe Passport)
+parsePassport = do
+  -- (byr, iyr, eyr, hgt, hcl, ecl, pid, _) <- dbg "passport" . runPermutation $
+  (byr, iyr, eyr, hgt, hcl, ecl, pid, _) <- runPermutation $
+    (,,,,,,,) <$> toPermutationWithDefault Nothing (parseInt "byr" 1920 2002)
+              <*> toPermutationWithDefault Nothing (parseInt "iyr" 2010 2020)
+              <*> toPermutationWithDefault Nothing (parseInt "eyr" 2020 2030)
+              <*> toPermutationWithDefault Nothing (parseHeight "hgt")
+              <*> toPermutationWithDefault Nothing (parseColor "hcl")
+              <*> toPermutationWithDefault Nothing (parseEyeColor "ecl")
+              <*> toPermutationWithDefault Nothing (parsePid "pid")
+              <*> toPermutationWithDefault Nothing (skipString "cid")
+  void (char '\n')
+  return $ makePassport byr iyr eyr hgt hcl ecl pid
+
+makePassport :: Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe String -> Maybe String -> Maybe Int -> Maybe Passport
+makePassport (Just byr) ( Just iyr) (Just eyr) (Just hgt) (Just hcl) (Just ecl) (Just pid) = Just $ Passport { byr=byr, iyr=iyr, eyr=eyr, hgt=hgt, hcl=hcl, ecl=ecl, pid=pid }
+makePassport _ _ _ _ _ _ _ = Nothing
+
+parsePassports :: Parser [Passport]
+parsePassports = do
+  passports <- some parsePassport
+  eof
+  return $ catMaybes passports
+
+parseInput :: String -> IO [Passport]
+parseInput filename = do
+  input <- readFile filename
+  case runParser parsePassports filename input of
+    Left bundle -> die $ errorBundlePretty bundle
+    Right passports -> return passports
+
+compute :: [Passport]-> Int
+compute passports = length passports
+
+main :: IO ()
+main = do
+  example <- parseInput "example"
+  let exampleOutput = compute example
+  when  (exampleOutput /= exampleExpectedOutput)  (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+  input <- parseInput "input"
+  print $ compute input