diff --git a/ats-src/combinatorics-ffi.dats b/ats-src/combinatorics-ffi.dats --- a/ats-src/combinatorics-ffi.dats +++ b/ats-src/combinatorics-ffi.dats @@ -21,10 +21,6 @@ fun double_factorial_ats {n : nat} : int(n) -> Intinf = "mac#" -extern -fun factorial_ats {n : nat} : int(n) -> Intinf = - "mac#" - implement choose_ats (n, k) = choose(n, k) @@ -33,6 +29,3 @@ implement double_factorial_ats (m) = dfact(m) - -implement factorial_ats (m) = - fact(m) diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -28,16 +28,12 @@ [ bench "isPerfect" $ nf isPerfect 318 , bench "hsIsPerfect" $ nf hsIsPerfect (318 :: Int) ] - , bgroup "factorial" - [ bench "factorial" $ nfIO (factorial 1000) - , bench "hsFactorial" $ nf hsFactorial (1000 :: Integer) - ] , bgroup "doubleFactorial" [ bench "doubleFactorial" $ nfIO (doubleFactorial 79) , bench "hsDoubleFactorial" $ nf hsDoubleFactorial (79 :: Integer) ] , bgroup "choose" [ bench "choose" $ nfIO (choose 322 16) - , bench "hsChoose" $ nf (hsChoose 322) (16 :: Integer) + , bench "hsChoose" $ nf (hsChoose 322 :: Int -> Integer) 16 ] ] diff --git a/cbits/combinatorics.c b/cbits/combinatorics.c --- a/cbits/combinatorics.c +++ b/cbits/combinatorics.c @@ -1,7 +1,7 @@ /* ** ** The C code is generated by [ATS/Postiats-0-3-8] -** The starting compilation time is: 2018-1-9: 17h: 0m +** The starting compilation time is: 2018-1-9: 18h:50m ** */ @@ -640,12 +640,6 @@ double_factorial_ats(atstkind_t0ype(atstype_int)) ; #endif // end of [QUALIFIED] -#if(0) -ATSextern() -atstkind_type(atstype_ptrk) -factorial_ats(atstkind_t0ype(atstype_int)) ; -#endif // end of [QUALIFIED] - /* /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics.dats: 280(line=10, offs=4) -- 980(line=34, offs=6) */ @@ -4011,7 +4005,7 @@ } /* end of [ATSCNTRB_056_HX_056_intinf_vt__intinf_free__12__3] */ /* -/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 597(line=28, offs=22) -- 620(line=29, offs=15) +/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 531(line=24, offs=22) -- 554(line=25, offs=15) */ /* local: choose_44$0(level=0) @@ -4028,11 +4022,11 @@ /* tmpvardeclst(end) */ ATSfunbody_beg() /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 586(line=28, offs=11) -- 620(line=29, offs=15) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 520(line=24, offs=11) -- 554(line=25, offs=15) */ ATSINSflab(__patsflab_choose_ats): /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 608(line=29, offs=3) -- 620(line=29, offs=15) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 542(line=25, offs=3) -- 554(line=25, offs=15) */ ATSINSmove(tmpret131, choose_44(arg0, arg1)) ; @@ -4041,7 +4035,7 @@ } /* end of [choose_ats] */ /* -/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 649(line=31, offs=28) -- 672(line=32, offs=15) +/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 583(line=27, offs=28) -- 606(line=28, offs=15) */ /* local: choose_44$0(level=0) @@ -4058,11 +4052,11 @@ /* tmpvardeclst(end) */ ATSfunbody_beg() /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 632(line=31, offs=11) -- 672(line=32, offs=15) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 566(line=27, offs=11) -- 606(line=28, offs=15) */ ATSINSflab(__patsflab_permutations_ats): /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 660(line=32, offs=3) -- 672(line=32, offs=15) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 594(line=28, offs=3) -- 606(line=28, offs=15) */ ATSINSmove(tmpret132, choose_44(arg0, arg1)) ; @@ -4071,7 +4065,7 @@ } /* end of [permutations_ats] */ /* -/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 705(line=34, offs=32) -- 720(line=35, offs=10) +/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 639(line=30, offs=32) -- 654(line=31, offs=10) */ /* local: dfact_34$0(level=0) @@ -4088,47 +4082,17 @@ /* tmpvardeclst(end) */ ATSfunbody_beg() /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 684(line=34, offs=11) -- 721(line=35, offs=11) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 618(line=30, offs=11) -- 655(line=31, offs=11) */ ATSINSflab(__patsflab_double_factorial_ats): /* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 713(line=35, offs=3) -- 720(line=35, offs=10) +emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 647(line=31, offs=3) -- 654(line=31, offs=10) */ ATSINSmove(tmpret133, dfact_34(arg0)) ; ATSfunbody_end() ATSreturn(tmpret133) ; } /* end of [double_factorial_ats] */ - -/* -/home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 747(line=37, offs=25) -- 761(line=38, offs=9) -*/ -/* -local: fact_28$0(level=0) -global: fact_28$0(level=0), factorial_ats$61$0(level=0) -local: -global: -*/ -ATSextern() -atstkind_type(atstype_ptrk) -factorial_ats(atstkind_t0ype(atstype_int) arg0) -{ -/* tmpvardeclst(beg) */ -ATStmpdec(tmpret134, atstkind_type(atstype_ptrk)) ; -/* tmpvardeclst(end) */ -ATSfunbody_beg() -/* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 733(line=37, offs=11) -- 762(line=38, offs=10) -*/ -ATSINSflab(__patsflab_factorial_ats): -/* -emit_instr: loc0 = /home/vanessa/programming/haskell/done/fast-arithmetic/ats-src/combinatorics-ffi.dats: 755(line=38, offs=3) -- 761(line=38, offs=9) -*/ -ATSINSmove(tmpret134, fact_28(arg0)) ; - -ATSfunbody_end() -ATSreturn(tmpret134) ; -} /* end of [factorial_ats] */ /* ** for initialization(dynloading) diff --git a/cbits/number-theory.c b/cbits/number-theory.c --- a/cbits/number-theory.c +++ b/cbits/number-theory.c @@ -1,7 +1,7 @@ /* ** ** The C code is generated by [ATS/Postiats-0-3-8] -** The starting compilation time is: 2018-1-9: 15h:48m +** The starting compilation time is: 2018-1-9: 18h:50m ** */ diff --git a/cbits/numerics.c b/cbits/numerics.c --- a/cbits/numerics.c +++ b/cbits/numerics.c @@ -1,7 +1,7 @@ /* ** ** The C code is generated by [ATS/Postiats-0-3-8] -** The starting compilation time is: 2018-1-9: 15h:48m +** The starting compilation time is: 2018-1-9: 18h:50m ** */ diff --git a/fast-arithmetic.cabal b/fast-arithmetic.cabal --- a/fast-arithmetic.cabal +++ b/fast-arithmetic.cabal @@ -1,5 +1,5 @@ name: fast-arithmetic -version: 0.2.0.1 +version: 0.2.1.0 synopsis: Fast functions on integers. description: Fast functions for number theory and combinatorics with a high level of safety guaranteed by [ATS](http://www.ats-lang.org/). This package also provides a 'Storable' instance for GMP's @mpz@ type. diff --git a/src/Numeric/Combinatorics.hs b/src/Numeric/Combinatorics.hs --- a/src/Numeric/Combinatorics.hs +++ b/src/Numeric/Combinatorics.hs @@ -6,8 +6,7 @@ functions. -} -module Numeric.Combinatorics ( factorial - , choose +module Numeric.Combinatorics ( choose , doubleFactorial ) where @@ -17,7 +16,6 @@ import Foreign.Ptr import Foreign.Storable -foreign import ccall unsafe factorial_ats :: CInt -> Ptr GMPInt foreign import ccall unsafe double_factorial_ats :: CInt -> Ptr GMPInt foreign import ccall unsafe choose_ats :: CInt -> CInt -> Ptr GMPInt @@ -28,6 +26,3 @@ -- | See [here](http://mathworld.wolfram.com/DoubleFactorial.html). doubleFactorial :: Int -> IO Integer doubleFactorial = conjugateGMP double_factorial_ats - -factorial :: Int -> IO Integer -factorial = conjugateGMP factorial_ats diff --git a/src/Numeric/Pure.hs b/src/Numeric/Pure.hs --- a/src/Numeric/Pure.hs +++ b/src/Numeric/Pure.hs @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} --- | Pure Haskell functions for testing and benchmarking. Specialized for --- 'Int's. -module Numeric.Pure ( hsIsPrime - , hsFactorial +-- | Pure Haskell functions for testing and benchmarking. +module Numeric.Pure ( -- * Useful functions + derangement + , factorial + -- * Functions exported for testing and benchmarking + , hsIsPrime , hsDoubleFactorial , hsChoose , hsTotient @@ -12,25 +14,26 @@ , hsLittleOmega , hsIsPerfect , hsSumDivisors - , hsDerangement ) where #if __GLASGOW_HASKELL__ <= 784 import Control.Applicative #endif +{-# SPECIALIZE factorial :: Int -> Integer #-} +{-# SPECIALIZE derangement :: Int -> Integer #-} {-# SPECIALIZE hsLittleOmega :: Int -> Int #-} -{-# SPECIALIZE hsFactorial :: Int -> Int #-} {-# SPECIALIZE hsTau :: Int -> Int #-} {-# SPECIALIZE hsTotient :: Int -> Int #-} {-# SPECIALIZE hsIsPrime :: Int -> Bool #-} {-# SPECIALIZE hsChoose :: Int -> Int -> Int #-} {-# SPECIALIZE hsDoubleFactorial :: Int -> Int #-} -hsDerangement :: Int -> Integer -hsDerangement n = derangements !! n +-- | See [here](http://mathworld.wolfram.com/Derangement.html). +derangement :: (Integral a) => Int -> a +derangement n = derangements !! n -derangements :: [Integer] +derangements :: (Integral a) => [a] derangements = fmap snd g where g = (0, 1) : (1, 0) : zipWith (\(_, n) (i, m) -> (i + 1, i * (n + m))) g (tail g) @@ -62,9 +65,12 @@ hsIsPrime x = all ((/=0) . (x `mod`)) [2..m] where m = floor (sqrt (fromIntegral x :: Float)) -hsFactorial :: (Integral a) => a -> a -hsFactorial n = product [1..n] +factorials :: (Integral a) => [a] +factorials = 1 : 1 : zipWith (*) [2..] (tail factorials) +factorial :: (Integral a) => Int -> a +factorial = (factorials !!) + hsDoubleFactorial :: (Integral a) => a -> a hsDoubleFactorial 0 = 1 hsDoubleFactorial 1 = 1 @@ -74,5 +80,5 @@ | odd n = product [1, 3 .. n] | otherwise = 1 -hsChoose :: (Integral a) => a -> a -> a -hsChoose n k = product [ n + 1 - i | i <- [1..k] ] `div` hsFactorial k +hsChoose :: (Integral a) => a -> Int -> a +hsChoose n k = product [ n + 1 - i | i <- [1..(fromIntegral k)] ] `div` factorial k diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -46,13 +46,16 @@ describe "totient" $ prop "should be equal to m-1 for m prime" $ \m -> m < 1 || not (isPrime m) || totient m == m - 1 + describe "derangement" $ + prop "should be equal to [n!/e]" $ + \n -> n < 1 || n > 18 || (derangement n :: Integer) == floor ((fromIntegral (factorial n :: Integer) :: Double) / exp 1 + 0.5) describe "totient" $ prop "should satisfy Fermat's little theorem" $ \a m -> a < 1 || m < 2 || gcd a m /= 1 || tooBig a m || (a ^ totient m) `mod` m == 1 -- TODO property test w/ recurrence relations? sequence_ $ zipWith4 check - ["factorial", "choose 101", "doubleFactorial"] - [factorial, choose 101, doubleFactorial] - [hsFactorial, hsChoose 101, hsDoubleFactorial] - [3141, 16, 79] + ["choose 101", "doubleFactorial"] + [choose 101, doubleFactorial] + [hsChoose 101 . fromIntegral, hsDoubleFactorial] + [16, 79]