diff --git a/Tests.hs b/Tests.hs deleted file mode 100644 --- a/Tests.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module Tests where - -import Data.Complex.Cyclotomic -import Test.Framework (defaultMain, testGroup) -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 -import qualified Test.Framework.Providers.SmallCheck as S -import qualified Test.Framework.Providers.API as T -import Test.HUnit -import Data.Ratio - -main :: IO () -main = defaultMain tests - -tests :: [T.Test] -tests = [test1a - ,test2b - ,test3b - ,test4b - ,S.withDepth 10 (S.testProperty "SmallCheck prop_square_sqrtRat" prop_square_sqrtRat) - ,qc_square_sqrtRat - ,qc_dftInv_dft - ,qc_dft_dftInv - ] - -rationals :: [Rational] -rationals = 0 % 1 : [sign * k % j | n <- [0..], m <- [0..n-1], sign <- [1,-1] - , let k = m + 1, let j = n - m, gcd k j == 1] - -cyclotomics :: [Cyclotomic] -cyclotomics = 0 : undefined - -test1a :: T.Test -test1a = testGroup "polarRat" [polarRatTest p q | p <- [0..10], q <- [1..10]] - -polarRatAssertion :: Integer -> Integer -> Assertion -polarRatAssertion p q = polarRat 1 (p % q) @?= e q^p - -polarRatTest :: Integer -> Integer -> T.Test -polarRatTest p q = testCase ("polarRat 1 (" ++ show p ++ " % " ++ show q ++ ")") (polarRatAssertion p q) - -test2b :: T.Test -test2b = testGroup "sqrtRat r ^ 2 == r for the following values of r" - [testCase (show r) (sqrtRat r ^ (2::Int) @?= fromRational r) - | r <- take 100 rationals] - -test3b :: T.Test -test3b = testGroup "sqrtRat (r*r) == abs r for the following values of r" - [testCase (show r) (sqrtRat (r*r) @?= fromRational (abs r)) - | r <- take 100 rationals] - -test4b :: T.Test -test4b = testGroup "z * (1 / z) == 1 for the following values of z" - [testCase (show z) (z * (1 / z) @?= 1) - | n <- [1..10], m <- [1..10], let z = e n + e m, z /= 0] - ----------------- --- Properties -- ----------------- - -prop_square_sqrtRat :: Int -> Bool -prop_square_sqrtRat n = sqrtRat (fromIntegral n) ^ (2::Int) == fromIntegral n - ----------------------- --- QuickCheck Tests -- ----------------------- - -qc_square_sqrtRat :: T.Test -qc_square_sqrtRat - = T.plusTestOptions (T.TestOptions - {T.topt_seed = Nothing - ,T.topt_maximum_generated_tests = Just 15 - ,T.topt_maximum_unsuitable_generated_tests = Nothing - ,T.topt_maximum_test_size = Just 15 - ,T.topt_maximum_test_depth = Nothing - ,T.topt_timeout = Nothing - }) - $ testProperty "QuickCheck prop_square_sqrtRat" prop_square_sqrtRat - -prop_dftInv_dft :: [Rational] -> Bool -prop_dftInv_dft rs = dftInv (dft cs) == cs - where cs = map fromRational rs - -qc_dftInv_dft :: T.Test -qc_dftInv_dft - = T.plusTestOptions (T.TestOptions - {T.topt_seed = Nothing - ,T.topt_maximum_generated_tests = Just 15 - ,T.topt_maximum_unsuitable_generated_tests = Nothing - ,T.topt_maximum_test_size = Just 30 - ,T.topt_maximum_test_depth = Nothing - ,T.topt_timeout = Nothing - }) - $ testProperty "QuickCheck prop_dftInv_dft" prop_dftInv_dft - -prop_dft_dftInv :: [Rational] -> Bool -prop_dft_dftInv rs = dft (dftInv cs) == cs - where cs = map fromRational rs - -qc_dft_dftInv :: T.Test -qc_dft_dftInv - = T.plusTestOptions (T.TestOptions - {T.topt_seed = Nothing - ,T.topt_maximum_generated_tests = Just 15 - ,T.topt_maximum_unsuitable_generated_tests = Nothing - ,T.topt_maximum_test_size = Just 30 - ,T.topt_maximum_test_depth = Nothing - ,T.topt_timeout = Nothing - }) - $ testProperty "QuickCheck prop_dft_dftInv" prop_dft_dftInv - diff --git a/cyclotomic.cabal b/cyclotomic.cabal --- a/cyclotomic.cabal +++ b/cyclotomic.cabal @@ -1,5 +1,5 @@ Name: cyclotomic -Version: 0.3.1 +Version: 0.4 Synopsis: A subfield of the complex numbers for exact calculation. Description: The cyclotomic numbers are a subset of the complex numbers that are represented exactly, enabling exact @@ -19,10 +19,10 @@ Category: Math Build-type: Simple Cabal-version: >=1.6 -Tested-with: GHC == 7.4.1 +Tested-with: GHC == 7.6.3 Library Exposed-modules: Data.Complex.Cyclotomic - Build-depends: base >= 4.2 && < 4.6, - containers >= 0.3 && < 0.5, + Build-depends: base >= 4.2 && < 4.7, + containers >= 0.3 && < 0.6, arithmoi >= 0.4 && < 0.5 Hs-source-dirs: src diff --git a/src/Tests.hs b/src/Tests.hs new file mode 100644 --- /dev/null +++ b/src/Tests.hs @@ -0,0 +1,133 @@ +{-# OPTIONS_GHC -Wall #-} + +module Main where + +import Data.Complex.Cyclotomic +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import qualified Test.Framework.Providers.SmallCheck as S +import qualified Test.Framework.Providers.API as T +import Test.HUnit +import Data.Ratio + +main :: IO () +main = defaultMain tests + +tests :: [T.Test] +tests = [test1a + ,test2b + ,test3b + ,test4b + ,S.withDepth 10 (S.testProperty "SmallCheck prop_square_sqrtRat" prop_square_sqrtRat) + ,qc_square_sqrtRat + ,qc_Gauss + ,qc_dftInv_dft + ,qc_dft_dftInv + ] + +rationals :: [Rational] +rationals = 0 % 1 : [sign * k % j | n <- [0..], m <- [0..n-1], sign <- [1,-1] + , let k = m + 1, let j = n - m, gcd k j == 1] + +cyclotomics :: [Cyclotomic] +cyclotomics = 0 : undefined + +test1a :: T.Test +test1a = testGroup "polarRat" [polarRatTest p q | p <- [0..10], q <- [1..10]] + +polarRatAssertion :: Integer -> Integer -> Assertion +polarRatAssertion p q = polarRat 1 (p % q) @?= e q^p + +polarRatTest :: Integer -> Integer -> T.Test +polarRatTest p q = testCase ("polarRat 1 (" ++ show p ++ " % " ++ show q ++ ")") (polarRatAssertion p q) + +test2b :: T.Test +test2b = testGroup "sqrtRat r ^ 2 == r for the following values of r" + [testCase (show r) (sqrtRat r ^ (2::Int) @?= fromRational r) + | r <- take 100 rationals] + +test3b :: T.Test +test3b = testGroup "sqrtRat (r*r) == abs r for the following values of r" + [testCase (show r) (sqrtRat (r*r) @?= fromRational (abs r)) + | r <- take 100 rationals] + +test4b :: T.Test +test4b = testGroup "z * (1 / z) == 1 for the following values of z" + [testCase (show z) (z * (1 / z) @?= 1) + | n <- [1..10], m <- [1..10], let z = e n + e m, z /= 0] + +---------------- +-- Properties -- +---------------- + +prop_square_sqrtRat :: Int -> Bool +prop_square_sqrtRat n = sqrtRat (fromIntegral n) ^ (2::Int) == fromIntegral n + +prop_Gauss :: Integer -> Bool +prop_Gauss n = let nn = 2 * abs n + 1 + in sum [e nn^(j*j `mod` nn) | j <- [1..(nn - 1) `div` 2]] + == if nn `mod` 4 == 1 + then (-1 + sqrtInteger nn) / 2 + else (-1 + i*sqrtInteger nn) / 2 + +---------------------- +-- QuickCheck Tests -- +---------------------- + +qc_square_sqrtRat :: T.Test +qc_square_sqrtRat + = T.plusTestOptions (T.TestOptions + {T.topt_seed = Nothing + ,T.topt_maximum_generated_tests = Just 15 + ,T.topt_maximum_unsuitable_generated_tests = Nothing + ,T.topt_maximum_test_size = Just 15 + ,T.topt_maximum_test_depth = Nothing + ,T.topt_timeout = Nothing + }) + $ testProperty "QuickCheck prop_square_sqrtRat" prop_square_sqrtRat + +qc_Gauss :: T.Test +qc_Gauss + = T.plusTestOptions (T.TestOptions + {T.topt_seed = Nothing + ,T.topt_maximum_generated_tests = Nothing + ,T.topt_maximum_unsuitable_generated_tests = Nothing + ,T.topt_maximum_test_size = Nothing + ,T.topt_maximum_test_depth = Nothing + ,T.topt_timeout = Nothing + }) + $ testProperty "QuickCheck prop_Gauss" prop_Gauss + +prop_dftInv_dft :: [Rational] -> Bool +prop_dftInv_dft rs = dftInv (dft cs) == cs + where cs = map fromRational rs + +qc_dftInv_dft :: T.Test +qc_dftInv_dft + = T.plusTestOptions (T.TestOptions + {T.topt_seed = Nothing + ,T.topt_maximum_generated_tests = Just 15 + ,T.topt_maximum_unsuitable_generated_tests = Nothing + ,T.topt_maximum_test_size = Just 30 + ,T.topt_maximum_test_depth = Nothing + ,T.topt_timeout = Nothing + }) + $ testProperty "QuickCheck prop_dftInv_dft" prop_dftInv_dft + +prop_dft_dftInv :: [Rational] -> Bool +prop_dft_dftInv rs = dft (dftInv cs) == cs + where cs = map fromRational rs + +qc_dft_dftInv :: T.Test +qc_dft_dftInv + = T.plusTestOptions (T.TestOptions + {T.topt_seed = Nothing + ,T.topt_maximum_generated_tests = Just 15 + ,T.topt_maximum_unsuitable_generated_tests = Nothing + ,T.topt_maximum_test_size = Just 30 + ,T.topt_maximum_test_depth = Nothing + ,T.topt_timeout = Nothing + }) + $ testProperty "QuickCheck prop_dft_dftInv" prop_dft_dftInv +