improve code

This commit is contained in:
Michael Zhang 2020-12-04 18:57:18 -06:00
parent 6876e45877
commit 70a8c18a27
Signed by: michael
GPG key ID: BDA47A31A3C8EE6B

77
4.hs
View file

@ -6,49 +6,23 @@ import Data.List
import Data.List.Extra (stripSuffix) import Data.List.Extra (stripSuffix)
import Data.List.Split import Data.List.Split
import Data.Maybe import Data.Maybe
import Debug.Trace
import Text.Read import Text.Read
import Data.Set (Set, fromList, isSubsetOf)
data Attr data Attr = Byr | Iyr | Eyr | Hgt | Hcl | Ecl | Pid | Cid
= Byr
| Iyr
| Eyr
| Hgt
| Hcl
| Ecl
| Pid
| Cid
deriving (Show, Bounded, Enum, Eq, Ord) deriving (Show, Bounded, Enum, Eq, Ord)
type Passport = [Attr] intval :: Int -> Int -> Int -> Maybe Int
intval lo hi n = guard (n >= lo && n <= hi) $> n
intval :: (Int, Int) -> Int -> Maybe Int
intval (lo, hi) = \n ->
if n >= lo && n <= hi then Just n
else Nothing
nDigits :: Int -> String -> Maybe String nDigits :: Int -> String -> Maybe String
nDigits n = \s -> nDigits n s = guard (length s == n && all isDigit s) $> s
if length s == n && all isDigit s then Just s
else Nothing
hexColor :: String -> Maybe String hexColor :: String -> Maybe String
hexColor s = hexColor s = guard (length s == 7 && s !! 0 == '#' && all (\c -> elem c "0123456789abcdef") (drop 1 s)) $> s
if length s == 7
&& s !! 0 == '#'
&& all (\c -> elem c "0123456789abcdef") (drop 1 s) then Just s
else Nothing
validEcl :: String -> Bool validEcl :: String -> Bool
validEcl s = case s of validEcl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
"amb" -> True
"blu" -> True
"brn" -> True
"gry" -> True
"grn" -> True
"hzl" -> True
"oth" -> True
_ -> False
parseAttr :: String -> Maybe Attr parseAttr :: String -> Maybe Attr
parseAttr s = parseAttr s =
@ -56,13 +30,13 @@ parseAttr s =
let key = parts !! 0 in let key = parts !! 0 in
let value = parts !! 1 in let value = parts !! 1 in
case key of case key of
"byr" -> (readMaybe value >>= intval (1920, 2002)) $> Byr "byr" -> (readMaybe value >>= intval 1920 2002) $> Byr
"iyr" -> (readMaybe value >>= intval (2010, 2020)) $> Iyr "iyr" -> (readMaybe value >>= intval 2010 2020) $> Iyr
"eyr" -> (readMaybe value >>= intval (2020, 2030)) $> Eyr "eyr" -> (readMaybe value >>= intval 2020 2030) $> Eyr
"hgt" -> "hgt" ->
((stripSuffix "cm" value >>= readMaybe >>= intval (150, 193)) <|> let inch = stripSuffix "cm" value >>= readMaybe >>= intval 150 193 in
(stripSuffix "in" value >>= readMaybe >>= intval(59, 76))) let cm = stripSuffix "in" value >>= readMaybe >>= intval 59 76 in
$> Hgt (inch <|> cm) $> Hgt
"hcl" -> hexColor value $> Hcl "hcl" -> hexColor value $> Hcl
"ecl" -> if validEcl value then Just Ecl else Nothing "ecl" -> if validEcl value then Just Ecl else Nothing
"pid" -> nDigits 9 value $> Pid "pid" -> nDigits 9 value $> Pid
@ -70,28 +44,25 @@ parseAttr s =
_ -> Nothing _ -> Nothing
processLine :: String -> Maybe [Attr] processLine :: String -> Maybe [Attr]
processLine line = sequence $ (map parseAttr $ splitOn " " line) processLine = mapM parseAttr . splitOn " "
requiredAttrs :: [Attr] requiredAttrs :: Set Attr
requiredAttrs = enumFromTo Byr Pid requiredAttrs = fromList $ enumFromTo Byr Pid
combineAttrs :: [Attr] -> Maybe Passport combineAttrs :: [Attr] -> Maybe [Attr]
combineAttrs attrs = combineAttrs attrs = guard (isSubsetOf requiredAttrs $ fromList $ attrs) $> attrs
let intersection = intersect attrs requiredAttrs in
if sort intersection == sort requiredAttrs then Just attrs
else Nothing
processPassport :: [String] -> Maybe Passport processPassport :: [String] -> Maybe [Attr]
processPassport lines = concat <$> (sequence $ map processLine lines) >>= combineAttrs processPassport = combineAttrs . concat <=< mapM processLine
processLines :: [String] -> [Maybe Passport] processLines :: [String] -> [Maybe [Attr]]
processLines lines = map processPassport $ splitWhen (== "") lines processLines = map processPassport . splitWhen (== "")
countValid :: [Maybe Passport] -> Int countValid :: [Maybe [Attr]] -> Int
countValid = length . filter isJust countValid = length . filter isJust
main :: IO () main :: IO ()
main = do main = do
content <- readFile "4.txt" content <- readFile "4.txt"
let valid = countValid $ processLines $ lines content let valid = countValid $ processLines $ lines content
putStrLn (show valid) print valid