Day 2

src/Day2502.hs

@@ -0,0 +1,99 @@
+module Main where
+
+import Data.List (find, nub)
+import Data.Maybe (isNothing)
+
+import Debug.Trace (trace)
+
+-----------------
+----- Utils -----
+-----------------
+
+dropEnd :: Int -> [a] -> [a]
+dropEnd n xs = reverse $ drop n $ reverse xs
+
+split :: Char -> String -> [String]
+split _ ""  = []
+split c str | isNothing $ find (==c) str = [str]
+            | otherwise              = takeWhile (/=c) str : split c (tail $ dropWhile (/=c) str)
+
+-------------------
+----- Problem -----
+-------------------
+
+digitCount :: Int -> Int
+digitCount 0 = 0
+digitCount n = 1 + digitCount (n `div` 10)
+
+splitIntoSeeds :: Int -> (Int, Int)
+splitIntoSeeds n = ( n `div` part , n `mod` part )
+  where
+  l = digitCount n `div` 2
+  part = 10 ^ l
+
+fromSeed :: Int -> Int
+fromSeed n = n + part * n
+  where
+  l = digitCount n
+  part = 10 ^ l
+
+nextValid :: Int -> Int
+nextValid = fromSeed . (+1) . fst . splitIntoSeeds
+
+findFirstNumber :: Int -> Int
+findFirstNumber n | l `mod` 2 == 1 = nextValid $ fromSeed $ 10 ^ seedLength - 1
+                  | otherwise      = fromSeed seed
+  where
+  l = digitCount n
+  seedLength = digitCount n `div` 2
+
+  (a,b) = splitIntoSeeds n
+  seed = if b > a then a+1 else a
+
+part1 :: String -> Int
+part1 str = sum $ map runOne bounds
+  where
+  bounds :: [(Int, Int)]
+  bounds = (map ((\(x:y:_) -> (read x, read y)) . split '-') .  split ',' . dropEnd 1) str
+
+  runOne :: (Int, Int) -> Int
+  runOne (lo,hi) = go $ findFirstNumber lo
+    where
+    go :: Int -> Int
+    go n | n > hi    = 0
+         | otherwise = n + go (nextValid n)
+
+
+partition :: Int -> Int -> [Int]
+partition n size = map (\it -> (n `div` (10 ^ (size*it))) `mod` 10 ^ size) [0..shift-1]
+  where
+  l = digitCount n
+  shift = l `div` size
+
+allEqual :: Eq a => [a] -> Bool
+allEqual = (==1) . length . nub
+
+isValidNumber :: Int -> Bool
+isValidNumber n = any (\it -> l `mod` it == 0 && allEqual (partition n it)) [1..l`div`2]
+  where
+  l = digitCount n
+
+part2 :: String -> Int
+part2 str = sum $ map runOne bounds
+  where
+  bounds :: [(Int, Int)]
+  bounds = (map ((\(x:y:_) -> (read x, read y)) . split '-') .  split ',' . dropEnd 1) str
+
+runOne :: (Int, Int) -> Int
+runOne (lo,hi) = go lo
+  where
+  go :: Int -> Int
+  go n | n > hi    = 0
+       | otherwise = (if isValidNumber n then n else 0) + go (n + 1)
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str