OFFSET
1,2
COMMENTS
LINKS
Jan Behrens, Estimation of the ratios of subsequent highly composite numbers (in German)
PROG
(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
findBigGaps [] = []
findBigGaps [_] = []
findBigGaps (x1:x2:xs)
..| x1 * 3 < x2 * 2 = (x1, x2) : findBigGaps (x2:xs)
..| otherwise = findBigGaps (x2:xs)
main = mapM (putStrLn . show . fst) (findBigGaps highlyCompositeNumbers)
CROSSREFS
KEYWORD
fini,full,nonn
AUTHOR
Jan Behrens (jbe-oeis(AT)magnetkern.de), Jul 17 2009
STATUS
approved