Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,78 @@
|
|||
{-# OPTIONS_GHC -O2 -fllvm -Wno-incomplete-patterns #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
|
||||
import Data.Time.Clock.POSIX ( getPOSIXTime ) -- for timing
|
||||
|
||||
import Data.Int ( Int64 )
|
||||
import Data.Bits ( Bits( shiftL, shiftR ) )
|
||||
|
||||
data Memo a = EmptyNode | Node a (Memo a) (Memo a)
|
||||
deriving Functor
|
||||
|
||||
memo :: Integral a => Memo p -> a -> p
|
||||
memo (Node a l r) n
|
||||
| n == 0 = a
|
||||
| odd n = memo l (n `div` 2)
|
||||
| otherwise = memo r (n `div` 2 - 1)
|
||||
|
||||
nats :: Integral a => Memo a
|
||||
nats = Node 0 ((+1).(*2) <$> nats) ((*2).(+1) <$> nats)
|
||||
|
||||
memoize :: Integral a => (a -> b) -> a -> b
|
||||
memoize f = memo (f <$> nats)
|
||||
|
||||
memoize2 :: (Integral a, Integral b) => (a -> b -> c) -> a -> b -> c
|
||||
memoize2 f = memoize (memoize . f)
|
||||
|
||||
memoList :: [b] -> Integer -> b
|
||||
memoList = memo . mkList
|
||||
where
|
||||
mkList [] = EmptyNode -- never used; makes complete
|
||||
mkList (x:xs) = Node x (mkList l) (mkList r)
|
||||
where (l,r) = split xs
|
||||
split [] = ([],[])
|
||||
split [x] = ([x],[])
|
||||
split (x:y:xs) = let (l,r) = split xs in (x:l, y:r)
|
||||
|
||||
isqrt :: Integer -> Integer
|
||||
isqrt n = go n 0 (q `shiftR` 2)
|
||||
where
|
||||
q = head $ dropWhile (< n) $ iterate (`shiftL` 2) 1
|
||||
go z r 0 = r
|
||||
go z r q = let t = z - r - q
|
||||
in if t >= 0
|
||||
then go t (r `shiftR` 1 + q) (q `shiftR` 2)
|
||||
else go z (r `shiftR` 1) (q `shiftR` 2)
|
||||
|
||||
primes :: [Integer]
|
||||
primes = 2 : _Y ((3:) . gaps 5 . _U . map(\p-> [p*p, p*p+2*p..])) where
|
||||
_Y g = g (_Y g) -- = g (g (g ( ... ))) non-sharing multistage fixpoint combinator
|
||||
gaps k s@(c:cs) | k < c = k : gaps (k+2) s -- ~= ([k,k+2..] \\ s)
|
||||
| otherwise = gaps (k+2) cs -- when null(s\\[k,k+2..])
|
||||
_U ((x:xs):t) = x : (merge xs . _U . pairs) t -- tree-shaped folding big union
|
||||
pairs (xs:ys:t) = merge xs ys : pairs t
|
||||
merge xs@(x:xt) ys@(y:yt) | x < y = x : merge xt ys
|
||||
| y < x = y : merge xs yt
|
||||
| otherwise = x : merge xt yt
|
||||
|
||||
phi :: Integer -> Integer -> Integer
|
||||
phi = memoize2 phiM
|
||||
where
|
||||
phiM x 0 = x
|
||||
phiM x a = phi x (a-1) - phi (x `div` p a) (a - 1)
|
||||
|
||||
p = memoList (undefined : primes)
|
||||
|
||||
legendrePi :: Integer -> Integer
|
||||
legendrePi n
|
||||
| n < 2 = 0
|
||||
| otherwise = phi n a + a - 1
|
||||
where a = legendrePi (floor (sqrt (fromInteger n)))
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
strt <- getPOSIXTime
|
||||
mapM_ (\n -> putStrLn $ show n ++ "\t" ++ show (legendrePi (10^n))) [0..9]
|
||||
stop <- getPOSIXTime
|
||||
let elpsd = round $ 1e3 * (stop - strt) :: Int64
|
||||
putStrLn $ "This last took " ++ show elpsd ++ " milliseconds."
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
{-# OPTIONS_GHC -O2 -fllvm #-}
|
||||
{-# LANGUAGE FlexibleContexts, BangPatterns #-}
|
||||
|
||||
import Data.Time.Clock.POSIX ( getPOSIXTime ) -- for timing
|
||||
|
||||
import Data.Int ( Int64 )
|
||||
import Data.Word ( Word32, Word64 )
|
||||
import Data.Bits ( Bits( (.&.), (.|.), shiftL, shiftR ) )
|
||||
import Control.Monad ( unless, when, forM_ )
|
||||
import Control.Monad.ST ( ST, runST )
|
||||
import Data.Array.ST ( runSTUArray )
|
||||
import Data.Array.Base ( UArray(..), IArray(unsafeAt), listArray, elems, assocs,
|
||||
MArray( unsafeNewArray_, newArray, unsafeRead, unsafeWrite ),
|
||||
STUArray, unsafeFreezeSTUArray, castSTUArray )
|
||||
|
||||
countPrimes :: Word64 -> Int64
|
||||
countPrimes n =
|
||||
if n < 3 then (if n < 2 then 0 else 1) else
|
||||
let sqrtn = truncate $ sqrt $ fromIntegral n
|
||||
qdrtn = truncate $ sqrt $ fromIntegral sqrtn
|
||||
rtlmt = (sqrtn - 3) `div` 2
|
||||
qrtlmt = (qdrtn - 3) `div` 2
|
||||
oddPrimes@(UArray _ _ psz _) = runST $ do -- UArray of odd primes...
|
||||
cmpsts <- newArray (0, rtlmt) False :: ST s (STUArray s Int Bool)
|
||||
forM_ [ 0 .. qrtlmt ] $ \ i -> do
|
||||
t <- unsafeRead cmpsts i
|
||||
unless t $ do
|
||||
let sqri = (i + i) * (i + 3) + 3
|
||||
bp = i + i + 3
|
||||
forM_ [ sqri, sqri + bp .. rtlmt ] $ \ c ->
|
||||
unsafeWrite cmpsts c True
|
||||
fcmpsts <- unsafeFreezeSTUArray cmpsts
|
||||
let !numoprms = sum $ [ 1 | False <- elems fcmpsts ]
|
||||
prms = [ fromIntegral $ i + i + 3 | (i, False) <- assocs fcmpsts ]
|
||||
return $ listArray (0, numoprms - 1) prms :: ST s (UArray Int Word32)
|
||||
phi x a =
|
||||
if a < 1 then x - (x `shiftR` 1) else
|
||||
let na = a - 1
|
||||
p = fromIntegral $ unsafeAt oddPrimes na in
|
||||
if x < p then 1 else
|
||||
phi x na - phi (x `div` p) na
|
||||
|
||||
in fromIntegral (phi n psz) + fromIntegral psz
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
strt <- getPOSIXTime
|
||||
mapM_ (\n -> putStrLn $ show n ++ "\t" ++ show (countPrimesx (10^n))) [ 0 .. 9 ]
|
||||
stop <- getPOSIXTime
|
||||
let elpsd = round $ 1e3 * (stop - strt) :: Int64
|
||||
putStrLn $ "This took " ++ show elpsd ++ " milliseconds."
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
cTinyPhiPrimes :: [Int]
|
||||
cTinyPhiPrimes = [ 2, 3, 5, 7, 11, 13 ]
|
||||
cC :: Int
|
||||
cC = length cTinyPhiPrimes - 1
|
||||
cTinyPhiOddCirc :: Int
|
||||
cTinyPhiOddCirc = product cTinyPhiPrimes `div` 2
|
||||
cTinyPhiTot :: Int
|
||||
cTinyPhiTot = product [ p - 1 | p <- cTinyPhiPrimes ]
|
||||
cTinyPhiLUT :: UArray Int Word32
|
||||
cTinyPhiLUT = runSTUArray $ do
|
||||
ma <- newArray (0, cTinyPhiOddCirc - 1) 1
|
||||
forM_ (drop 1 cTinyPhiPrimes) $ \ bp -> do
|
||||
let i = (bp - 1) `shiftR` 1
|
||||
let sqri = (i + i) * (i + 1)
|
||||
unsafeWrite ma i 0
|
||||
forM_ [ sqri, sqri + bp .. cTinyPhiOddCirc - 1 ] $ \ c -> unsafeWrite ma c 0
|
||||
let tot i acc =
|
||||
if i >= cTinyPhiOddCirc then return ma else do
|
||||
v <- unsafeRead ma i
|
||||
if v == 0 then do unsafeWrite ma i acc; tot (i + 1) acc
|
||||
else do let nacc = acc + 1
|
||||
unsafeWrite ma i nacc; tot (i + 1) nacc
|
||||
tot 0 0
|
||||
tinyPhi :: Word64 -> Int64
|
||||
tinyPhi n =
|
||||
let on = (n - 1) `shiftR` 1
|
||||
numcyc = on `div` fromIntegral cTinyPhiOddCirc
|
||||
rem = fromIntegral $ on - numcyc * fromIntegral cTinyPhiOddCirc
|
||||
in fromIntegral numcyc * fromIntegral cTinyPhiTot +
|
||||
fromIntegral (unsafeAt cTinyPhiLUT rem)
|
||||
|
||||
countPrimes :: Word64 -> Int64
|
||||
countPrimes n =
|
||||
if n < 3 then (if n < 2 then 0 else 1) else
|
||||
let sqrtn = truncate $ sqrt $ fromIntegral n
|
||||
qdrtn = truncate $ sqrt $ fromIntegral sqrtn
|
||||
rtlmt = (sqrtn - 3) `div` 2
|
||||
qrtlmt = (qdrtn - 3) `div` 2
|
||||
oddPrimes@(UArray _ _ psz _) = runST $ do -- UArray of odd primes...
|
||||
cmpsts <- newArray (0, rtlmt) False :: ST s (STUArray s Int Bool)
|
||||
forM_ [ 0 .. qrtlmt ] $ \ i -> do
|
||||
t <- unsafeRead cmpsts i
|
||||
unless t $ do
|
||||
let sqri = (i + i) * (i + 3) + 3
|
||||
bp = i + i + 3
|
||||
forM_ [ sqri, sqri + bp .. rtlmt ] $ \ c ->
|
||||
unsafeWrite cmpsts c True
|
||||
fcmpsts <- unsafeFreezeSTUArray cmpsts
|
||||
let !numoprms = sum $ [ 1 | False <- elems fcmpsts ]
|
||||
prms = [ fromIntegral $ i + i + 3 | (i, False) <- assocs fcmpsts ]
|
||||
return $ listArray (0, numoprms - 1) prms :: ST s (UArray Int Word32)
|
||||
lvl pi pilmt !m !acc =
|
||||
if pi >= pilmt then acc else
|
||||
let p = fromIntegral $ unsafeAt oddPrimes pi
|
||||
nm = m * p in
|
||||
if n <= nm * p then acc + fromIntegral (pilmt - pi) else
|
||||
let !q = fromIntegral $ n `div` nm
|
||||
!nacc = acc + tinyPhi q
|
||||
!sacc = if pi <= cC then 0 else lvl cC pi nm 0
|
||||
in lvl (pi + 1) pilmt m $ nacc - sacc
|
||||
|
||||
in tinyPhi n - lvl cC psz 1 0 + fromIntegral psz
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
countPrimes :: Word64 -> Int64
|
||||
countPrimes n =
|
||||
if n < 3 then (if n < 2 then 0 else 1) else
|
||||
let
|
||||
{-# INLINE divide #-}
|
||||
divide :: Word64 -> Word64 -> Int
|
||||
divide nm d = truncate $ (fromIntegral nm :: Double) / fromIntegral d
|
||||
{-# INLINE half #-}
|
||||
half :: Int -> Int
|
||||
half x = (x - 1) `shiftR` 1
|
||||
rtlmt = floor $ sqrt (fromIntegral n :: Double)
|
||||
mxndx = (rtlmt - 1) `div` 2
|
||||
(!nbps, !nrs, !smalls, !roughs, !larges) = runST $ do
|
||||
mss <- unsafeNewArray_ (0, mxndx) :: ST s (STUArray s Int Word32)
|
||||
let msscst =
|
||||
castSTUArray :: STUArray s Int Word32 -> ST s (STUArray s Int Int64)
|
||||
mdss <- msscst mss -- for use in adjing counts LUT
|
||||
forM_ [ 0 .. mxndx ] $ \ i -> unsafeWrite mss i (fromIntegral i)
|
||||
mrs <- unsafeNewArray_ (0, mxndx) :: ST s (STUArray s Int Word32)
|
||||
forM_ [ 0 .. mxndx ] $ \ i -> unsafeWrite mrs i (fromIntegral i * 2 + 1)
|
||||
mls <- unsafeNewArray_ (0, mxndx) :: ST s (STUArray s Int Int64)
|
||||
forM_ [ 0 .. mxndx ] $ \ i ->
|
||||
let d = fromIntegral (i + i + 1)
|
||||
in unsafeWrite mls i (fromIntegral (divide n d - 1) `div` 2)
|
||||
cmpsts <- unsafeNewArray_ (0, mxndx) :: ST s (STUArray s Int Bool)
|
||||
|
||||
let loop i !cbpi !rlmti =
|
||||
let sqri = (i + i) * (i + 1) in
|
||||
if sqri > mxndx then do
|
||||
fss <- unsafeFreezeSTUArray mss
|
||||
frs <- unsafeFreezeSTUArray mrs
|
||||
fls <- unsafeFreezeSTUArray mls
|
||||
return (cbpi, rlmti + 1, fss, frs, fls)
|
||||
else do
|
||||
v <- unsafeRead cmpsts i
|
||||
if v then loop (i + 1) cbpi rlmti else do
|
||||
unsafeWrite cmpsts i True -- cull current bp so not a "k-rough"!
|
||||
let bp = i + i + 1
|
||||
-- partial cull by current base prime, bp...
|
||||
cull c = if c > mxndx then return () else do
|
||||
unsafeWrite cmpsts c True; cull (c + bp)
|
||||
|
||||
-- adjust `larges` according to partial sieve...
|
||||
part ri nri = -- old "rough" index to new one...
|
||||
if ri > rlmti then return (nri - 1) else do
|
||||
r <- unsafeRead mrs ri -- "rough" always odd!
|
||||
t <- unsafeRead cmpsts (fromIntegral r `shiftR` 1)
|
||||
if t then part (ri + 1) nri else do -- skip newly culled
|
||||
olv <- unsafeRead mls ri
|
||||
let m = fromIntegral r * fromIntegral bp
|
||||
adjv <- if m <= fromIntegral rtlmt then do
|
||||
let ndx = fromIntegral m `shiftR` 1
|
||||
sv <- unsafeRead mss ndx
|
||||
unsafeRead mls (fromIntegral sv - cbpi)
|
||||
else do
|
||||
sv <- unsafeRead mss (half (divide n m))
|
||||
return (fromIntegral sv)
|
||||
unsafeWrite mls nri (olv - (adjv - fromIntegral cbpi))
|
||||
unsafeWrite mrs nri r; part (ri + 1) (nri + 1)
|
||||
!pm0 = ((rtlmt `div` bp) - 1) .|. 1 -- max base prime mult
|
||||
|
||||
adjc lmti pm = -- adjust smalls according to partial sieve:
|
||||
if pm < bp then return () else do
|
||||
c <- unsafeRead mss (pm `shiftR` 1)
|
||||
let ac = c - fromIntegral cbpi -- correction
|
||||
bi = (pm * bp) `shiftR` 1 -- start array index
|
||||
adj si = if si > lmti then adjc (bi - 1) (pm - 2)
|
||||
else do ov <- unsafeRead mss si
|
||||
unsafeWrite mss si (ov - ac)
|
||||
adj (si + 1)
|
||||
adj bi
|
||||
dadjc lmti pm =
|
||||
if pm < bp then return () else do
|
||||
c <- unsafeRead mss (pm `shiftR` 1)
|
||||
let ac = c - fromIntegral cbpi -- correction
|
||||
bi = (pm * bp) `shiftR` 1 -- start array index
|
||||
ac64 = fromIntegral ac :: Int64
|
||||
dac = (ac64 `shiftL` 32) .|. ac64
|
||||
dbi = (bi + 1) `shiftR` 1
|
||||
dlmti = (lmti - 1) `shiftR` 1
|
||||
dadj dsi = if dsi > dlmti then return ()
|
||||
else do dov <- unsafeRead mdss dsi
|
||||
unsafeWrite mdss dsi (dov - dac)
|
||||
dadj (dsi + 1)
|
||||
when (bi .&. 1 /= 0) $ do
|
||||
ov <- unsafeRead mss bi
|
||||
unsafeWrite mss bi (ov - ac)
|
||||
dadj dbi
|
||||
when (lmti .&. 1 == 0) $ do
|
||||
ov <- unsafeRead mss lmti
|
||||
unsafeWrite mss lmti (ov - ac)
|
||||
adjc (bi - 1) (pm - 2)
|
||||
cull sqri; nrlmti <- part 0 0
|
||||
dadjc mxndx pm0
|
||||
loop (i + 1) (cbpi + 1) nrlmti
|
||||
loop 1 0 mxndx
|
||||
|
||||
!ans0 = unsafeAt larges 0 - -- combine all counts; each includes nbps...
|
||||
sum [ unsafeAt larges i | i <- [ 1 .. nrs - 1 ] ]
|
||||
-- adjust for all the base prime counts subracted above...
|
||||
!adj = (nrs + 2 * (nbps - 1)) * (nrs - 1) `div` 2
|
||||
!adjans0 = ans0 + fromIntegral adj
|
||||
|
||||
loopr ri !acc = -- o final phi calculation for pairs of larger primes...
|
||||
let r = fromIntegral (unsafeAt roughs ri)
|
||||
q = n `div` r
|
||||
lmtsi = half (fromIntegral (q `div` r))
|
||||
lmti = fromIntegral (unsafeAt smalls lmtsi) - nbps
|
||||
addcnt pi !ac =
|
||||
if pi > lmti then ac else
|
||||
let p = fromIntegral (unsafeAt roughs pi)
|
||||
ci = half (fromIntegral (divide q p))
|
||||
in addcnt (pi + 1) (ac + fromIntegral (unsafeAt smalls ci))
|
||||
in if lmti <= ri then acc else -- break when up to cube root of range!
|
||||
-- adjust for the `nbps`'s over added in the `smalls` counts...
|
||||
let !adj = fromIntegral ((lmti - ri) * (nbps + ri - 1))
|
||||
in loopr (ri + 1) (addcnt (ri + 1) acc - adj)
|
||||
in loopr 1 adjans0 + 1 -- add one for only even prime of two!
|
||||
Loading…
Add table
Add a link
Reference in a new issue