commit ccc30ec73637c8ad5f1b62e0983763075f6cbf6f
parent 1a71bf7bf958bbef9c3273895f6468c31538dbc7
Author: Robert Russell <robert@rr3.xyz>
Date: Sat, 6 Dec 2025 23:46:50 -0800
Solve 02
Diffstat:
4 files changed, 95 insertions(+), 1 deletion(-)
diff --git a/01/Main.hs b/01/Main.hs
@@ -30,7 +30,7 @@ part2 = part1 . (>>= expand)
--------------------------------------------------------------------------------
-- Parsing
-data ParseError = ErrorUtf8 Loc | ErrorOther deriving (Show)
+newtype ParseError = ErrorUtf8 Loc deriving (Show)
instance Utf8Error ParseError where
utf8Error = ErrorUtf8
type P a = Parse ParseError a
diff --git a/02/Main.hs b/02/Main.hs
@@ -0,0 +1,90 @@
+module Main (main) where
+
+import Data.ByteString qualified as BS
+import Numeric.Natural (Natural)
+import Sparsec
+import System.Exit (die)
+
+--------------------------------------------------------------------------------
+-- Util
+
+divides :: Natural -> Natural -> Bool
+d `divides` n = d /= 0 && n `mod` d == 0
+
+numDigits :: Natural -> Natural -> Natural
+numDigits b = ceiling . logBase @Double (fromIntegral b) . fromIntegral
+
+digits :: Natural -> Natural -> [Natural]
+digits b _ | b < 2 = error "invalid base"
+digits _ 0 = []
+digits b n =
+ let (q, r) = n `divMod` b
+ in r : digits b q
+
+hasConsensus :: (Eq a) => [a] -> Bool
+hasConsensus [] = False
+hasConsensus (x : xs) = all (== x) xs
+
+--------------------------------------------------------------------------------
+-- Solution
+
+-- Idea: We say a number is k-silly iff its base-10 representation consists
+-- of k identical sequences of digits (this is effectively what we get from the
+-- problem statement). Equivalently, a number n is k-silly iff k divides the
+-- number d of base-10 digits in n and the digits in n's base-10^k
+-- representation are identical. We use the latter characterization.
+--
+-- Part 1 asks us to sum all 2-silly numbers in the input ranges.
+-- Part 2 asks us to sum all numbers that are k-silly for some k >= 2.
+
+data Range = Range Natural Natural deriving (Show)
+
+elems :: Range -> [Natural]
+elems (Range l u) = [l .. u]
+
+isSilly :: Natural -> Natural -> Bool
+isSilly k n =
+ let d = numDigits 10 n
+ in k `divides` d && hasConsensus (digits (10 ^ (d `div` k)) n)
+
+isAnySilly :: Natural -> Bool
+isAnySilly n = any (`isSilly` n) [2 .. numDigits 10 n]
+
+part1 :: [Range] -> Natural
+part1 = sum . filter (isSilly 2) . (>>= elems)
+
+part2 :: [Range] -> Natural
+part2 = sum . filter isAnySilly . (>>= elems)
+
+--------------------------------------------------------------------------------
+-- Parsing
+
+-- TODO: We ought to check that the ranges are well-formed (i.e., l <= u).
+
+newtype ParseError = ErrorUtf8 Loc deriving (Show)
+instance Utf8Error ParseError where
+ utf8Error = ErrorUtf8
+type P a = Parse ParseError a
+
+pRange :: P Range
+pRange = (\l () u -> Range l u) <$> natural 10 <*> char '-' <*> natural 10
+
+pRanges :: P [Range]
+pRanges = someSepBy pRange (char ',') <* char '\n' <* eof
+
+--------------------------------------------------------------------------------
+-- Main
+
+getInput :: IO [Range]
+getInput = do
+ raw <- BS.getContents
+ case runParse pRanges raw locZero of
+ Ok ranges _ _ -> pure ranges
+ Fail -> die "parse failure"
+ Error e -> die $ "parse error: " ++ show e
+
+main :: IO ()
+main = do
+ input <- getInput
+ print . part1 $ input
+ print . part2 $ input
diff --git a/02/input.txt b/02/input.txt
@@ -0,0 +1 @@
+655-1102,2949-4331,885300-1098691,1867-2844,20-43,4382100-4484893,781681037-781860439,647601-734894,2-16,180-238,195135887-195258082,47-64,4392-6414,6470-10044,345-600,5353503564-5353567532,124142-198665,1151882036-1151931750,6666551471-6666743820,207368-302426,5457772-5654349,72969293-73018196,71-109,46428150-46507525,15955-26536,65620-107801,1255-1813,427058-455196,333968-391876,482446-514820,45504-61820,36235767-36468253,23249929-23312800,5210718-5346163,648632326-648673051,116-173,752508-837824
diff --git a/package.yaml b/package.yaml
@@ -40,3 +40,6 @@ executables:
01:
source-dirs: ./01
main: Main.hs
+ 02:
+ source-dirs: ./02
+ main: Main.hs
