Euler problem 21.2.1

.

primes :: [Integer]
primes = 2 : filter (null . tail . primeFactors) [3, 5 ..]

primeFactors :: Integer -> [Integer]
primeFactors n = factor n primes
  where
    factor n (p : ps)
      | p * p > n = [n]
      | n `mod` p == 0 = p : factor (n `div` p) (p : ps)
      | otherwise = factor n ps

groupFactors :: [Integer] -> [[Integer]]
groupFactors = gf []
  where
    gf acc lst
      | null lst = reverse acc
      | null acc = gf [[p,1]] ps
      --
      | p == head (head acc) =
        gf ([p, head (tail (head acc)) + 1]:tail acc) ps
      --  
      | otherwise = gf ([p,1]:acc) ps
      where
        p = head lst
        ps = tail lst

generateDivisors :: Integral b => [[b]] -> [b]
generateDivisors xs = go xs 1
  where
    go [] acc = [acc]
    go (pe:ps) acc = concat [go ps (acc*p^e) | e <- [0..n]]
      where
        p = head pe
        n = pe !! 1

sumProperDivisors :: Integer -> Integer
sumProperDivisors n
  = -n + sum (generateDivisors
              (groupFactors (primeFactors n)))

amicableNumbers :: Integer -> [Integer]
amicableNumbers limit
  = [a | a <- [1..(limit-1)],
      let b = sumProperDivisors a, 
            a == sumProperDivisors b,
            a /= b]

λ> :set +s
λ> sum (amicableNumbers 10000)
31626
(0.35 secs, 511,950,576 bytes)
λ> sum (amicableNumbers 100000)
852810
(4.73 secs, 6,902,354,168 bytes)
λ> sum (amicableNumbers 1000000)
27220963
(66.07 secs, 93,880,279,320 bytes)
λ> 

— Me@2024-08-11 10:40:06 AM

.

.

2024.08.12 Monday (c) All rights reserved by ACHK