|
(Other) import Data.Ratio
import Data.Set (Set)
import qualified Data.Set as Set
printList :: (Show a) => [a] -> IO()
printList = putStr . concat . map (\x -> show x ++ "\n")
isPrime n
..| n >= 2 = all isNotDivisor $ takeWhile smallEnough primes
..| otherwise = False
..where
....isNotDivisor d = n `mod` d /= 0
....smallEnough d = d^2 <= n
primes = 2 : filter isPrime [ 2 * n + 1 | n <- [1..] ]
primeSynthesis = partialSynthesis 1 primes
..where
....partialSynthesis n _ [] = n
....partialSynthesis n (p:ps) (c:cs) = partialSynthesis (n * p^c) ps cs
primeAnalysis n
..| n < 1 = undefined
..| n == 1 = []
..| n > 1 = reverse $ buildPrimeCounts [0] n
..where
....buildPrimeCounts (c:cs) n
......| n == 1 = (c:cs)
......| n `mod` p == 0 = buildPrimeCounts (c+1 : cs) (n `div` p)
......| otherwise = buildPrimeCounts (0:c:cs) n
......where p = primes !! (length cs)
divisorCount n = product $ map (+1) $ primeAnalysis n
primorialProducts = resFrom 1
..where
....resFrom n = resBetween n (4*n - 1) ++ resFrom (4*n)
....resBetween start end = Set.toAscList $ Set.fromList $ unorderedList
......where
........unorderedList = filter (>= start) (1 : build 0 [])
........build pos exponents
..........| nextNumber <= end = nextNumber : build 0 nextCombination
..........| newPrime = []
..........| otherwise = build (pos + 1) exponents
..........where
............newPrime = pos >= length exponents
............nextCombination
..............| newPrime = replicate (length exponents + 1) 1
..............| otherwise = replicate (pos + 1) ((exponents !! pos) + 1)
..............................++ drop (pos + 1) exponents
............nextNumber = primeSynthesis nextCombination
filterStrictlyMonotonicDivisorCount = filterRest 0
..where
....filterRest _ [] = []
....filterRest lim (num:nums)
......| divisorCount num > lim = num : filterRest (divisorCount num) nums
......| otherwise = filterRest lim nums
highlyCompositeNumbers
..= filterStrictlyMonotonicDivisorCount primorialProducts
findGaps [] = []
findGaps [_] = []
findGaps (x1:x2:xs)
..| x1 * 3 <= x2 * 2 = (x1, x2) : findGaps (x2:xs)
..| otherwise = findGaps (x2:xs)
main = mapM (putStrLn . show . fst) (findGaps highlyCompositeNumbers)
| 