primes :: [Integer] primes = sieve [2..] where sieve [] = [] sieve (p:xs) = p: sieve [x| x<-xs, x `mod` p /=0]
primeFactors :: Integer -> [Integer] primeFactors n =primeFactors' n primes where primeFactors' 1 _ = [] primeFactors' _ [] = [] primeFactors' m (p:xs) | m `mod` p ==0 = p: primeFactors' (divide m p) xs | otherwise = primeFactors' m xs divide m p | m `mod` p ==0 = divide (m `div` p) p | otherwise = m
largestPrimeFactor :: Integer -> Integer largestPrimeFactor n= last $ primeFactors n
P4 回文数的分解
这里学习如何用 Haskell 写循环,对于不熟悉的人来说,还是有点挑战的。首先遍历 x 和 y,y 从大到小,如果 y 到达下界,就 x-1,重置 y,直到 x 到达下界返回。
isPalindrome :: Int -> Bool isPalindrome n = n == reverseNum n where reverseNum :: Int -> Int reverseNum = go 0 where go acc 0 = acc go acc x = let (q, r) = x `quotRem` 10in go (acc * 10 + r) q
largestPalindromeProduct :: Int -> Int largestPalindromeProduct n = go 0 upperBound (divisible11 upperBound) where lowerBound = 10 ^ (n - 1) upperBound = 10 ^ n - 1 go maxPalin x y | x < lowerBound = maxPalin | y < lowerBound = go maxPalin (x - 1) (divisible11 (x-1)) | isPalindrome currentPalin = go (max maxPalin currentPalin) (x-1) (divisible11 (x-1)) | otherwise = go maxPalin x (y - 11) where currentPalin = x * y divisible11 m = m - m `mod` 11
P5 最小公倍数
最小公倍数 x,事实上是覆盖 a 和 b 的质数因子的最小数。比如 6=2*3, 8= 2*2*2,那么最小公倍数要有 3 个 2,1 个 3,也即 2*2*2*3=24。多个数也是一样的。
1 2 3 4 5 6 7 8 9 10 11
lcmRangeImproved :: Integer -> Integer lcmRangeImproved n = product $ map maxPower primesInRange where primesInRange = takeWhile (<= n) primes maxPower p = p ^ maxExponent p maxExponent p = last $ takeWhile (\x -> p ^ x <= n) [1 ..] primes :: [Integer] primes = sieve [2 ..] where sieve [] = [] sieve (p : xs) = p : sieve [x | x <- xs, x `mod` p /= 0]
那么 a+b+c=2m(m+n),所以 m 和 n 实际上只有很少的选择,再然后考虑去除倍数的影响,确保 m 和 m+n 互素。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
findPythagoreanTripletImproved :: Integer -> Maybe [(Integer, Integer, Integer)] findPythagoreanTripletImproved totalSum | odd totalSum = Nothing | null candicates = Nothing | otherwise = Just $ map getSides candicates where candicates = let relativePrimeFac (x, y) = (x `div` d, y `div` d, d ^ 2) where d = gcd x y in [relativePrimeFac (a, b) | (a, b) <- factors $ totalSum `div` 2, b < 2 * a] getSides (m, k, d) = (d * a, d * b, d * c) where n = k - m a = m ^ 2 - n ^ 2 b = 2 * m * n c = m ^ 2 + n ^ 2 factors :: Integer -> [(Integer, Integer)] factors x = [(a, x `div` a) | a <- [2 .. (floor . sqrt $ fromInteger x)], x `mod` a == 0]
P12 三角形数的因子个数
三角形数有特征的,满足n(n+1)/2,然后因子个数实际是质因子的组合,对于每类质因子a,如果有 ma个,那就可以选择 0 到 ma 个 a 组成一个因子,所以 m+1 种选择。为了复用质因数列表,于是用了 State Monad。
typePrimeState = State [Int] firstDivsorsN2 :: Int -> Int firstDivsorsN2 num = evalState (findFirstDivisor num) (sieve [2 ..]) where findFirstDivisor :: Int -> PrimeStateInt findFirstDivisor n = head <$> filterM (fmap (> n) <$> divisorNum) triNum
divisorNum :: Int -> PrimeStateInt divisorNum m = product <$> (map (succ . length) . group <$> primeFactors m)
primeFactors :: Int -> PrimeState [Int] primeFactors num = gets $ \ps -> factorize num ps where factorize 1 _ = [] factorize _ [] = [] factorize m (p : ps) | m `mod` p == 0 = p : factorize (m `div` p) (p : ps) | otherwise = factorize m ps
sieve (p : xs) = p : sieve [x | x <- xs, x `mod` p /= 0] triNum = [m * (m + 1) `div` 2 | m <- [1 ..]]
P14 最长 Collatz 序列
序列长度的递推关系很清晰,但是最好要记录下状态,可以在已有的状态上递推,所以用 State Monad。之后比较长度即可。
-- | Finds the starting number under a given limit which produces the longest Collatz sequence. -- 'n' is the upper limit for the starting number. longestUnder :: Integer -> Integer longestUnder n = fst $ maximumBy (comparing snd) $ zip [1 .. n] (map collatzLen [1 .. (n - 1)]) where -- \| Computes the length of the Collatz sequence for a given starting number. collatzLen 1 = 1-- Base case: sequence length is 1 for starting number 1. collatzLen start | even start = 1 + collatzLen (start `div` 2) -- If 'start' is even. | otherwise = 1 + collatzLen (3 * start + 1) -- If 'start' is odd.
-- Type aliases for readability. typeCache = Map.MapIntInt
typeCollatzState = StateCache
-- | An optimized version of 'longestUnder' using the State Monad for caching. longestUnder2 :: Int -> Int longestUnder2 m = fst $ maximumBy (comparing snd) $ evalState (mapM collatzPair [1 .. m - 1]) Map.empty where -- \| Creates a pair (starting number, sequence length) for each number. collatzPair :: Int -> CollatzState (Int, Int) collatzPair num = (num,) <$> collatzLen num
-- \| Computes the Collatz sequence length with caching. collatzLen :: Int -> CollatzStateInt collatzLen 1 = return 1-- Base case: sequence length is 1 for starting number 1. collatzLen n = do cache <- get maybe (updateCache n) return (Map.lookup n cache) where -- \| Updates the cache with the new sequence length if not already cached. updateCache num = do len <- collatzLen $ if even num then num `div` 2else3 * num + 1 modify (Map.insert num (1 + len)) return (1 + len)
-- | Main function to print the starting number under 1,000,000 with the longest Collatz sequence. main :: IO () main = print $ longestUnder2 1000000
P15 走格子路径的方式
1 2 3 4 5 6 7 8 9
latticePaths2 side = dp !! side !! side where dp = [[lattice x y | y <- [0 .. side]] | x <- [0 .. side]] lattice 0 _ = 1 lattice _ 0 = 1 lattice x y = dp !! (x - 1) !! y + dp !! x !! (y - 1)
latticePaths3 :: (Integral a) => a -> a latticePaths3 side = numerator $ product [(side + i) % i | i <- [1 .. side]]
可以直接看代码,每个点的来源是左边或者上面的点,所以动态规划就可以了。不过呢,其实也是有组合公式,因为每个点的路径,实际上是 d(down)r(right),这样 ddrddrr 的序列组合,这样就到达了(4,3)。7 个位置选出 3 个给 r 就是一种走法。
P18 路径之和
step 函数是从最后一行和倒数第二行开始,计算得到从最后一行到倒数第二行的每个数字最大的和,然后这个列表继续和倒数第三行操作,最后就剩下一个数。记 si,j 为从上到下到第 i 行第 j 列的数 ni,j 的路径之和。那么
-- | Computes the maximum path sum in a triangle. -- The triangle is represented as a list of lists, where each list is a row in the triangle. maxPathSum :: [[Int]] -> Int maxPathSum [] = 0-- Base case: if the triangle is empty, the max sum is 0. maxPathSum tri = head $ foldr1 step tri where -- \| 'step' combines two rows of the triangle into one by choosing the maximum adjacent numbers. -- It is used as the function in a right fold to accumulate the maximum path sum. step [] _ = [] -- Base case for the step function when the last row is empty. step _ [] = [] -- Base case for the step function when the next row is empty. step lastRow@(x : xs) nextRow@(y : ys) = (x + max y (head ys)) : step xs ys -- Calculate the max sum for each position in the row.
-- 'foldr1' is used to apply 'step' function starting from the bottom of the triangle, -- eventually reducing the entire triangle to a single row containing only the max path sum.
Problem 21 - 40
P21 Amicable Numbers
这里实际想要证明,因子之和,其实有一个公式。显然对于质数 p 有:
σ(p)=p+1
对于质因子只有 p 的数 Pa有
σ(pa)=i=0∑api=p−1pa+1−1
这是因为因子只能是几个 1 或者 p 的倍数。
考虑如果一个数有 2 个不同质因数 p 和 q 组成,分别由 a 和 b 个,那么质因数组成的方式是 p 选出若干个,q 选出若干个,实际上就是下面多项式相乘的方式
import Control.Monad.State import Data.List (group, nub) importqualified Data.Map as Map
-- | Calculates the sum of amicable numbers under a given limit. sumAcicable :: Int -> Int sumAcicable num = sum $ acicable (num - 1) where -- \| Generates a list of amicable numbers up to a given limit. acicable n = [a | a <- [2 .. n], let b = sumDivisors a, a == sumDivisors b, a /= b]
-- \| Calculates the sum of proper divisors of a number. sumDivisors n = foldr (\(x, y) acc -> acc + x + y) 1 (factors n)
-- \| Generates a list of factors of a number along with their complementary factors. factors x = [(a, if a * a == x then0else x `div` a) | a <- [2 .. (floor . sqrt $ fromIntegral x)], x `mod` a == 0]
-- | An alternative implementation using the State Monad for caching. sumAcicable2 :: Int -> Int sumAcicable2 num = evalState (acicable (num - 1)) Map.empty where -- \| Generates a list of prime numbers up to half the given limit. primes = sieve [2 .. num `div` 2]
-- \| Calculates the sum of amicable numbers using a State Monad for caching. acicable :: Int -> State (Map.MapIntInt) Int acicable n = sum <$> mapM evaluateDivisors [2 .. n]
-- \| Evaluates and returns an amicable number if conditions are met, using cached results. evaluateDivisors :: Int -> State (Map.MapIntInt) Int evaluateDivisors a = do b <- sumDivisors a bDivSum <- sumDivisors b if bDivSum == a && a /= b then return a else return 0
-- \| Computes the sum of divisors of a number, with caching. sumDivisors :: Int -> State (Map.MapIntInt) Int sumDivisors n = do cache <- get caseMap.lookup n cache of Just s -> return s Nothing -> do let facs = primeFactors n primes exponents = map length $ group facs deltas = zipWith (\p a -> (p ^ (a + 1) - 1) `div` (p - 1)) (nub facs) exponents s = product deltas - n modify (Map.insert n s) return s
-- \| Generates the prime factors of a number. primeFactors :: Int -> [Int] -> [Int] primeFactors 1 _ = [] primeFactors _ [] = [] primeFactors m (p : ps) | m `mod` p == 0 = p : primeFactors (m `div` p) (p : ps) | otherwise = primeFactors m ps
-- \| Generates a list of prime numbers using the sieve method. sieve :: [Int] -> [Int] sieve [] = [] sieve (p : xs) = p : sieve [x | x <- xs, x `mod` p /= 0]
-- | Main function to print the sum of amicable numbers under 10000. main = print $ sumAcicable2 10000
先考虑当 10 和 n 互质的时候,构成循环群{10kmodn∣k∈N∗},而且那么循环群的阶是最小使它余 1 的数,而且必然是 φ(n)的因子。显然如果φ(n)是质数,那么阶就是φ(n)。
这是因为群是闭合的,任意两个群元素的乘积仍然是群的元素。如果我们考虑 akmodm 的所有可能的幂,这个集合在模 m 的乘法下也是闭合的。那么如果 a 生成了一个循环群,那么这个群的阶(即群中元素的个数)就是最小的正整数 k,使得 ak≡1(modm)。这个阶 k 必须整除任何 ax≡1(modm) 成立的 x,包括 ϕ(m)
-- Generates the decimal representation of 1/deno after the decimal point. afterPoint :: Int -> [Int] afterPoint = afterPoint' 1 where afterPoint' num deno = let (d, r) = (10 * num) `divMod` deno -- Multiplies numerator by 10, divides by denominator, and keeps remainder. in d : afterPoint' r deno -- Recursively continues with remainder as new numerator.
-- Calculates the length of the recurring cycle in the decimal representation of 1/deno. recurCycle :: Int -> Int recurCycle deno = recurCycle' onlyCycle maxPossibleLen where maxSkip = myLog2 deno -- Determines the number of digits to skip based on log base 2 of denominator. onlyCycle = drop maxSkip $ afterPoint deno -- Skips initial digits that don't participate in the cycle. maxPossibleLen = deno - 1-- The maximum possible cycle length is deno - 1. recurCycle' xs len | all (== 0) (take maxPossibleLen xs) = 0-- If all digits are zero, cycle length is 0. | whenLen len && not (any whenLen (factors len)) = len -- Checks if current length satisfies cycle conditions. | otherwise = recurCycle' xs (len - 1) -- Otherwise, decreases length and tries again. where whenLen l = (l /= 0) && listEq (take l xs) (drop l xs) -- Checks if two subsequences of length l are equal. myLog2 :: Int -> Int myLog2 num = floor $ logBase 2 (fromIntegral num) -- Calculates the floor of log base 2 of a number. listEq [] _ = True-- Base case for equality check: empty list is equal to any list. listEq (x : xs) (y : ys) = (x == y) && listEq xs ys -- Recursive case: checks if heads are equal and proceeds to tails.
-- Generates the list of factors of a number by finding divisors up to the square root and their complements. factors :: Int -> [Int] factors num = let halfFactors = filter ((== 0) . mod num) [2 .. floor . sqrt $ fromIntegral num] in halfFactors ++ map (div num) (reverse halfFactors)
观察到,循环节的长度 n 和分母有关,或者说由分母决定。只要能把分母转化成10n−1的形式,那么一定是循环小数。也就是说,对于分数 a/b,找到正整数n,使得b∣10n−1,那么这个 n 就是循环节。
代码如下,需要避免整数溢出:
1 2 3 4 5 6 7 8 9
-- Improved version of recurCycle that utilizes an infinite list of numbers composed entirely of 9s to find the cycle length. recurCycleImprove :: Integer -> Int recurCycleImprove deno | any ((== 0) . mod deno) [2, 5] = 0-- Returns 0 immediately if deno is a multiple of 2 or 5. | otherwise = maybe 0 (+ 1) (findIndex ((== 0) . (`mod` deno)) all9s) -- Finds the cycle length using an index in the all9s list.
-- Generates an infinite list of integers where each integer is composed entirely of 9s. all9s :: [Integer] all9s = map (\n -> 10 ^ n - 1) [1 :: Integer ..]