language: Haskell (ghc-7.4.1)
date: 614 days 21 hours ago
link:
visibility: private 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
 
-- http://rosettacode.org/wiki/Hamming_numbers#Haskell
 
module Main where
import Data.List 
import Data.Function
 
hamming = 1 : map (2*) hamming `union` map (3*) hamming `union` map (5*) hamming
  where
    union a@(x:xs) b@(y:ys) = case compare x y of
            LT -> x : union  xs  b
            EQ -> x : union  xs  ys
            GT -> y : union  a   ys
 
main = do 
  s <- getLine
  case s of
   "a" -> do print $ take 20 hamming
             print  (hamming !! 1690, hamming !! 1691)
             print $ hamming !! (1000000-1)          -- 9 MB: releases the prefix of the list
   "b" -> do
             print $ hamming !! (1000000-1)
             print $ hamming !!  1000000             -- 77 MB: does NOT release the prefix (is needed twice)
   "c" -> do
             mapM_ print $ take 2 $ drop 999999 hamming  -- 9 MB: used once, prefix gc-d
   "d" -> do
             let (r,t)   = nthHam (1000000)           -- 4 MB: stores upper band only
                 (r2,t2) = nthHam (1000001)
             print (t,trival t)         
             print (t2,trival t2)         
   _   -> do                                          --    10^8:  4 MB          0.27 sec
             let (r,t) = nthHam (read s)             --    10^9:  6 MB (-4=2)   1.42 sec   O(n^0.7)
             print t                                 --   10^10: 14 MB (-4=10)  7.20 sec   O(n^0.7)
 
-- directly find n-th Hamming number (base 1, from 2), in ~ O(n^{2/3}) time
-- by Will Ness, based on "top band" idea by Louis Klauder from DDJ discussion
--   http://drdobbs.com/blogs/architecture-and-design/228700538
 
ln2 = log 2;  ln3 = log 3;  ln5 = log 5
logval (i,j,k)    = fromIntegral i*ln2 + fromIntegral j*ln3 + fromIntegral k*ln5
trival (i,j,k)    = 2^i * 3^j * 5^k
estval n          = (6*ln2*ln3*ln5* fromIntegral n)**(1/3)  -- estimated logval
rngval n       
    | n > 500000  = (1.698 , 0.0050)                          -- empirical
    | n > 50000   = (1.693 , 0.0100)                          --  estimation
    | n > 500     = (1.66  , 0.0500)                          --   correction  
    | n > 1       = (1.56  , 0.2000)                          --    (dist,width)
    | otherwise  = (1.56  , 0.4000) 
 
 -- estval(n) = log (M[n]) = ln2 * logBase 2 (M[n])
 
lb3 = logBase 2 3;  lb5 = logBase 2 5   -- lb3 == log 3/log 2,  lb5 == log 5/log 2
logval2 (i,j,k)    = fromIntegral i + fromIntegral j*lb3 + fromIntegral k*lb5
estval2 n          = (6*lb3*lb5* fromIntegral n)**(1/3)  -- estimated logval **Base 2**
rngval2 n       
    | n > 500000  = (2.4496 , 0.0076 )                          -- empirical
    | n > 50000   = (2.4424 , 0.0146 )                          --  estimation
    | n > 500     = (2.3948 , 0.0723 )                          --   correction - base 2
    | n > 1       = (2.2506 , 0.2887 )                          --    (dist,width)
    | otherwise  = (2.2506 , 0.5771 )  
 
nthHam n                                                      -- n: 1-based 1,2,3...
  | w >= 1   = error $ "Breach of contract: (w < 1):  " ++ show (w)
  | m <  0   = error $ "Not enough triples generated: " ++ show (c,n)
  | m >= nb  = error $ "Generated band is too narrow: " ++ show (m,nb)
  | True     = res 
 where 
  (d,w)   = rngval2 n                                         -- correction dist, width
  hi      = estval2 n - d                                     --   hi > logval2 > hi-w 
  (c,b)   = foldl'                                            -- total count, the band
             (\(!c,!b) (i,t) -> case t of [] -> (i+c,b)
                                          [x] -> (i+c,x:b)) 
             (0,[])
             [ ( i+1,                                         -- total triples w/ this (j,k)
                 [ (r,(i,j,k)) | frac < w ] )                 -- store it, if inside band
               | k <- [ 0 .. floor ( hi   /lb5) ],  let p = fromIntegral k*lb5,    
                 j <- [ 0 .. floor ((hi-p)/lb3) ],  let q = fromIntegral j*lb3 + p,
                 let (i,frac) = pr  (hi-q) ;              r = hi - frac  -- r = i + q 
               ] where     pr = properFraction
  (m,nb)  = ( fromIntegral $ c - n, length b )              -- m 0-based from top, |band|
  (s,res) = ( sortBy (flip compare `on` fst) b, s!!m )      -- sorted decreasing, result
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...
  • upload with new input
  • # 13:   show   clone   input   186 days 19 hours ago    Success
  • # 12:   show   clone   input   186 days 19 hours ago    Time limit exceeded
  • # 11:   show   clone   input   531 days 17 hours ago    Success
  • # 10:   show   clone   input   531 days 21 hours ago    Success
  • # 9:   show   clone   input   614 days 21 hours ago    Success
  • # 8:   show   clone   input   614 days 21 hours ago    Success
  • # 7:   show   clone   input   614 days 21 hours ago    Success
  • # 6:   show   clone   input   614 days 21 hours ago    Success
  • # 5:   show   clone   input   614 days 21 hours ago    Success
  • # 4:   show   clone   input   614 days 21 hours ago    Success
  • # 3:   show   clone   input   614 days 21 hours ago    Success
  • # 2:   show   clone   input   614 days 21 hours ago    Success
  • # 1:   hide   clone   input   614 days 21 hours ago

    result: Success     time: 7.22s    memory: 14072 kB     returned value: 0 

    10020030010
    (1544,574,1547)
nth Hamming, top band, base 2