numeric-prelude 0.1.1 → 0.1.2
raw patch · 13 files changed
+714/−52 lines, 13 files
Files
- docs/NOTES +11/−0
- numeric-prelude.cabal +6/−1
- src/Algebra/Monoid.hs +48/−5
- src/Algebra/PrincipalIdealDomain.hs +19/−0
- src/Algebra/Units.hs +26/−0
- src/MathObj/Matrix.hs +158/−37
- src/MathObj/Monoid.hs +56/−0
- src/Number/GaloisField2p32m5.hs +93/−0
- test/Test/MathObj/Gaussian/Polynomial.hs +144/−0
- test/Test/MathObj/Matrix.hs +96/−0
- test/Test/MathObj/Polynomial.hs +16/−9
- test/Test/Number/GaloisField2p32m5.hs +37/−0
- test/Test/Run.hs +4/−0
docs/NOTES view
@@ -83,6 +83,17 @@ Juergen Bokowski <bokowski@mathematik.tu-darmstadt.de> DMV-Nachrichten 2004/3 + Gerhard Navratil <Navratil@geoinfo.tuwien.ac.at>+ Partial derivatives, Haskell-Cafe 2006-05-08++ Paul Johnson <paul@cogito.org.uk>+ interval arithmetic+ http://sourceforge.net/projects/ranged-sets++ David Amos <polyomino@f2s.com>+ algebra+ http://polyomino.f2s.com/+ * RealFloat Defines the properties of a Floating type, thus should be named 'Floating'.
numeric-prelude.cabal view
@@ -1,5 +1,5 @@ Name: numeric-prelude-Version: 0.1.1+Version: 0.1.2 License: GPL License-File: LICENSE Author: Dylan Thurston <dpt@math.harvard.edu>, Henning Thielemann <numericprelude@henning-thielemann.de>, Mikael Johansson@@ -185,6 +185,7 @@ MathObj.DiscreteMap MathObj.LaurentPolynomial MathObj.Matrix+ MathObj.Monoid MathObj.PartialFraction MathObj.Permutation MathObj.Permutation.CycleList@@ -204,6 +205,7 @@ Number.DimensionTerm.SI Number.FixedPoint Number.FixedPoint.Check+ Number.GaloisField2p32m5 Number.NonNegative Number.NonNegativeChunky Number.PartiallyTranscendental@@ -246,11 +248,14 @@ GHC-Options: -Wall Other-modules: Test.NumericPrelude.Utility+ Test.Number.GaloisField2p32m5 Test.MathObj.PartialFraction+ Test.MathObj.Matrix Test.MathObj.Polynomial Test.MathObj.PowerSeries Test.MathObj.Gaussian.Variance Test.MathObj.Gaussian.Bell+ Test.MathObj.Gaussian.Polynomial Main-Is: Test/Run.hs If flag(buildTests) Build-Depends: HUnit >=1 && <2
src/Algebra/Monoid.hs view
@@ -5,16 +5,59 @@ Stability : provisional Portability : -Abstract concept of a Monoid. Will be used in order to generate-type classes for generic algebras. An algebra is a vector space-that also is a monoid.+Abstract concept of a Monoid.+Will be used in order to generate type classes for generic algebras.+An algebra is a vector space that also is a monoid.+Should we use the Monoid class from base library+despite its unfortunate method name @mappend@? -} module Algebra.Monoid where -{- | We expect a monoid to adher to associativity and the identity-behaving decently. Nothing more, really. -}+import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring +import Data.Monoid as Mn++{- |+We expect a monoid to adher to associativity and+the identity behaving decently.+Nothing more, really.+-} class C a where idt :: a (<*>) :: a -> a -> a++instance C Mn.All where+ idt = mempty+ (<*>) = mappend++instance C Any where+ idt = mempty+ (<*>) = mappend++instance C a => C (Dual a) where+ idt = Mn.Dual idt+ (Mn.Dual x) <*> (Mn.Dual y) = Mn.Dual (y <*> x)++instance C (Endo a) where+ idt = mempty+ (<*>) = mappend++instance C (First a) where+ idt = mempty+ (<*>) = mappend++instance C (Last a) where+ idt = mempty+ (<*>) = mappend+++instance Ring.C a => C (Product a) where+ idt = Mn.Product Ring.one+ (Mn.Product x) <*> (Mn.Product y) = Mn.Product (x Ring.* y)++instance Additive.C a => C (Sum a) where+ idt = Mn.Sum Additive.zero+ (Mn.Sum x) <*> (Mn.Sum y) = Mn.Sum (x Additive.+ y)+
src/Algebra/PrincipalIdealDomain.hs view
@@ -55,6 +55,8 @@ import Control.Monad (foldM, liftM) import Data.List (mapAccumL, mapAccumR, unfoldr) +import Data.Int (Int, Int8, Int16, Int32, Int64, )+ import PreludeBase import Prelude (Integer, Int) import qualified Prelude as P@@ -137,6 +139,11 @@ in aux -- could be implemented in a tail-recursive manner+{-+Unfortunately, with the normalization to the stdAssociate,+@gcd 0@ is no longer the identity function,+since @gcd 0 (-2) = 2@.+-} extendedEuclid :: (Units.C a, ZeroTestable.C a) => (a -> a -> (a,a)) -> a -> a -> (a,(a,a)) extendedEuclid genDivMod =@@ -288,6 +295,18 @@ gcd = euclid mod instance C Int where+ gcd = euclid mod++instance C Int8 where+ gcd = euclid mod++instance C Int16 where+ gcd = euclid mod++instance C Int32 where+ gcd = euclid mod++instance C Int64 where gcd = euclid mod
src/Algebra/Units.hs view
@@ -32,6 +32,8 @@ import Algebra.Additive (negate) import Algebra.ZeroTestable (isZero) +import Data.Int (Int, Int8, Int16, Int32, Int64, )+ import PreludeBase import Prelude (Integer, Int) import qualified Prelude as P@@ -96,6 +98,30 @@ stdUnitInv = intStandardInverse instance C Integer where+ isUnit = intQuery+ stdAssociate = intAssociate+ stdUnit = intStandard+ stdUnitInv = intStandardInverse++instance C Int8 where+ isUnit = intQuery+ stdAssociate = intAssociate+ stdUnit = intStandard+ stdUnitInv = intStandardInverse++instance C Int16 where+ isUnit = intQuery+ stdAssociate = intAssociate+ stdUnit = intStandard+ stdUnitInv = intStandardInverse++instance C Int32 where+ isUnit = intQuery+ stdAssociate = intAssociate+ stdUnit = intStandard+ stdUnitInv = intStandardInverse++instance C Int64 where isUnit = intQuery stdAssociate = intAssociate stdUnit = intStandard
src/MathObj/Matrix.hs view
@@ -2,16 +2,45 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |-Copyright : (c) Mikael Johansson 2006-Maintainer : mik@math.uni-jena.de+Copyright : (c) Henning Thielemann 2009, Mikael Johansson 2006+Maintainer : numericprelude@henning-thielemann.de Stability : provisional Portability : requires multi-parameter type classes Routines and abstractions for Matrices and basic linear algebra over fields or rings.++We stick to simple Int indices.+Although advanced indices would be nice+e.g. for matrices with sub-matrices,+this is not easily implemented since arrays+do only support a lower and an upper bound+but no additional parameters.++ToDo:+ - Matrix inverse, determinant -} -module MathObj.Matrix where+module MathObj.Matrix (+ T, Dimension,+ format,+ transpose,+ rows,+ columns,+ fromRows,+ fromColumns,+ fromList,+ dimension,+ numRows,+ numColumns,+ zipWith,+ zero,+ one,+ diagonal,+ scale,+ random,+ randomR,+ ) where import qualified Algebra.Module as Module import qualified Algebra.Vector as Vector@@ -20,32 +49,34 @@ import Algebra.Module((*>), ) import Algebra.Ring((*), fromInteger, scalarProduct, )-import Algebra.Additive((+), (-), zero, subtract, )+import Algebra.Additive((+), (-), subtract, ) -import Data.Array (Array, listArray, elems, bounds, (!), ixmap, range, )+import qualified System.Random as Rnd+import Data.Array (Array, array, listArray, accumArray, elems, bounds, (!), ixmap, range, ) import qualified Data.List as List import Control.Monad (liftM2, ) import Control.Exception (assert, ) -import Data.Tuple.HT (swap, )+import Data.Tuple.HT (swap, mapFst, ) import Data.List.HT (outerProduct, )-import NumericPrelude (Integer, )++import NumericPrelude (Int, ) import PreludeBase hiding (zipWith, ) + {- |-A matrix is a twodimensional array of ring elements, indexed by integers.+A matrix is a twodimensional array, indexed by integers. -}+data T a =+ Cons (Array (Dimension, Dimension) a)+ deriving (Eq,Ord,Read) -data {-(Ring.C a) =>-}- T a = Cons (Array (Integer, Integer) a) deriving (Eq,Ord,Read)+type Dimension = Int {- |-Transposition of matrices is just transposition in the sense of-Data.List.+Transposition of matrices is just transposition in the sense of Data.List. -}-- transpose :: T a -> T a transpose (Cons m) = let (lower,upper) = bounds m@@ -59,31 +90,63 @@ columns :: T a -> [[a]] columns (Cons m) = let ((lr,lc), (ur,uc)) = bounds m- in outerProduct (curry(m!)) (range (lc,uc)) (range (lr,ur))+ in outerProduct (flip(curry(m!))) (range (lc,uc)) (range (lr,ur)) -fromList :: Integer -> Integer -> [a] -> T a-fromList m n xs = Cons (listArray ((1,1),(m,n)) xs)+fromRows :: Dimension -> Dimension -> [[a]] -> T a+fromRows m n =+ Cons .+ array (indexBounds m n) .+ concat .+ List.zipWith (\r -> map (\(c,x) -> ((r,c),x))) allIndices .+ map (zip allIndices) -instance (Ring.C a, Show a) => Show (T a) where- show m = List.unlines $ map (\r -> "(" ++ r ++ ")")- $ map (unwords . map show) $ rows m+fromColumns :: Dimension -> Dimension -> [[a]] -> T a+fromColumns m n =+ Cons .+ array (indexBounds m n) .+ concat .+ List.zipWith (\r -> map (\(c,x) -> ((c,r),x))) allIndices .+ map (zip allIndices) +fromList :: Dimension -> Dimension -> [a] -> T a+fromList m n xs = Cons (listArray (indexBounds m n) xs) -dimension :: T a -> (Integer,Integer)+appPrec :: Int+appPrec = 10++instance (Show a) => Show (T a) where+ showsPrec p m =+ showParen (p >= appPrec)+ (showString "Matrix.fromRows " . showsPrec appPrec (rows m))++format :: (Show a) => T a -> String+format m = formatS m ""++formatS :: (Show a) => T a -> ShowS+formatS =+ concatS .+ map (\r -> showString "(" . concatS r . showString ")\n") .+ map (List.intersperse (' ':) . map (showsPrec 11)) .+ rows++concatS :: [ShowS] -> ShowS+concatS = flip (foldr ($))++dimension :: T a -> (Dimension,Dimension) dimension (Cons m) = uncurry subtract (bounds m) + (1,1) -numRows :: T a -> Integer+numRows :: T a -> Dimension numRows = fst . dimension -numColumns :: T a -> Integer+numColumns :: T a -> Dimension numColumns = snd . dimension -- These implementations may benefit from a better exception than -- just assertions to validate dimensionalities instance (Additive.C a) => Additive.C (T a) where- (+) = zipWith (+)- (-) = zipWith (-)- zero = zeroMatrix 1 1+ (+) = zipWith (+)+ (-) = zipWith (-)+ zero = zero 1 1 zipWith :: (a -> b -> c) -> T a -> T b -> T c zipWith op mM@(Cons m) nM@(Cons n) =@@ -93,30 +156,71 @@ in assert (d == dimension nM) $ uncurry fromList d (List.zipWith op em en) -zeroMatrix :: (Additive.C a) => Integer -> Integer -> T a-zeroMatrix m n = fromList m n $- List.repeat zero+zero :: (Additive.C a) => Dimension -> Dimension -> T a+zero m n =+ fromList m n $+ List.repeat Additive.zero -- List.replicate (fromInteger (m*n)) zero +one :: (Ring.C a) => Dimension -> T a+one n =+ Cons $+ accumArray (flip const) Additive.zero+ (indexBounds n n)+ (map (\i -> ((i,i), Ring.one)) (indexRange n))++diagonal :: (Additive.C a) => [a] -> T a+diagonal xs =+ let n = List.length xs+ in Cons $+ accumArray (flip const) Additive.zero+ (indexBounds n n)+ (zip (map (\i -> (i,i)) allIndices) xs)++scale :: (Ring.C a) => a -> T a -> T a+scale s = Vector.functorScale s+ instance (Ring.C a) => Ring.C (T a) where- mM * nM = assert (numRows mM == numColumns nM) $- fromList (numColumns mM) (numRows nM)- (liftM2 scalarProduct (rows mM) (columns nM))- fromInteger n = fromList 1 1 [fromInteger n]+ mM * nM =+ assert (numColumns mM == numRows nM) $+ fromList (numRows mM) (numColumns nM)+ (liftM2 scalarProduct (rows mM) (columns nM))+ fromInteger n = fromList 1 1 [fromInteger n] instance Functor T where fmap f (Cons m) = Cons (fmap f m) instance Vector.C T where- zero = zero+ zero = Additive.zero (<+>) = (+)- (*>) = Vector.functorScale+ (*>) = scale instance Module.C a b => Module.C a (T b) where x *> m = fmap (x*>) m -{- |-What more do we need from our matrix class? We have addition,++random :: (Rnd.RandomGen g, Rnd.Random a) =>+ Dimension -> Dimension -> g -> (T a, g)+random =+ randomAux Rnd.random++randomR :: (Rnd.RandomGen g, Rnd.Random a) =>+ Dimension -> Dimension -> (a,a) -> g -> (T a, g)+randomR m n rng =+ randomAux (Rnd.randomR rng) m n++{-+could be made nicer with the State monad,+but I like to keep dependencies minimal+-}+randomAux :: (Rnd.RandomGen g, Rnd.Random a) =>+ (g -> (a,g)) -> Dimension -> Dimension -> g -> (T a, g)+randomAux rnd m n g0 =+ mapFst (fromList m n) $ swap $+ List.mapAccumL (\g _i -> swap $ rnd g) g0 (indexRange (m*n))++{-+What more do we need from our matrix type? We have addition, subtraction and multiplication, and thus composition of generic free-module-maps. We're going to want to solve linear equations with or without fields underneath, so we're going to want an implementation@@ -125,6 +229,7 @@ with the Gaussian algorithm or some other goodish method. -} +{- {- | We'll want generic linear equation solving, returning one solution, any solution really, or nothing. Basically, this is asking for the@@ -144,7 +249,23 @@ (numRows a == numRows y && -- they match numColumns y == 1) -- and y is a column vector Nothing+-} {- Cf. /usr/lib/hugs/demos/Matrix.hs -}+++-- these functions control whether we use 0 or 1 based indices++indexRange :: Dimension -> [Dimension]+indexRange n = [0..(n-1)]++indexBounds ::+ Dimension -> Dimension ->+ ((Dimension,Dimension), (Dimension,Dimension))+indexBounds m n =+ ((0,0), (m-1,n-1))++allIndices :: [Dimension]+allIndices = [0..]
+ src/MathObj/Monoid.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.Monoid where++import qualified Algebra.PrincipalIdealDomain as PID++import Algebra.PrincipalIdealDomain (gcd, lcm, )+import Algebra.Additive (zero, )+import Algebra.Monoid (C, idt, (<*>), )++import PreludeBase++{- |+It is only a monoid for non-negative numbers.++> idt <*> GCD (-2) = GCD 2++Thus, use this Monoid only for non-negative numbers!+-}+newtype GCD a = GCD {runGCD :: a}+ deriving (Show, Eq)++instance PID.C a => C (GCD a) where+ idt = GCD zero+ (GCD x) <*> (GCD y) = GCD (gcd x y)+++newtype LCM a = LCM {runLCM :: a}+ deriving (Show, Eq)++instance PID.C a => C (LCM a) where+ idt = LCM zero+ (LCM x) <*> (LCM y) = LCM (lcm x y)+++{- |+@Nothing@ is the largest element.+-}+newtype Min a = Min {runMin :: Maybe a}+ deriving (Show, Eq)++instance Ord a => C (Min a) where+ idt = Min Nothing+ (Min x) <*> (Min y) = Min $+ maybe y (\x' -> maybe x (Just . min x') y) x+++{- |+@Nothing@ is the smallest element.+-}+newtype Max a = Max {runMax :: Maybe a}+ deriving (Show, Eq)++instance Ord a => C (Max a) where+ idt = Max Nothing+ (Max x) <*> (Max y) = Max $+ maybe y (\x' -> maybe x (Just . max x') y) x
+ src/Number/GaloisField2p32m5.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+This number type is intended for tests of functions over fields,+where the field elements need constant space.+This way we can provide a Storable instance.+For 'Rational' this would not be possible.++However, be aware that sums of non-zero elements may yield zero.+Thus division is not always safe, where it is for rational numbers.+-}+module Number.GaloisField2p32m5 where++import qualified Number.ResidueClass as RC+import qualified Algebra.Module as Module+import qualified Algebra.Field as Field+import qualified Algebra.Ring as Ring+import qualified Algebra.Additive as Additive++import Data.Int (Int64, )+import Data.Word (Word32, Word64, )++import qualified Foreign.Storable.Newtype as SN+import qualified Foreign.Storable as St++import Test.QuickCheck (Arbitrary(..), )++import PreludeBase+import NumericPrelude+++newtype T = Cons {decons :: Word32}+ deriving Eq++{-# INLINE appPrec #-}+appPrec :: Int+appPrec = 10++instance Show T where+ showsPrec p (Cons x) =+ showsPrec p x+{-+ showParen (p >= appPrec)+ (showString "GF2p32m5.Cons " . shows x)+-}++instance Arbitrary T where+ arbitrary = fmap (Cons . fromInteger . flip mod base) arbitrary+ coarbitrary = undefined++instance St.Storable T where+ sizeOf = SN.sizeOf decons+ alignment = SN.alignment decons+ peek = SN.peek Cons+ poke = SN.poke decons+++base :: Ring.C a => a+base = 2^32-5+++{-# INLINE lift2 #-}+lift2 :: (Word64 -> Word64 -> Word64) -> (T -> T -> T)+lift2 f (Cons x) (Cons y) =+ Cons (fromIntegral (mod (f (fromIntegral x) (fromIntegral y)) base))++{-# INLINE lift2Integer #-}+lift2Integer :: (Int64 -> Int64 -> Int64) -> (T -> T -> T)+lift2Integer f (Cons x) (Cons y) =+ Cons (fromIntegral (mod (f (fromIntegral x) (fromIntegral y)) base))+++instance Additive.C T where+ zero = Cons zero+ (+) = lift2 (+)+-- (-) = lift2 (-)+ x-y = x + negate y+ negate n@(Cons x) =+ if x==0+ then n+ else Cons (base-x)++instance Ring.C T where+ one = Cons one+ (*) = lift2 (*)+ fromInteger =+ Cons . fromInteger . flip mod base++instance Field.C T where+ (/) = lift2Integer (RC.divide base)++instance Module.C T T where+ (*>) = (*)
+ test/Test/MathObj/Gaussian/Polynomial.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Gaussian.Polynomial where++import qualified MathObj.Gaussian.Polynomial as G+import qualified MathObj.Gaussian.Bell as B++import qualified MathObj.Polynomial as Poly++-- import qualified Algebra.Ring as Ring++import qualified Algebra.Laws as Laws++import qualified Number.Complex as Complex++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>))+import qualified Test.HUnit as HUnit++import qualified Number.NonNegative as NonNeg+import Data.Function.HT (nest, )+import Data.Tuple.HT (mapSnd, )++-- import Debug.Trace (trace, )++import PreludeBase as P+import NumericPrelude as NP+++simple ::+ (Testable t) =>+ (G.T Rational -> t) -> IO ()+simple f =+ quickCheck (\x -> f (x :: G.T Rational))++tests :: HUnit.Test+tests =+ HUnit.TestLabel "polynomial" $+ HUnit.TestList $+ map testUnit $+ testList++testList :: [(String, IO ())]+testList =+{-+ ("convolution, dirac",+ simple $ Laws.identity (+) zero) :+-}+ ("convolution, commutative",+ simple $ Laws.commutative G.convolve) :+-- simple $ \x -> Laws.commutative G.convolve (trace (show x) x)) :+ ("convolution, associative",+ simple $ Laws.associative G.convolve) :+ ("multiplication, one",+ simple $ Laws.identity G.multiply G.constant) :+ ("multiplication, commutative",+ simple $ Laws.commutative G.multiply) :+ ("multiplication, associative",+ simple $ Laws.associative G.multiply) :+ ("convolution, multplication, fourier",+ simple $ \x y ->+ G.fourier (G.convolve x y)+ == G.multiply (G.fourier x) (G.fourier y)) :+ ("fourier reverse",+ simple $ \x -> nest 2 G.fourier x == G.reverse x) :+ ("reverse identity",+ simple $ \x -> nest 2 G.reverse x == x) :+ ("fourier eigenfunction differential",+ quickCheck $ \m ->+ m <= 15 ==>+ let n = NonNeg.toNumber m+ x = G.eigenfunctionDifferential n :: G.T Rational+ k = Complex.conjugate Complex.imaginaryUnit ^ fromIntegral n+ in G.fourier x == G.scaleComplex k x) :+ ("fourier eigenfunction iterative",+ quickCheck $ \m ->+ m <= 15 ==>+ let n = NonNeg.toNumber m+ x = G.eigenfunctionIterative n :: G.T Rational+ k = Complex.conjugate Complex.imaginaryUnit ^ fromIntegral n+ in G.fourier x == G.scaleComplex k x) :+{- this does not hold, both functions compute different eigenbases+ ("fourier eigenfunction diff vs. iterative",+ quickCheck $ \n ->+ n <= 15 ==>+ G.eigenfunctionDifferential n ==+ (G.eigenfunctionIterative n :: G.T Rational)) :+-}+ ("translate additive",+ simple $ \x a b ->+ G.translate a (G.translate b x) == G.translate (a+b) x) :+ ("translateComplex additive",+ simple $ \x a b ->+ G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x) :+ ("translateComplex real",+ simple $ \x a ->+ G.translateComplex (Complex.fromReal a) x == G.translate a x) :+ ("modulate additive",+ simple $ \x a b ->+ G.modulate a (G.modulate b x) == G.modulate (a+b) x) :+ ("commute translate modulate",+ simple $ \x a b ->+ G.modulate b (G.translate a x)+ == G.turn (a*b) (G.translate a (G.modulate b x))) :+ ("fourier translate",+ simple $ \x a ->+ G.fourier (G.translate a x)+ == G.modulate a (G.fourier x)) :+ ("dilate multiplicative",+ simple $ \x a b -> a>0 && b>0 ==>+ G.dilate a (G.dilate b x) == G.dilate (a*b) x) :+ ("dilate by shrink",+ simple $ \x a -> a>0 ==>+ G.shrink a x == G.dilate (recip a) x) :+ ("fourier dilate",+ simple $ \x a -> a>0 ==>+ G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))) :+ ("integrate differentiate",+ simple $ \x ->+ G.integrate (G.differentiate x) == (zero, x)) :+ ("fourier differentiate",+ simple $ \x ->+ G.fourier (G.differentiate x) ==+ let y = G.fourier x+ in y{G.polynomial =+ Poly.fromCoeffs [0, 0 Complex.+: 2] * G.polynomial y}) :+ ("approximate by bells, translate",+ simple $ \x unit d -> unit/=0 ==>+ G.approximateByBells unit (G.translateComplex d x) ==+ map (mapSnd (B.translateComplex d)) (G.approximateByBells unit x)) :+ ("approximate by bells, dilate",+ simple $ \x unit d -> unit/=0 && d/=0 ==>+ G.approximateByBells unit (G.dilate d x) ==+ map (mapSnd (B.dilate d)) (G.approximateByBells (unit/d) x)) :+ ("approximate by bells, shrink",+ simple $ \x unit d -> unit/=0 && d/=0 ==>+ G.approximateByBells unit (G.shrink d x) ==+ map (mapSnd (B.shrink d)) (G.approximateByBells (unit*d) x)) :+ ("approximate by bells, different implementations",+ quickCheck $ \unit d s p -> unit/=0 ==>+ G.approximateByBellsAtOnce unit d s (p::Poly.T (Complex.T Rational)) ==+ G.approximateByBellsByTranslation unit d s p) :+ []
+ test/Test/MathObj/Matrix.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Matrix where++import qualified MathObj.Matrix as Matrix++import qualified Algebra.Ring as Ring++import qualified Algebra.Laws as Laws++import qualified Number.NonNegative as NonNeg++import qualified System.Random as Random++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (quickCheck, )+import qualified Test.HUnit as HUnit+++import PreludeBase as P+import NumericPrelude as NP+++type Seed = Int+type Dimension = NonNeg.Int++random :: Dimension -> Dimension -> Seed -> Matrix.T Integer+random mn nn seed =+ fst $+ Matrix.random (NonNeg.toNumber mn) (NonNeg.toNumber nn) $+ Random.mkStdGen seed+++tests :: HUnit.Test+tests =+ HUnit.TestLabel "matrix" $+ HUnit.TestList $+ map testUnit $+ ("dimension",+ quickCheck (\m n a ->+ (NonNeg.toNumber m, NonNeg.toNumber n) == Matrix.dimension (random m n a))) :+ ("to and from rows",+ quickCheck (\m n a' ->+ let a = random m n a'+ in a == Matrix.fromRows (NonNeg.toNumber m) (NonNeg.toNumber n) (Matrix.rows a))) :+ ("to and from columns",+ quickCheck (\m n a' ->+ let a = random m n a'+ in a == Matrix.fromColumns (NonNeg.toNumber m) (NonNeg.toNumber n) (Matrix.columns a))) :+ ("transpose, rows, columns",+ quickCheck (\m n a' ->+ let a = random m n a'+ in Matrix.rows a == Matrix.columns (Matrix.transpose a))) :+ ("transpose, columns, rows",+ quickCheck (\m n a' ->+ let a = random m n a'+ in Matrix.columns a == Matrix.rows (Matrix.transpose a))) :+ ("addition, zero",+ quickCheck (\m n a ->+ Laws.identity (+) (Matrix.zero (NonNeg.toNumber m) (NonNeg.toNumber n)) (random m n a))) :+ ("addition, commutative",+ quickCheck (\m n a b ->+ Laws.commutative (+) (random m n a) (random m n b))) :+ ("addition, associative",+ quickCheck (\m n a b c ->+ Laws.associative (+) (random m n a) (random m n b) (random m n c))) :+ ("addition, transpose",+ quickCheck (\m n a b ->+ Laws.homomorphism Matrix.transpose (+) (+) (random m n a) (random m n b))) :+ ("one, diagonal",+ quickCheck (\n' ->+ let n = NonNeg.toNumber n'+ in Matrix.one n == (Matrix.diagonal $ replicate n Ring.one :: Matrix.T Integer))) :+ ("multiplication, one left",+ quickCheck (\m n a ->+ Laws.leftIdentity (*) (Matrix.one (NonNeg.toNumber m)) (random m n a))) :+ ("multiplication, one right",+ quickCheck (\m n a ->+ Laws.rightIdentity (*) (Matrix.one (NonNeg.toNumber n)) (random m n a))) :+ ("multiplication, associative",+ quickCheck (\k l m n a b c ->+ Laws.associative (*) (random k l a) (random l m b) (random m n c))) :+ ("multiplication and addition, distributive left",+ quickCheck (\l m n a b c ->+ Laws.leftDistributive (*) (+) (random n l a) (random m n b) (random m n c))) :+ ("multiplication and addition, distributive right",+ quickCheck (\l m n a b c ->+ Laws.rightDistributive (*) (+) (random l m a) (random m n b) (random m n c))) :+ ("multiplication, transpose",+ quickCheck (\l m n a b ->+ Laws.homomorphism Matrix.transpose (*) (flip (*)) (random l m a) (random m n b))) :+{-+ ("division", quickCheck (\x -> Integral.propInverse (x :: Poly.T Rational))) :+-}+ []
test/Test/MathObj/Polynomial.hs view
@@ -14,7 +14,7 @@ import qualified Data.List as List import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Property, quickCheck, (==>))+import Test.QuickCheck (Property, quickCheck, (==>), Testable, ) import qualified Test.HUnit as HUnit @@ -32,6 +32,13 @@ mul xs ys = Poly.equal (Poly.mul xs ys) (Poly.mulShear xs ys) +test :: Testable a => (Poly.T Integer -> a) -> IO ()+test = quickCheck++testRat :: Testable a => (Poly.T Rational -> a) -> IO ()+testRat = quickCheck++ tests :: HUnit.Test tests = HUnit.TestLabel "polynomial" $@@ -39,12 +46,12 @@ map testUnit $ ("tensor product", quickCheck (tensorProductTranspose :: [Integer] -> [Integer] -> Property)) : ("mul speed", quickCheck (mul :: [Integer] -> [Integer] -> Bool)) :- ("addition, zero", quickCheck (\x -> Laws.identity (+) zero (x :: Poly.T Integer))) :- ("addition, commutative", quickCheck (\x -> Laws.commutative (+) (x :: Poly.T Integer))) :- ("addition, associative", quickCheck (\x -> Laws.associative (+) (x :: Poly.T Integer))) :- ("multiplication, one", quickCheck (\x -> Laws.identity (*) one (x :: Poly.T Integer))) :- ("multiplication, commutative", quickCheck (\x -> Laws.commutative (*) (x :: Poly.T Integer))) :- ("multiplication, associative", quickCheck (\x -> Laws.associative (*) (x :: Poly.T Integer))) :- ("multiplication and addition, distributive", quickCheck (\x -> Laws.leftDistributive (*) (+) (x :: Poly.T Integer))) :- ("division", quickCheck (\x -> Integral.propInverse (x :: Poly.T Rational))) :+ ("addition, zero", test (Laws.identity (+) zero)) :+ ("addition, commutative", test (Laws.commutative (+))) :+ ("addition, associative", test (Laws.associative (+))) :+ ("multiplication, one", test (Laws.identity (*) one)) :+ ("multiplication, commutative", test (Laws.commutative (*))) :+ ("multiplication, associative", test (Laws.associative (*))) :+ ("multiplication and addition, distributive", test (Laws.leftDistributive (*) (+))) :+ ("division", testRat (Integral.propInverse)) : []
+ test/Test/Number/GaloisField2p32m5.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.Number.GaloisField2p32m5 where++import qualified Number.GaloisField2p32m5 as GF++import qualified Algebra.Laws as Laws++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>))+import qualified Test.HUnit as HUnit+++import PreludeBase as P+import NumericPrelude as NP+++test :: Testable a => (GF.T -> a) -> IO ()+test = quickCheck+++tests :: HUnit.Test+tests =+ HUnit.TestLabel "galois field 2^32-5" $+ HUnit.TestList $+ map testUnit $+ ("addition, zero", test (Laws.identity (+) zero)) :+ ("addition, commutative", test (Laws.commutative (+))) :+ ("addition, associative", test (Laws.associative (+))) :+ ("addition, negate", test (Laws.inverse (+) negate zero)) :+ ("addition, subtract", test (\x -> Laws.inverse (+) (x-) x)) :+ ("multiplication, one", test (Laws.identity (*) one)) :+ ("multiplication, commutative", test (Laws.commutative (*))) :+ ("multiplication, associative", test (Laws.associative (*))) :+ ("multiplication, recip", test (\y -> y /= 0 ==> Laws.inverse (*) recip one y)) :+ ("multiplication, division", test (\y x -> y /= 0 ==> Laws.inverse (*) (x/) x y)) :+ ("multiplication and addition, distributive", test (Laws.leftDistributive (*) (+))) :+ []
test/Test/Run.hs view
@@ -4,8 +4,10 @@ import qualified Test.MathObj.Gaussian.Variance as GaussVariance import qualified Test.MathObj.Gaussian.Bell as GaussBell import qualified Test.MathObj.PartialFraction as PartialFraction+import qualified Test.MathObj.Matrix as Matrix import qualified Test.MathObj.Polynomial as Polynomial import qualified Test.MathObj.PowerSeries as PowerSeries+import qualified Test.Number.GaloisField2p32m5 as GF import qualified Test.HUnit.Text as HUnitText import qualified Test.HUnit as HUnit @@ -16,7 +18,9 @@ GaussBell.tests : GaussPoly.tests : PartialFraction.tests :+ Matrix.tests : Polynomial.tests : PowerSeries.tests :+ GF.tests : []) return ()