mirror of
https://github.com/fredrikr79/advent_of_code.git
synced 2025-12-27 12:40:21 +01:00
103 lines
3.0 KiB
Haskell
Executable File
103 lines
3.0 KiB
Haskell
Executable File
#! /usr/bin/env nix-shell
|
|
#! nix-shell -p "haskellPackages.ghcWithPackages (p: [ ])"
|
|
#! nix-shell -i runghc
|
|
|
|
-- imports
|
|
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as M
|
|
|
|
import Data.List (isInfixOf, nub)
|
|
|
|
import Control.Monad (liftM2)
|
|
|
|
-- solution composition
|
|
|
|
main :: IO ()
|
|
-- main = print =<< sol2
|
|
main = print $ (\l -> not . any (liftM2 (==) head last) $ windows 2 [0..length (windows 2 l) - 1]) $ "aaa"
|
|
|
|
fileContent :: IO String
|
|
fileContent = readFile "./input"
|
|
|
|
sol :: (LineData -> Bool) -> IO Int
|
|
sol isnice = pure . length . (filter isnice) . M.elems . parseInput =<< fileContent
|
|
|
|
sol1 :: IO Int
|
|
sol1 = sol isNice
|
|
|
|
sol2 :: IO Int
|
|
sol2 = sol isNice'
|
|
|
|
-- input parsing
|
|
|
|
type FileData = Map String LineData
|
|
data LineData = LineData { content :: String
|
|
, vowels :: [Char]
|
|
, vowelCount :: Int
|
|
, consonants :: [Char]
|
|
, consonantCount :: Int
|
|
} deriving Show
|
|
|
|
parseInput :: String -> FileData
|
|
parseInput s = M.fromList $ zip ls $ map parseLine ls
|
|
where ls = lines s
|
|
|
|
parseLine :: String -> LineData
|
|
parseLine l = LineData { content = l
|
|
, vowels = vs
|
|
, vowelCount = length vs
|
|
, consonants = cs
|
|
, consonantCount = length cs
|
|
} where
|
|
vs = filter (`elem`"aoeui") l
|
|
cs = filter (`notElem`"aoeui") l
|
|
|
|
-- helper functions
|
|
|
|
rotate :: Int -> [a] -> [a]
|
|
rotate _ [] = []
|
|
rotate n xs = zipWith const (drop n (cycle xs)) xs
|
|
|
|
windows :: Int -> [a] -> [[a]]
|
|
windows n xs = take (l-n+1) $ map (take n) rots
|
|
where
|
|
l = length xs
|
|
rots = map (`rotate` xs) [0..l-1]
|
|
|
|
isPalindrome :: Eq a => [a] -> Bool
|
|
isPalindrome xs = firstHalf == secondHalf
|
|
where
|
|
firstHalf = take half xs
|
|
secondHalf = reverse $ take half $ reverse xs
|
|
half = (length xs) `div` 2
|
|
|
|
occurenceCount :: (Ord a, Eq a) => [a] -> [Int]
|
|
occurenceCount xs = rec xs M.empty
|
|
where
|
|
rec [] _ = []
|
|
rec (x:xs) mem = case M.lookup x mem of
|
|
Just i -> i : rec xs (M.adjust (+1) x mem)
|
|
Nothing -> 0 : rec xs (M.insert x 1 mem)
|
|
|
|
-- problem solution algorithms
|
|
|
|
isNice :: LineData -> Bool
|
|
isNice ld = atLeastThreeVowels && atLeastOneDoubleLetter && noIllegalSubstrings
|
|
where
|
|
atLeastThreeVowels = vc >= 3
|
|
atLeastOneDoubleLetter = or $ drop 1 $ reverse $ zipWith (==) (rotate 1 l) l
|
|
noIllegalSubstrings = null $ filter (`isInfixOf` l) illegalSubstrings
|
|
illegalSubstrings = ["ab", "cd", "pq", "xy"]
|
|
l = content ld
|
|
vc = vowelCount ld
|
|
|
|
isNice' :: LineData -> Bool
|
|
isNice' ld = containsPairWithoutOverlapping && containsThreeLetterSandwich
|
|
where
|
|
containsPairWithoutOverlapping = containsPair && notOverlapping
|
|
containsPair = any (/=0) $ occurenceCount $ windows 2 l
|
|
notOverlapping = not . any (liftM2 (==) head last) $ windows 2 [0..length (windows 2 l) - 1]
|
|
containsThreeLetterSandwich = not . null $ filter isPalindrome $ windows 3 l
|
|
l = content ld
|