A162935 - OEIS

%I #1 Jun 01 2010 03:00:00

%S 1,2,6,12,60,360,2520,27720

%N Highly composite numbers (A002182) with property that the next highly composite number is more than 3/2 times greater.

%C It can be proved that this sequence is finite, just like A072938, and that there are no further terms.

%C This sequence is a subsequence of A162936.

%H Jan Behrens, <a href="http://www.magnetkern.de/hcn/hcn-verhaeltnisse-2009-07-18.pdf">Estimation of the ratios of subsequent highly composite numbers</a> (in German)

%o (Other) import Data.Ratio

%o import Data.Set (Set)

%o import qualified Data.Set as Set

%o printList :: (Show a) => [a] -> IO()

%o printList = putStr . concat . map (\x -> show x ++ "\n")

%o isPrime n

%o ..| n >= 2 = all isNotDivisor $ takeWhile smallEnough primes

%o ..| otherwise = False

%o ..where

%o ....isNotDivisor d = n `mod` d /= 0

%o ....smallEnough d = d^2 <= n

%o primes = 2 : filter isPrime [ 2 * n + 1 | n <- [1..] ]

%o primeSynthesis = partialSynthesis 1 primes

%o ..where

%o ....partialSynthesis n _ [] = n

%o ....partialSynthesis n (p:ps) (c:cs) = partialSynthesis (n * p^c) ps cs

%o primeAnalysis n

%o ..| n < 1 = undefined

%o ..| n == 1 = []

%o ..| n > 1 = reverse $ buildPrimeCounts [0] n

%o ..where

%o ....buildPrimeCounts (c:cs) n

%o ......| n == 1 = (c:cs)

%o ......| n `mod` p == 0 = buildPrimeCounts (c+1 : cs) (n `div` p)

%o ......| otherwise = buildPrimeCounts (0:c:cs) n

%o ......where p = primes !! (length cs)

%o divisorCount n = product $ map (+1) $ primeAnalysis n

%o primorialProducts = resFrom 1

%o ..where

%o ....resFrom n = resBetween n (4*n - 1) ++ resFrom (4*n)

%o ....resBetween start end = Set.toAscList $ Set.fromList $ unorderedList

%o ......where

%o ........unorderedList = filter (>= start) (1 : build 0 [])

%o ........build pos exponents

%o ..........| nextNumber <= end = nextNumber : build 0 nextCombination

%o ..........| newPrime = []

%o ..........| otherwise = build (pos + 1) exponents

%o ..........where

%o ............newPrime = pos >= length exponents

%o ............nextCombination

%o ..............| newPrime = replicate (length exponents + 1) 1

%o ..............| otherwise = replicate (pos + 1) ((exponents !! pos) + 1)

%o ..............................++ drop (pos + 1) exponents

%o ............nextNumber = primeSynthesis nextCombination

%o filterStrictlyMonotonicDivisorCount = filterRest 0

%o ..where

%o ....filterRest _ [] = []

%o ....filterRest lim (num:nums)

%o ......| divisorCount num > lim = num : filterRest (divisorCount num) nums

%o ......| otherwise = filterRest lim nums

%o highlyCompositeNumbers

%o ..= filterStrictlyMonotonicDivisorCount primorialProducts

%o findBigGaps [] = []

%o findBigGaps [_] = []

%o findBigGaps (x1:x2:xs)

%o ..| x1 * 3 < x2 * 2 = (x1,x2) : findBigGaps (x2:xs)

%o ..| otherwise = findBigGaps (x2:xs)

%o main = mapM (putStrLn . show . fst) (findBigGaps highlyCompositeNumbers)

%Y Cf. A002182, A072938, A162936

%K fini,full,nonn

%O 1,2

%A Jan Behrens (jbe-oeis(AT)magnetkern.de), Jul 17 2009