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

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

Offset: 1

Author

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

Keywords

• fini
• full
• nonn

Comments

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

This sequence is a subsequence of A162936.

Links

• Jan Behrens, Estimation of the ratios of subsequent highly composite numbers (in German)

Crossrefs

Cf. A002182, A072938, A162936

Programs

Haskell

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)