2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,12 +1,13 @@
|
|||
hamming = 1:foldl u [] [5,3,2] where
|
||||
u s n = ar where
|
||||
ar = merge s (n:map (n*) ar)
|
||||
merge [] b = b
|
||||
merge a@(x:xs) b@(y:ys)
|
||||
| x < y = x:merge xs b
|
||||
| otherwise = y:merge a ys
|
||||
hamming = 1 : foldr u [] [2,3,5] where
|
||||
u n s = -- fix (merge s . map (n*) . (1:))
|
||||
r where
|
||||
r = merge s (map (n*) (1:r))
|
||||
|
||||
merge [] b = b
|
||||
merge a@(x:xs) b@(y:ys) | x < y = x : merge xs b
|
||||
| otherwise = y : merge a ys
|
||||
|
||||
main = do
|
||||
print $ take 20 hamming
|
||||
print $ hamming !! 1690
|
||||
print $ hamming !! (1000000-1)
|
||||
print $ take 20 (hamming ())
|
||||
print $ (hamming ()) !! 1690
|
||||
print $ (hamming ()) !! (1000000-1)
|
||||
|
|
|
|||
|
|
@ -1,44 +1,40 @@
|
|||
-- directly find n-th Hamming number, 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
|
||||
-- based on "top band" idea by Louis Klauder, from DDJ discussion
|
||||
-- by Will Ness, original post: drdobbs.com/blogs/architecture-and-design/228700538
|
||||
|
||||
{-# OPTIONS -O2 -XBangPatterns #-}
|
||||
import Data.List (sortBy)
|
||||
import Data.Function (on)
|
||||
import Data.List
|
||||
import Data.Function
|
||||
|
||||
main = let (r,t) = nthHam 1000000 in print t >> print (trival t)
|
||||
|
||||
lg3 = logBase 2 3; lg5 = logBase 2 5
|
||||
logval (i,j,k) = fromIntegral i + fromIntegral j*lg3 + fromIntegral k*lg5
|
||||
lb3 = logBase 2 3; lb5 = logBase 2 5; lb30_2 = logBase 2 30 / 2
|
||||
trival (i,j,k) = 2^i * 3^j * 5^k
|
||||
estval n = (6*lg3*lg5* fromIntegral n)**(1/3) -- estimated logval, base 2
|
||||
rngval n
|
||||
| n > 500000 = (2.4496 , 0.0076 ) -- empirical estimation
|
||||
| n > 50000 = (2.4424 , 0.0146 ) -- correction, base 2
|
||||
| n > 500 = (2.3948 , 0.0723 ) -- (dist,width)
|
||||
| n > 1 = (2.2506 , 0.2887 ) -- around (log $ sqrt 30),
|
||||
| otherwise = (2.2506 , 0.5771 ) -- says WP
|
||||
estval n
|
||||
| n > 500000 = (v - lb30_2 + (3/v), 6/v) -- the space tweak! (thx, GBG!)
|
||||
| n > 500000 = (v - 2.4496 , 0.0076 ) -- empirical estimation
|
||||
| n > 50000 = (v - 2.4424 , 0.0146 ) -- correction, base 2
|
||||
| n > 500 = (v - 2.3948 , 0.0723 ) -- (dist,width)
|
||||
| n > 1 = (v - 2.2506 , 0.2887 ) -- around (log $ sqrt 30),
|
||||
| otherwise = (v - 2.2506 , 0.5771 ) -- says WP
|
||||
where v = (6*lb3*lb5* fromIntegral n)**(1/3) -- estimated logval, base 2
|
||||
|
||||
nthHam :: Int -> (Double, (Int, Int, Int))
|
||||
nthHam n -- n: 1-based: 1,2,3...
|
||||
nthHam :: Integer -> (Double, (Int, Int, Int)) -- ( 64bit: use Int!!! NB! )
|
||||
nthHam n -- n: 1-based: 1,2,3...
|
||||
| n <= 0 = error $ "n is 1--based: must be n > 0: " ++ show n
|
||||
| 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)
|
||||
| otherwise = res
|
||||
| otherwise = sortBy (flip compare `on` fst) b !! m -- m-th from top in sorted band
|
||||
where
|
||||
(d,w) = rngval n -- correction dist, width
|
||||
hi = estval n - d -- hi > logval > hi-w
|
||||
(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
|
||||
(c,b) = f 0 -- total count, the band
|
||||
[ ( i+1, -- total triples w/ this (j,k)
|
||||
[ (r,(i,j,k)) | frac < w ] ) -- store it, if inside band
|
||||
| k <- [ 0 .. floor ( hi /lg5) ], let p = fromIntegral k*lg5,
|
||||
j <- [ 0 .. floor ((hi-p)/lg3) ], let q = fromIntegral j*lg3 + p,
|
||||
let (i,frac) = pr (hi-q) ; r = hi-frac ] -- r = i + q
|
||||
-- f 0 z == (sum $ map fst z, concat $ map snd z)
|
||||
where pr = properFraction
|
||||
f !c [] = (c,[]) -- code as a loop
|
||||
f !c ((c1,b1):r) = let (cr,br) = f (c+c1) r -- to prevent space leak
|
||||
in case b1 of { [v] -> (cr,v:br)
|
||||
; _ -> (cr, br) }
|
||||
(hi,w) = estval n -- hi > logval > hi-w
|
||||
m = fromIntegral (c - n) -- target index, from top
|
||||
nb = length b -- length of the band
|
||||
(c,b) = foldl_ (\(c,b) (i,t)-> let c2=c+i in c2`seq` -- ( total count, the band )
|
||||
case t of []-> (c2,b);[v]->(c2,v:b) ) (0,[]) -- ( =~= mconcat )
|
||||
[ ( fromIntegral 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 -- pr 1.24 => (1,0.24)
|
||||
foldl_ = foldl'
|
||||
|
|
|
|||
43
Task/Hamming-numbers/Haskell/hamming-numbers-6.hs
Normal file
43
Task/Hamming-numbers/Haskell/hamming-numbers-6.hs
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
{-# OPTIONS -O2 -XBangPatterns #-}
|
||||
|
||||
import Data.Word
|
||||
import Data.List (sortBy)
|
||||
import Data.Function (on)
|
||||
|
||||
main = let t = nthHam 1000000000000 in print t >> print (trival t)
|
||||
|
||||
lb3 = logBase 2 3; lb5 = logBase 2 5
|
||||
lbrt30 = logBase 2 $ sqrt 30 :: Double -- estimate adjustment as per WP
|
||||
trival (i,j,k) = 2^i * 3^j * 5^k
|
||||
estval2 n = (6*lb3*lb5*n)**(1/3) - lbrt30 -- estimated logval, base 2
|
||||
crctn n
|
||||
| n < 1000 = 0.509 -- empirical correction terms
|
||||
| n < 1000000 = 0.206
|
||||
| n < 1000000000 = 0.122 -- further divisions have little effect as already small
|
||||
| otherwise = 0.105 -- very slowly decrease from this point for a billion
|
||||
|
||||
nthHam :: Word64 -> (Int, Int, Int)
|
||||
nthHam n -- n: 1-based 1,2,3...
|
||||
| n < 2 = case n of
|
||||
0 -> error "nthHam: Argument is zero!"
|
||||
_ -> (0, 0, 0) -- trivial case for 1
|
||||
| m < 0 = error $ "Not enough triples generated: " ++ show (c,n)
|
||||
| m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb)
|
||||
| otherwise = case res of (_, tv) -> tv -- 2^i * 3^j * 5^k
|
||||
where
|
||||
(fr,est)= (crctn n, estval2 $ fromIntegral n) -- fraction of log2 error, est val
|
||||
(hi,lo) = (estval2 (fromIntegral n + fr*est), 2*est-hi) -- hi > logval2 > hi-w
|
||||
(c,b) = let klmt = floor (hi/lb5) in
|
||||
let loopk k !ck bndk =
|
||||
if k > klmt then (ck, bndk) else
|
||||
let p = fromIntegral k*lb5; jlmt = floor ((hi-p)/lb3) in
|
||||
let loopj j !cj bndj =
|
||||
if j > jlmt then loopk (k+1) cj bndj else
|
||||
let q = fromIntegral j*lb3 + p in
|
||||
let (i, frac) = properFraction (hi-q); r = hi-frac in
|
||||
if r < lo then loopj (j+1) (fromIntegral i+cj+1) bndj else
|
||||
loopj (j+1) (fromIntegral i+cj+1) ((r,(i,j,k)):bndj) in
|
||||
loopj 0 ck bndk in
|
||||
loopk 0 0 []
|
||||
(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<
|
||||
Loading…
Add table
Add a link
Reference in a new issue