import Data.Array as Array ( Array )
import Data.Array.Base ( (!), listArray )
import Data.List (group)

primes :: [Int]
primes = 2 : filter (null . tail . (pfa !)) [3, 5 ..]

ub :: Int
ub = 28123

pfa :: Array Int [Int]
pfa = listArray (2, ub) $ map pf [2..ub]

pf :: Int -> [Int]
pf n = factor n primes
  where
    factor n (p : ps)
      | p * p > n = [n]
      | n `mod` p == 0 = p : pfa ! (n `div` p)
      | otherwise = factor n ps

groupFactors :: [Int] -> [[Int]]
groupFactors xs = [[head x, length x] | x <- group xs]

genDiv :: [[Int]] -> [Int]
genDiv = foldr combine [1]
  where
    combine [p, n] acc
      = [x * p^e | x <- acc, e <- [0..n]]

sumProperDivisors :: Int -> Int
sumProperDivisors n
  = -n + sum (genDiv $ groupFactors $ pfa ! n)

isAbundant :: Int -> Bool
isAbundant n = sumProperDivisors n > n

abdSieve :: Array Int Bool
abdSieve = listArray (2, ub) $ map isAbundant [2..ub]

abundantNumbers :: Int -> [Int]
abundantNumbers m
  | m > ub = filter isAbundant [2..m]
  | otherwise = filter (abdSieve !) [2..m]

abundantList :: [Int]
abundantList = abundantNumbers ub

isAbundantSum :: Int -> Bool
isAbundantSum n 
  = any (\a -> abdSieve ! (n-a))
    $ takeWhile (<= n `div` 2) abundantList

notAbundantSumsList :: Int -> [Int]
notAbundantSumsList m
  = filter (not . isAbundantSum) [1..m]

λ> :set +s
λ> sum (notAbundantSumsList ub)
4179871
(1.14 secs, 1,772,425,584 bytes)
λ> 

— Me@2024-10-19 09:53:30 PM

.

.

2024.10.21 Monday (c) All rights reserved by ACHK