diff --git a/Examples.hs b/Examples.hs deleted file mode 100644 --- a/Examples.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module Examples where - -import Data.Complex.Cyclotomic -import Data.Ratio - --- | A Discrete Fourier Transform -dft :: [Cyclotomic] -> [Cyclotomic] -dft cs = [sum $ zipWith (*) [conj (e m^(k*n)) | n <- [0..]] cs | k <- [0..m-1]] - where m = fromIntegral $ length cs - --- | Inverse Discrete Fourier Transform -dftInv :: [Cyclotomic] -> [Cyclotomic] -dftInv cs = [minv * sum (zipWith (*) [e m^(k*n) | n <- [0..]] cs) | k <- [0..m-1]] - where m = fromIntegral $ length cs - minv = fromRational (1 % m) diff --git a/Properties.hs b/Properties.hs deleted file mode 100644 --- a/Properties.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - --- Properties.hs is modified from Brent Yorgey's file of the same name --- for his package Data.List.Split - -module Properties where - -import Data.Complex.Cyclotomic -import Test.QuickCheck -import Test.SmallCheck - -import Control.Monad -import Text.Printf - -import Examples - -main :: IO () -main = do - results <- mapM (\(s,t) -> printf "%-40s" s >> t) tests - when (not . all isSuccess $ results) $ fail "Not all tests passed!" - where - isSuccess (Success{}) = True - isSuccess _ = False - qc si su x = quickCheckWithResult (stdArgs { maxSize = si, maxSuccess = su }) x - tests = [ ("square of sqrtRat", qc 15 15 prop_square_sqrtRat) - , ("dftInv . dft", qc 30 15 prop_dftInv_dft) - , ("dft . dftInv", qc 30 15 prop_dft_dftInv) - ] - -two :: Integer -two = 2 - -prop_square_sqrtRat :: Int -> Bool -prop_square_sqrtRat n = sqrtRat (fromIntegral n) ^ two == fromIntegral n - -prop_dftInv_dft :: [Rational] -> Bool -prop_dftInv_dft rs = dftInv (dft cs) == cs - where cs = map fromRational rs - -prop_dft_dftInv :: [Rational] -> Bool -prop_dft_dftInv rs = dft (dftInv cs) == cs - where cs = map fromRational rs - -smallCheckTests :: IO () -smallCheckTests - = smallCheck 10 prop_square_sqrtRat --- smallCheck 10 prop_dftInv_dft >> --- smallCheck 10 prop_dft_dftInv - diff --git a/Tests.hs b/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,113 @@ +{-# 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/UnitTests.hs b/UnitTests.hs deleted file mode 100644 --- a/UnitTests.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module UnitTests where - -import Data.Complex.Cyclotomic -import Test.HUnit ---import Examples -import Data.Ratio - -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] - -test1 :: Test -test1 = TestLabel "polarRat" $ TestList [polarRat 1 (p % q) ~=? e q^p | p <- [0..10], q <- [1..10]] - -test2 :: Test -test2 = TestList [sqrtRat r ^ (2::Int) ~=? fromRational r | r <- take 100 rationals] - -test3 :: Test -test3 = TestList [sqrtRat (r*r) ~=? fromRational (abs r) | r <- take 100 rationals] - -test4 :: Test -test4 = TestList [z * (1 / z) ~=? 1 | n <- [1..10], m <- [1..10], let z = e n + e m, z /= 0] - -main :: IO Counts -main = runTestTT $ TestList [test1,test2,test3,test4] - diff --git a/cyclotomic.cabal b/cyclotomic.cabal --- a/cyclotomic.cabal +++ b/cyclotomic.cabal @@ -1,5 +1,5 @@ Name: cyclotomic -Version: 0.3 +Version: 0.3.1 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 diff --git a/src/Data/Complex/Cyclotomic.hs b/src/Data/Complex/Cyclotomic.hs --- a/src/Data/Complex/Cyclotomic.hs +++ b/src/Data/Complex/Cyclotomic.hs @@ -75,6 +75,9 @@ ,toComplex ,toReal ,toRat + ,goldenRatio + ,dft + ,dftInv ) where @@ -446,3 +449,20 @@ equal [] = True equal [_] = True equal (x:y:ys) = x == y && equal (y:ys) + +-- | The golden ratio, @(1 + √5)/2@. +goldenRatio :: Cyclotomic +goldenRatio = (1 + sqrtRat 5) / 2 + +-- | Discrete Fourier transform, +-- @X_k = \sum_{n=0}^{N-1} x_n \cdot e^{-i 2 \pi \frac{k}{N} n}@. +dft :: [Cyclotomic] -> [Cyclotomic] +dft cs = [sum $ zipWith (*) [conj (e m^(k*n)) | n <- [0..]] cs | k <- [0..m-1]] + where m = fromIntegral $ length cs + +-- | Inverse discrete Fourier transform, +-- @x_n = \frac{1}{N} \sum_{k=0}^{N-1} X_k \cdot e^{i 2 \pi \frac{k}{N} n}@. +dftInv :: [Cyclotomic] -> [Cyclotomic] +dftInv cs = [minv * sum (zipWith (*) [e m^(k*n) | n <- [0..]] cs) | k <- [0..m-1]] + where m = fromIntegral $ length cs + minv = fromRational (1 % m)