numeric-prelude 0.4.3.2 → 0.4.3.3
raw patch · 110 files changed
+2831/−1680 lines, 110 filesdep +doctest-exitcode-stdiodep +doctest-libdep −HUnitdep ~QuickCheckdep ~utility-ht
Dependencies added: doctest-exitcode-stdio, doctest-lib
Dependencies removed: HUnit
Dependency ranges changed: QuickCheck, utility-ht
Files
- Makefile +11/−0
- gaussian/MathObj/Gaussian/Bell.hs +85/−11
- gaussian/MathObj/Gaussian/Example.hs +1/−6
- gaussian/MathObj/Gaussian/ExponentTuple.hs +114/−0
- gaussian/MathObj/Gaussian/Polynomial.hs +108/−4
- gaussian/MathObj/Gaussian/Variance.hs +99/−20
- numeric-prelude.cabal +29/−34
- playground/Number/ComplexSquareRoot.hs +137/−0
- src/Algebra/Absolute.hs +2/−2
- src/Algebra/Additive.hs +14/−2
- src/Algebra/Algebraic.hs +1/−2
- src/Algebra/Differential.hs +1/−3
- src/Algebra/DivisibleSpace.hs +1/−1
- src/Algebra/Field.hs +1/−1
- src/Algebra/FloatingPoint.hs +1/−1
- src/Algebra/IntegralDomain.hs +18/−2
- src/Algebra/Lattice.hs +1/−1
- src/Algebra/Module.hs +1/−1
- src/Algebra/ModuleBasis.hs +1/−3
- src/Algebra/NonNegative.hs +0/−2
- src/Algebra/NormedSpace/Euclidean.hs +1/−1
- src/Algebra/NormedSpace/Maximum.hs +1/−1
- src/Algebra/NormedSpace/Sum.hs +1/−1
- src/Algebra/OccasionallyScalar.hs +1/−1
- src/Algebra/PrincipalIdealDomain.hs +29/−8
- src/Algebra/RealField.hs +1/−3
- src/Algebra/RealIntegral.hs +1/−3
- src/Algebra/RealRing.hs +55/−2
- src/Algebra/RealTranscendental.hs +1/−1
- src/Algebra/RightModule.hs +1/−3
- src/Algebra/Ring.hs +1/−2
- src/Algebra/ToInteger.hs +1/−0
- src/Algebra/ToRational.hs +2/−1
- src/Algebra/Transcendental.hs +1/−3
- src/Algebra/Units.hs +1/−2
- src/Algebra/Vector.hs +1/−2
- src/Algebra/VectorSpace.hs +1/−2
- src/Algebra/ZeroTestable.hs +1/−2
- src/MathObj/Algebra.hs +1/−1
- src/MathObj/DiscreteMap.hs +1/−2
- src/MathObj/LaurentPolynomial.hs +1/−2
- src/MathObj/Matrix.hs +65/−1
- src/MathObj/Monoid.hs +1/−1
- src/MathObj/PartialFraction.hs +101/−11
- src/MathObj/Permutation.hs +1/−3
- src/MathObj/Permutation/CycleList.hs +1/−1
- src/MathObj/Permutation/CycleList/Check.hs +3/−10
- src/MathObj/Permutation/Table.hs +1/−2
- src/MathObj/Polynomial.hs +30/−1
- src/MathObj/Polynomial/Core.hs +34/−4
- src/MathObj/PowerSeries.hs +15/−1
- src/MathObj/PowerSeries/Core.hs +82/−4
- src/MathObj/PowerSeries/DifferentialEquation.hs +1/−1
- src/MathObj/PowerSeries/Example.hs +44/−9
- src/MathObj/PowerSeries/Mean.hs +1/−1
- src/MathObj/PowerSeries2.hs +1/−6
- src/MathObj/PowerSeries2/Core.hs +1/−2
- src/MathObj/PowerSum.hs +1/−1
- src/MathObj/RefinementMask2.hs +52/−10
- src/MathObj/RootSet.hs +1/−1
- src/Number/Complex.hs +1/−3
- src/Number/DimensionTerm/SI.hs +1/−3
- src/Number/FixedPoint.hs +4/−5
- src/Number/FixedPoint/Check.hs +1/−1
- src/Number/GaloisField2p32m5.hs +26/−2
- src/Number/NonNegative.hs +1/−2
- src/Number/OccasionallyScalarExpression.hs +1/−1
- src/Number/PartiallyTranscendental.hs +1/−2
- src/Number/Peano.hs +2/−6
- src/Number/Physical.hs +1/−1
- src/Number/Physical/Read.hs +1/−2
- src/Number/Physical/Show.hs +1/−1
- src/Number/Physical/Unit.hs +1/−1
- src/Number/Physical/UnitDatabase.hs +1/−2
- src/Number/Positional.hs +2/−3
- src/Number/Positional/Check.hs +1/−3
- src/Number/Quaternion.hs +1/−3
- src/Number/Ratio.hs +1/−1
- src/Number/ResidueClass.hs +1/−3
- src/Number/ResidueClass/Check.hs +1/−1
- src/Number/ResidueClass/Func.hs +1/−1
- src/Number/ResidueClass/Maybe.hs +1/−1
- src/Number/ResidueClass/Reader.hs +1/−3
- src/Number/SI.hs +1/−1
- src/Number/SI/Unit.hs +1/−1
- src/NumericPrelude/List/Checked.hs +1/−2
- src/NumericPrelude/List/Generic.hs +1/−1
- src/NumericPrelude/Numeric.hs +1/−1
- test/Demo.hs +1/−1
- test/Number/ComplexSquareRoot.hs +0/−117
- test/Test/Algebra/Additive.hs +24/−31
- test/Test/Algebra/IntegralDomain.hs +37/−37
- test/Test/Algebra/PrincipalIdealDomain.hs +49/−0
- test/Test/Algebra/RealRing.hs +120/−34
- test/Test/MathObj/Gaussian/Bell.hs +150/−96
- test/Test/MathObj/Gaussian/ExponentTuple.hs +26/−0
- test/Test/MathObj/Gaussian/Polynomial.hs +206/−156
- test/Test/MathObj/Gaussian/Variance.hs +136/−221
- test/Test/MathObj/Matrix.hs +111/−96
- test/Test/MathObj/PartialFraction.hs +122/−191
- test/Test/MathObj/Polynomial.hs +57/−82
- test/Test/MathObj/Polynomial/Core.hs +51/−0
- test/Test/MathObj/PowerSeries.hs +19/−161
- test/Test/MathObj/PowerSeries/Core.hs +178/−0
- test/Test/MathObj/PowerSeries/Example.hs +92/−0
- test/Test/MathObj/RefinementMask2.hs +61/−67
- test/Test/Number/ComplexSquareRoot.hs +51/−45
- test/Test/Number/GaloisField2p32m5.hs +65/−32
- test/Test/NumericPrelude/Utility.hs +11/−15
- test/Test/Run.hs +40/−32
Makefile view
@@ -17,5 +17,16 @@ ghci-compile: $(HCI7) -Wall -i:src:test +RTS -M256m -c30 -RTS -fobject-code -O -hidir=dist/build -odir=dist/build test/Demo.hs ++run-test: update-test+ runhaskell Setup configure --user -fbuildExamples --enable-tests+ runhaskell Setup build+ runhaskell Setup haddock+ ./dist/build/numeric-prelude-test/numeric-prelude-test++update-test:+ doctest-extract-0.1 -i src/ -i gaussian/ -i playground/ -o test/ --executable-main=Test/Run.hs $$(cat test-module.list)++ %.html: %.md pandoc $< --output=$@
gaussian/MathObj/Gaussian/Bell.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Complex translated and modulated Gaussian bell curve. @@ -23,11 +23,33 @@ import Test.QuickCheck (Arbitrary, arbitrary, ) import Control.Monad (liftM4, ) --- import Prelude (($)) import NumericPrelude.Numeric import NumericPrelude.Base hiding (reverse, ) +{- $setup+>>> import qualified MathObj.Gaussian.Bell as G+>>> import qualified Algebra.ZeroTestable as ZeroTestable+>>> import qualified Algebra.Laws as Laws+>>> import qualified Number.Complex as Complex+>>> import Number.Complex ((+:))+>>> import NumericPrelude.Base as P+>>> import NumericPrelude.Numeric as NP+>>> import Prelude ()+>>> import qualified Test.QuickCheck as QC+>>> import Data.Function.HT (Id, nest)+>>>+>>> asRational :: Id (G.T Rational)+>>> asRational = id+>>>+>>> withRational :: Id (G.T Rational -> a)+>>> withRational = id+>>>+>>> isConstant :: ZeroTestable.C a => G.T a -> Bool+>>> isConstant (G.Cons _amp _a b c) = isZero b && isZero c+-}++ data T a = Cons {amp :: a, c0, c1 :: Complex.T a, c2 :: a} deriving (Eq, Show) @@ -82,6 +104,11 @@ variance f = recip $ c2 f * 2*pi +{- |+prop> Laws.identity G.multiply G.constant . asRational+prop> Laws.commutative G.multiply . asRational+prop> Laws.associative G.multiply . asRational+-} multiply :: (Ring.C a) => T a -> T a -> T a multiply f g =@@ -118,8 +145,24 @@ (Complex.scale p $ c0 f) (Complex.scale p $ c1 f) (p * c2 f) -{--let x=Cons 2 (1+:3) (4+:5) (7::Rational); y=Cons 7 (1+:4) (3+:2) (5::Rational)+{- |+>>> let x=G.Cons 2 (1+:3) (4+:5) (7::Rational); y=G.Cons 7 (1+:4) (3+:2) (5::Rational) in G.convolve x y+Cons {amp = 7 % 6, c0 = 13 % 6 +: 55 % 8, c1 = 41 % 12 +: 13 % 4, c2 = 35 % 12}++prop> Laws.commutative G.convolve . asRational+prop> Laws.associative G.convolve . asRational++Would be nice to have something like:++> Laws.identity G.convolve G.dirac++but we cannot represent @G.dirac@.++prop> isConstant . G.convolve G.constant . asRational++Using a @G.norm1@ we could exactly compute the amplitude+of the resulting constant function.+But that would require transcendent operations. -} convolve :: (Field.C a) => T a -> T a -> T a@@ -153,6 +196,9 @@ (recip $ recip (c2 f) + recip (c2 g)) -} +{- |+prop> withRational $ \x y -> G.convolve x y == G.convolveByTranslation x y+-} convolveByTranslation :: (Field.C a) => T a -> T a -> T a convolveByTranslation f0 g0 =@@ -167,11 +213,21 @@ (c0 f1 + c0 g1) zero (c2 f1 * c2 g1 / s) +{- |+prop> withRational $ \x y -> G.convolve x y == G.convolveByFourier x y+-} convolveByFourier :: (Field.C a) => T a -> T a -> T a convolveByFourier f g = reverse $ fourier $ multiply (fourier f) (fourier g) +{- |+prop> withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y)+prop> withRational $ \x -> nest 2 G.fourier x == G.reverse x+prop> G.fourier G.unit == (asRational G.unit)+prop> withRational $ \x a -> G.fourier (G.translate a x) == G.modulate a (G.fourier x)+prop> withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))+-} fourier :: (Field.C a) => T a -> T a fourier f =@@ -184,6 +240,9 @@ (Complex.scale rc $ Complex.quarterRight b) rc +{- |+prop> withRational $ \x -> G.fourier x == G.fourierByTranslation x+-} fourierByTranslation :: (Field.C a) => T a -> T a fourierByTranslation f =@@ -249,6 +308,9 @@ Cons 0 (i*b) 1 -} +{- |+prop> withRational $ \x a b -> G.translate a (G.translate b x) == G.translate (a+b) x+-} translate :: Ring.C a => a -> T a -> T a translate d f = let a = c0 f@@ -260,6 +322,10 @@ (Complex.fromReal (-2*c*d) + b) c +{- |+prop> withRational $ \x a b -> G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x+prop> withRational $ \x a -> G.translateComplex (Complex.fromReal a) x == G.translate a x+-} translateComplex :: Ring.C a => Complex.T a -> T a -> T a translateComplex d f = let a = c0 f@@ -271,6 +337,10 @@ (Complex.scale (-2*c) d + b) c +{- |+prop> withRational $ \x a b -> G.modulate a (G.modulate b x) == G.modulate (a+b) x+prop> withRational $ \x a b -> G.modulate b (G.translate a x) == G.turn (a*b) (G.translate a (G.modulate b x))+-} modulate :: Ring.C a => a -> T a -> T a modulate d f = Cons@@ -287,11 +357,18 @@ (c1 f) (c2 f) +{- |+prop> withRational $ \x -> nest 2 G.reverse x == x+-} reverse :: Additive.C a => T a -> T a reverse f = f{c1 = negate $ c1 f} +{- |+prop> withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x+prop> withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x+-} dilate :: Field.C a => a -> T a -> T a dilate k f = Cons@@ -300,6 +377,10 @@ (Complex.scale (recip k) $ c1 f) (c2 f / k^2) +{- |+prop> withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x+prop> withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x+-} shrink :: Ring.C a => a -> T a -> T a shrink k f = Cons@@ -315,10 +396,3 @@ (c0 f) (c1 f) (c2 f)---{- laws-fourier (convolve f g) = fourier f * fourier g--fourier (fourier f) = reverse f--}
gaussian/MathObj/Gaussian/Example.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Reciprocal of variance of a Gaussian bell curve. We describe the curve only in terms of its variance@@ -24,9 +24,7 @@ import qualified Algebra.Transcendental as Trans import qualified Algebra.Algebraic as Algebraic import qualified Algebra.Field as Field--- import qualified Algebra.Absolute as Absolute import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Number.Complex as Complex import qualified Number.Root as Root@@ -46,9 +44,6 @@ import Control.Applicative (liftA2, ) --- import System.Exit (ExitCode, )---- import Prelude (($)) import NumericPrelude.Numeric import NumericPrelude.Base import qualified Prelude as P
+ gaussian/MathObj/Gaussian/ExponentTuple.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE RebindableSyntax #-}+module MathObj.Gaussian.ExponentTuple where++import qualified Test.QuickCheck as QC++import Control.Applicative (liftA2, liftA3)++import Data.Function.HT (compose2)++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++{- $setup+>>> import MathObj.Gaussian.ExponentTuple (HoelderConjugates(HoelderConjugates))+>>> import MathObj.Gaussian.ExponentTuple (YoungConjugates(YoungConjugates))+>>> import NumericPrelude.Base as P+>>> import NumericPrelude.Numeric as NP+>>> import Prelude ()+-}+++{- |+For @(HoelderConjugates p q)@ it holds++prop> \(HoelderConjugates p q) -> p>=1 && q>=1 && 1/p + 1/q == 1+-}+data HoelderConjugates = HoelderConjugates Rational Rational+ deriving Show++instance QC.Arbitrary HoelderConjugates where+ arbitrary = genHoelderConjugates0++genHoelderConjugates0 :: QC.Gen HoelderConjugates+genHoelderConjugates0 =+ liftA2+ (\(QC.Positive p) (QC.Positive q) ->+ let s = p + q in HoelderConjugates (s % p) (s % q))+ QC.arbitrary QC.arbitrary++genHoelderConjugates1 :: QC.Gen HoelderConjugates+genHoelderConjugates1 =+ liftA2+ (\(QC.Positive p) (QC.Positive q) ->+ let s = 1%p + 1%q+ in HoelderConjugates (fromInteger p * s) (fromInteger q * s))+ QC.arbitrary QC.arbitrary+++{- |+For @(YoungConjugates p q r)@ it holds++prop> \(YoungConjugates p q r) -> p>=1 && q>=1 && r>=1 && 1/p + 1/q == 1/r + 1+-}+data YoungConjugates = YoungConjugates Rational Rational Rational+ deriving Show++instance QC.Arbitrary YoungConjugates where+ arbitrary = genYoungConjugates0++{-+Find positive natural numbers @a, b, c, d@ with++> a + b = c + d++and++> d >= a, d >= b, d >= c++then set++> p=d/a, q=d/b, r=d/c+++a+b<=c+b+c<=a+-> 2b <= 0+-}+genYoungConjugates0 :: QC.Gen YoungConjugates+genYoungConjugates0 =+ liftA3+ (\(QC.Positive a0) (QC.Positive b0) (QC.Positive c0) ->+ let guardSwap cond (x,y) =+ if cond x y then (x,y) else (y,x)+ {-+ If a+b<=c, then from b>0 it follows a<c and thus c+b>a.+ Swapping a and c is enough and we have not to consider more cases.+ -}+ (a1,c1) = guardSwap (\a c -> a+b0>c) (a0,c0)+ b1 = b0+ d1 = a1+b1-c1+ ((a2,b2),(c2,d2)) =+ guardSwap (compose2 (<=) snd)+ (guardSwap (<=) (a1,b1),+ guardSwap (<=) (c1,d1))+ in YoungConjugates (d2%a2) (d2%b2) (d2%c2))+ QC.arbitrary QC.arbitrary QC.arbitrary++{- |+This one is simpler, but may yield exponents smaller than 1.+-}+genYoungConjugates1 :: QC.Gen YoungConjugates+genYoungConjugates1 =+ liftA3+ (\(QC.Positive a0) (QC.Positive b0) (QC.Positive c0) ->+ let {-+ If a+b<=c, then from b>0 it follows a<c and thus c+b>a.+ Swapping a and c is enough and we have not to consider more cases.+ -}+ (a1,c1) = if a0+b0<=c0 then (c0,a0) else (a0,c0)+ b1 = b0+ d1 = a1+b1-c1+ in YoungConjugates (d1%a1) (d1%b1) (d1%c1))+ QC.arbitrary QC.arbitrary QC.arbitrary
gaussian/MathObj/Gaussian/Polynomial.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Complex Gaussian bell multiplied with a polynomial. @@ -55,9 +55,39 @@ import NumericPrelude.Numeric import NumericPrelude.Base hiding (reverse, )--- import Prelude () +{- $setup+>>> :set -XRebindableSyntax+>>>+>>> import qualified MathObj.Gaussian.Polynomial as G+>>> import qualified MathObj.Gaussian.Bell as Bell+>>> import qualified MathObj.Polynomial as Poly+>>> import qualified Algebra.Laws as Laws+>>> import qualified Number.Complex as Complex+>>> import Number.Complex ((+:))+>>> import NumericPrelude.Base as P+>>> import NumericPrelude.Numeric as NP+>>> import qualified Test.QuickCheck as QC+>>> import Data.Function.HT (Id, nest)+>>> import Data.Tuple.HT (mapSnd)+>>>+>>> asRational :: Id (G.T Rational)+>>> asRational = id+>>>+>>> withRational :: Id (G.T Rational -> a)+>>> withRational = id+>>>+>>> mulLinear2i :: Id (G.T Rational)+>>> mulLinear2i x =+>>> x{G.polynomial = Poly.fromCoeffs [0, 0+:2] * G.polynomial x}+>>>+>>> rotateQuarter :: Int -> Id (G.T Rational)+>>> rotateQuarter n =+>>> G.scaleComplex (negate Complex.imaginaryUnit ^ fromIntegral n)+-}++ data T a = Cons {bell :: Bell.T a, polynomial :: Poly.T (Complex.T a)} deriving (Show) @@ -149,33 +179,50 @@ unit :: (Ring.C a) => T a unit = eigenfunction0 +{- |+This one does not hold for larger degrees, although it would be nice:++prop> QC.forAll (QC.choose (0,3)) $ \n -> G.eigenfunctionDifferential n == asRational (G.eigenfunctionIterative n)++Unfortunately, both implementations compute different eigenbases.+-} eigenfunction :: (Field.C a) => Int -> T a eigenfunction = eigenfunctionDifferential +-- | prop> G.eigenfunction0 == asRational (G.eigenfunctionDifferential 0) eigenfunction0 :: (Ring.C a) => T a eigenfunction0 = Cons Bell.unit (Poly.fromCoeffs [one]) +-- | prop> G.eigenfunction1 == asRational (G.eigenfunctionDifferential 1) eigenfunction1 :: (Ring.C a) => T a eigenfunction1 = Cons Bell.unit (Poly.fromCoeffs [zero, one]) +-- | prop> G.eigenfunction2 == asRational (G.eigenfunctionDifferential 2) eigenfunction2 :: (Field.C a) => T a eigenfunction2 = Cons Bell.unit (Poly.fromCoeffs [-(1/4), zero, one]) +-- | prop> G.eigenfunction3 == asRational (G.eigenfunctionDifferential 3) eigenfunction3 :: (Field.C a) => T a eigenfunction3 = Cons Bell.unit (Poly.fromCoeffs [zero, -(3/4), zero, one]) +{- |+prop> QC.forAll (QC.choose (0,15)) $ \n -> let x = G.eigenfunctionDifferential n in G.fourier x == rotateQuarter n x+-} eigenfunctionDifferential :: (Field.C a) => Int -> T a eigenfunctionDifferential n = (\f -> f{bell = Bell.unit}) $ nest n (scale (-1/4) . differentiate) $ Cons (Bell.Cons one zero zero 2) one +{- |+prop> QC.forAll (QC.choose (0,15)) $ \n -> let x = G.eigenfunctionIterative n in G.fourier x == rotateQuarter n x+-} eigenfunctionIterative :: (Field.C a, Absolute.C a, ZeroTestable.C a, Eq a) => Int -> T a eigenfunctionIterative n =@@ -195,6 +242,11 @@ in y{polynomial = fmap (0.5*) (px + fmap (c*) py)}) +{- |+prop> withRational $ Laws.identity G.multiply G.constant+prop> withRational $ Laws.commutative G.multiply+prop> withRational $ Laws.associative G.multiply+-} multiply :: (Ring.C a) => T a -> T a -> T a multiply f g =@@ -202,6 +254,10 @@ (Bell.multiply (bell f) (bell g)) (polynomial f * polynomial g) +{- |+prop> withRational $ Laws.commutative G.convolve+prop> withRational $ Laws.associative G.convolve+-} convolve, {- convolveByDifferentiation, -} convolveByFourier :: (Field.C a) => T a -> T a -> T a convolve = convolveByFourier@@ -241,6 +297,13 @@ by decomposing the polynomial into four polynomials, one for each of the four eigenvalues 1, i, -1, -i. -}+{- |+prop> withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y)+prop> withRational $ \x -> nest 2 G.fourier x == G.reverse x+prop> withRational $ \x a -> G.fourier (G.translate a x) == G.modulate a (G.fourier x)+prop> withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))+prop> withRational $ \x -> G.fourier (G.differentiate x) == mulLinear2i (G.fourier x)+-} fourier :: (Field.C a) => T a -> T a fourier f =@@ -256,6 +319,8 @@ {- | Differentiate and divide by @sqrt pi@ in order to stay in a ring. This way, we do not need to fiddle with pi factors.++prop> withRational $ \x y -> G.convolve (G.differentiate x) y == G.convolve x (G.differentiate y) -} differentiate :: (Ring.C a) => T a -> T a differentiate f =@@ -265,8 +330,6 @@ * polynomial f} {--snd $ integrate $ differentiate (Cons Bell.unit (Poly.fromCoeffs [7,7,7,7]) :: T Double)- g = (bell f * poly f)' = bell f * ((poly f)' - (exppoly (bell f))' * poly f) poly g = (poly f)' - (exppoly (bell f))' * poly f@@ -278,6 +341,13 @@ However must start with the highest term of 'poly f', and thus we need to perform the division on reversed polynomials. -}+{- |+>>> snd $ G.integrate $ G.differentiate $ G.Cons Bell.unit (Poly.fromCoeffs [7,7,7,7 :: Complex.T Rational])+Cons {bell = Cons {amp = 1 % 1, c0 = 0 % 1 +: 0 % 1, c1 = 0 % 1 +: 0 % 1, c2 = 1 % 1}, polynomial = Polynomial.fromCoeffs [7 % 1 +: 0 % 1,7 % 1 +: 0 % 1,7 % 1 +: 0 % 1,7 % 1 +: 0 % 1]}++prop> withRational $ \x -> G.integrate (G.differentiate x) == (zero, x)+prop> withRational $ \x@(G.Cons b p) -> let (xoff,xint) = G.integrate x in G.differentiate xint == G.Cons b (p + Poly.const xoff)+-} integrate :: (Field.C a, ZeroTestable.C a) => T a -> (Complex.T a, T a)@@ -335,16 +405,27 @@ -} +{- |+prop> withRational $ \x a b -> G.translate a (G.translate b x) == G.translate (a+b) x+-} translate :: Ring.C a => a -> T a -> T a translate d = translateComplex (Complex.fromReal d) +{- |+prop> withRational $ \x a b -> G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x+prop> withRational $ \x a -> G.translateComplex (Complex.fromReal a) x == G.translate a x+-} translateComplex :: Ring.C a => Complex.T a -> T a -> T a translateComplex d f = Cons (Bell.translateComplex d $ bell f) (Poly.translate d $ polynomial f) +{- |+prop> withRational $ \x a b -> G.modulate a (G.modulate b x) == G.modulate (a+b) x+prop> withRational $ \x a b -> G.modulate b (G.translate a x) == G.turn (a*b) (G.translate a (G.modulate b x))+-} modulate :: Ring.C a => a -> T a -> T a modulate d f = Cons@@ -357,18 +438,29 @@ (Bell.turn d $ bell f) (polynomial f) +{- |+prop> withRational $ \x -> nest 2 G.reverse x == x+-} reverse :: Additive.C a => T a -> T a reverse f = Cons (Bell.reverse $ bell f) (Poly.reverse $ polynomial f) +{- |+prop> withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x+prop> withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x+-} dilate :: Field.C a => a -> T a -> T a dilate k f = Cons (Bell.dilate k $ bell f) (Poly.dilate (Complex.fromReal k) $ polynomial f) +{- |+prop> withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x+prop> withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x+-} shrink :: Ring.C a => a -> T a -> T a shrink k f = Cons@@ -394,6 +486,10 @@ since @amp@ must be real, but is complex here by construction. We really need at least signed amplitudes at this place, since we want to represent differences of Gaussians.++prop> withRational $ \x (QC.NonZero unit) d -> G.approximateByBells unit (G.translateComplex d x) == map (mapSnd (Bell.translateComplex d)) (G.approximateByBells unit x)+prop> withRational $ \x (QC.NonZero unit) (QC.NonZero d) -> G.approximateByBells unit (G.dilate d x) == map (mapSnd (Bell.dilate d)) (G.approximateByBells (unit/d) x)+prop> withRational $ \x (QC.NonZero unit) (QC.NonZero d) -> G.approximateByBells unit (G.shrink d x) == map (mapSnd (Bell.shrink d)) (G.approximateByBells (unit*d) x) -} approximateByBells :: Field.C a =>@@ -412,6 +508,9 @@ (\d -> Bell.translate d b) (laurentAbscissas (unit_/2) amps) +{- |+prop> \(QC.NonZero unit) d s p0 -> let p = Poly.fromCoeffs $ take 10 p0 in G.approximateByBellsAtOnce unit d s p == G.approximateByBellsByTranslation unit d (s::Rational) p+-} approximateByBellsAtOnce :: Field.C a => a -> Complex.T a -> a -> Poly.T (Complex.T a) -> LPoly.T (Complex.T a)@@ -477,4 +576,9 @@ {- laws differentiate (f*g) = (differentiate f) * g + f * (differentiate g)++inequalities:++Heisenberg's uncertainty relation+ needs integrals and thus needs product of exponential numbers and roots -}
gaussian/MathObj/Gaussian/Variance.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- We represent a Gaussian bell curve in terms of the reciprocal of its variance and its value at the origin.@@ -24,19 +24,33 @@ import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive -{--import Algebra.Transcendental (pi, )-import Algebra.Ring ((*), (^), )-import Algebra.Additive ((+))--} import Test.QuickCheck (Arbitrary, arbitrary, ) import Control.Monad (liftM2, ) --- import Prelude (($)) import NumericPrelude.Numeric import NumericPrelude.Base +{- $setup+>>> import qualified MathObj.Gaussian.Variance as G+>>> import MathObj.Gaussian.ExponentTuple (HoelderConjugates(HoelderConjugates))+>>> import MathObj.Gaussian.ExponentTuple (YoungConjugates(YoungConjugates))+>>> import qualified Algebra.Laws as Laws+>>> import qualified Number.Root as Root+>>> import NumericPrelude.Base as P+>>> import NumericPrelude.Numeric as NP+>>> import Prelude ()+>>> import qualified Test.QuickCheck as QC+>>> import Data.Function.HT (Id, nest)+>>>+>>> asRational :: Id (G.T Rational)+>>> asRational = id+>>>+>>> withRational :: Id (G.T Rational -> a)+>>> withRational = id+-}++ {- | Since @amp@ is the square of the actual amplitude it must be non-negative. -}@@ -75,14 +89,30 @@ integrateRoot f = Root.sqrt $ Root.fromNumber $ amp f / c f +{- |+Cauchy-Schwarz inequality:++prop> withRational $ \x y -> G.scalarProductRoot x y <= G.norm2Root x `Root.mul` G.norm2Root y++Hoelder inequality:++prop> withRational $ \x y -> G.scalarProductRoot x y <= G.norm1Root x `Root.mul` G.normInfRoot y+prop> withRational $ \x y (HoelderConjugates p q) -> G.scalarProductRoot x y <= G.normPRoot p x `Root.mul` G.normPRoot q y+-} scalarProductRoot :: (Field.C a) => T a -> T a -> Root.T a scalarProductRoot f g = integrateRoot (multiply f g) +{- |+prop> withRational $ \x -> G.norm1Root x == G.normPRoot 1 x+-} norm1Root :: (Field.C a) => T a -> Root.T a norm1Root = integrateRoot +{- |+prop> withRational $ \x -> G.norm2Root x == G.normPRoot 2 x+-} norm2Root :: (Field.C a) => T a -> Root.T a norm2Root f = Root.sqrt $@@ -94,6 +124,34 @@ normInfRoot f = Root.sqrt $ Root.fromNumber $ amp f +{-+I would have liked to test for a monotony of norms.+Unfortunately, it does not hold.++Means contain a division by the size of the domain.+Norms do not have this division.+Means are monotonic with respect to the degree.+Norms are not.+We cannot turn the norms into means since the size of the domain+(the complete real axis) is infinitely large.++prop> :{ withRational $ \x p0 q0 ->+ let p = 1 + abs p0+ q = 1 + abs q0+ in case compare p q of+ EQ -> G.normPRoot p x == G.normPRoot q x+ LT -> G.normPRoot p x <= G.normPRoot q x+ GT -> G.normPRoot p x >= G.normPRoot q x+:}++This should also fail,+but QuickCheck does not seem to try counterexamples.++prop> :{ withRational $ \x p0 ->+ let p = 1 + abs p0+ in G.normPRoot p x <= G.normInfRoot x+:}+-} normPRoot :: (Field.C a) => Rational -> T a -> Root.T a normPRoot p f = Root.sqrt (Root.fromNumber (amp f))@@ -124,6 +182,18 @@ variance f = recip $ c f * 2*pi +{- |+prop> withRational $ \x (QC.Positive a) -> G.varianceRational (G.dilate a x) == a^2 * G.varianceRational x+prop> withRational $ \x y -> G.varianceRational (G.convolve x y) == G.varianceRational x + G.varianceRational y+-}+varianceRational :: (Field.C a) => T a -> a+varianceRational f = recip $ c f++{- |+prop> Laws.identity G.multiply G.constant . asRational+prop> Laws.commutative G.multiply . asRational+prop> Laws.associative G.multiply . asRational+-} multiply :: (Ring.C a) => T a -> T a -> T a multiply f g =@@ -154,6 +224,15 @@ > integrate $ \s -> x s * y(t-s) Convergence only for @c f + c g > 0@.++prop> Laws.commutative G.convolve . asRational+prop> Laws.associative G.convolve . asRational++Young inequality:++prop> withRational $ \x y -> G.normInfRoot (G.convolve x y) <= G.norm1Root x `Root.mul` G.normInfRoot y+prop> withRational $ \x y (HoelderConjugates p q) -> G.normInfRoot (G.convolve x y) <= G.normPRoot p x `Root.mul` G.normPRoot q y+prop> withRational $ \x y (YoungConjugates p q r) -> G.normPRoot r (G.convolve x y) <= G.normPRoot p x `Root.mul` G.normPRoot q y -} convolve :: (Field.C a) => T a -> T a -> T a@@ -168,6 +247,11 @@ > integrate $ \t -> x t * cis (-2*pi*t*f) Convergence only for @c f > 0@.++prop> withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y)+prop> withRational $ \x -> nest 4 G.fourier x == x+prop> withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))+prop> withRational $ \x y -> G.scalarProductRoot x y == G.scalarProductRoot (G.fourier x) (G.fourier y) -} fourier :: (Field.C a) => T a -> T a@@ -177,10 +261,18 @@ fourier (t -> exp(-(a*t)^2)) -} +{- |+prop> withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x+prop> withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x+-} dilate :: (Field.C a) => a -> T a -> T a dilate k f = Cons (amp f) $ c f / k^2 +{- |+prop> withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x+prop> withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x+-} shrink :: (Ring.C a) => a -> T a -> T a shrink k f = Cons (amp f) $ c f * k^2@@ -191,16 +283,3 @@ amplify :: (Ring.C a) => a -> T a -> T a amplify k f = Cons (k^2 * amp f) $ c f---{- laws-fourier (convolve f g) = multiply (fourier f) (fourier g)--dilate k (dilate m f) = dilate (k*m) f--dilate k (shrink k f) = f--variance (dilate k f) = k^2 * variance f--variance (convolve f g) = variance f + variance g--}
numeric-prelude.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: numeric-prelude-Version: 0.4.3.2+Version: 0.4.3.3 License: BSD-3-Clause License-File: LICENSE Author: Dylan Thurston <dpt@math.harvard.edu>, Henning Thielemann <numericprelude@henning-thielemann.de>, Mikael Johansson@@ -9,7 +9,7 @@ Category: Math Stability: Experimental Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3-Tested-With: GHC==8.4.1+Tested-With: GHC==8.4.4, GHC==8.6.5, GHC==9.0.1 Build-Type: Simple Synopsis: An experimental alternative hierarchy of numeric type classes Description:@@ -30,22 +30,22 @@ default: False Source-Repository this- Tag: 0.4.3.2+ Tag: 0.4.3.3 Type: darcs- Location: http://hub.darcs.net/thielema/numeric-prelude/+ Location: https://hub.darcs.net/thielema/numeric-prelude/ Source-Repository head Type: darcs- Location: http://hub.darcs.net/thielema/numeric-prelude/+ Location: https://hub.darcs.net/thielema/numeric-prelude/ Library Build-Depends: parsec >=1 && <4,- QuickCheck >=1 && <3,+ QuickCheck >=2.10 && <3, storable-record >=0.0.1 && <0.1, non-negative >=0.0.5 && <0.2, semigroups >=0.1 && <1.0,- utility-ht >=0.0.6 && <0.1,+ utility-ht >=0.0.13 && <0.1, deepseq >=1.1 && <1.5 Build-Depends:@@ -54,10 +54,6 @@ random >=1.0 && <1.3, base >=4.5 && <5 - If impl(ghc>=7.0)- CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Default-Extensions: CPP- Default-Language: Haskell98 GHC-Options: -Wall Hs-source-dirs: src@@ -176,47 +172,50 @@ Else Buildable: False - If impl(ghc>=7.0)- CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Default-Extensions: CPP- Test-Suite numeric-prelude-test Type: exitcode-stdio-1.0- Hs-Source-Dirs: test, gaussian GHC-Options: -Wall Default-Language: Haskell98+ Hs-Source-Dirs: test Other-modules: Test.NumericPrelude.Utility Test.Number.GaloisField2p32m5 Test.Number.ComplexSquareRoot Test.Algebra.IntegralDomain+ Test.Algebra.PrincipalIdealDomain Test.Algebra.RealRing Test.Algebra.Additive Test.MathObj.RefinementMask2 Test.MathObj.PartialFraction Test.MathObj.Matrix Test.MathObj.Polynomial+ Test.MathObj.Polynomial.Core Test.MathObj.PowerSeries+ Test.MathObj.PowerSeries.Core+ Test.MathObj.PowerSeries.Example+ Test.MathObj.Gaussian.ExponentTuple Test.MathObj.Gaussian.Variance Test.MathObj.Gaussian.Bell Test.MathObj.Gaussian.Polynomial+ Hs-Source-Dirs: playground+ Other-modules: Number.ComplexSquareRoot+ Hs-Source-Dirs: gaussian+ Other-Modules:+ MathObj.Gaussian.Bell+ MathObj.Gaussian.Polynomial+ MathObj.Gaussian.Variance+ MathObj.Gaussian.ExponentTuple Main-Is: Test/Run.hs - If flag(buildExamples)- Build-Depends:- HUnit >=1 && <2,- numeric-prelude,- QuickCheck,- utility-ht,- random,- base- Else- Buildable: False-- If impl(ghc>=7.0)- CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Default-Extensions: CPP+ Build-Depends:+ doctest-exitcode-stdio >=0.0 && <0.1,+ doctest-lib >=0.1 && <0.1.1,+ numeric-prelude,+ QuickCheck,+ utility-ht,+ random,+ base Executable numeric-prelude-gaussian Hs-Source-Dirs: gaussian@@ -238,7 +237,3 @@ base Else Buildable: False-- If impl(ghc>=7.0)- CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Default-Extensions: CPP
+ playground/Number/ComplexSquareRoot.hs view
@@ -0,0 +1,137 @@+module Number.ComplexSquareRoot where++import qualified Algebra.RealField as RealField+import qualified Algebra.RealRing as RealRing+import qualified Algebra.Ring as Ring+import qualified Algebra.Additive as Additive+import qualified Algebra.ZeroTestable as ZeroTestable++import qualified Number.Complex as Complex++import Test.QuickCheck (Arbitrary, arbitrary, )++import Control.Monad (liftM2, )++import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (recip, )+import NumericPrelude.Base+import Prelude ()+++{- $setup+>>> import qualified Number.ComplexSquareRoot as SR+>>> import qualified Number.Complex as Complex+>>> import qualified Algebra.Laws as Laws+>>> import Test.QuickCheck ((==>))+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> sr :: SR.T Rational -> SR.T Rational+>>> sr = id+-}++{- |+Represent the square root of a complex number+without actually having to compute a square root.+If the Bool is False,+then the square root is represented with positive real part+or zero real part and positive imaginary part.+If the Bool is True the square root is negated.++prop> Laws.identity SR.mul SR.one . sr+prop> Laws.commutative SR.mul . sr+prop> Laws.associative SR.mul . sr+prop> Laws.homomorphism SR.fromNumber (\x y -> x * (y :: Complex.T Rational)) SR.mul+prop> Laws.rightIdentity SR.div SR.one . sr+prop> \x -> not (isZero x) ==> SR.recip (SR.recip x) == sr x+prop> \x -> not (isZero x) ==> Laws.inverse SR.mul SR.recip SR.one (sr x)+-}+data T a = Cons Bool (Complex.T a)+ deriving (Show)++{- |+You must use @fmap@ only for number type conversion.+-}+instance Functor T where+ fmap f (Cons n x) = Cons n (fmap f x)++instance (ZeroTestable.C a) => ZeroTestable.C (T a) where+ isZero (Cons _b s) = isZero s++instance (ZeroTestable.C a, Eq a) => Eq (T a) where+ (Cons xb xs) == (Cons yb ys) =+ isZero xs && isZero ys ||+ xb==yb && xs==ys++instance (Arbitrary a) => Arbitrary (T a) where+ arbitrary = liftM2 Cons arbitrary arbitrary+++fromNumber :: (RealRing.C a) => Complex.T a -> T a+fromNumber x =+ Cons+ (case compare zero (Complex.real x) of+ LT -> False+ GT -> True+ EQ -> Complex.imag x < zero)+ (x^2)++-- htam:Wavelet.DyadicResultant.parityFlip+toNumber :: (RealRing.C a, Complex.Power a) => T a -> Complex.T a+toNumber (Cons n x) =+ case sqrt x of y -> if n then NP.negate y else y+++one :: (Ring.C a) => T a+one = Cons False NP.one++inUpperHalfplane :: (Additive.C a, Ord a) => Complex.T a -> Bool+inUpperHalfplane x =+ case compare (Complex.imag x) zero of+ GT -> True+ LT -> False+ EQ -> Complex.real x < zero++mul, mulAlt, mulAlt2 :: (RealRing.C a) => T a -> T a -> T a+mul (Cons xb xs) (Cons yb ys) =+ let zs = xs*ys+ in Cons+ ((xb /= yb) /=+ case (inUpperHalfplane xs,+ inUpperHalfplane ys,+ inUpperHalfplane zs) of+ (True,True,False) -> True+ (False,False,True) -> True+ _ -> False)+ zs++mulAlt (Cons xb xs) (Cons yb ys) =+ let zs = xs*ys+ in Cons+ ((xb /= yb) /=+ let xi = Complex.imag xs+ yi = Complex.imag ys+ zi = Complex.imag zs+ in (xi>=zero) /= (yi>=zero) &&+ (xi>=zero) /= (zi>=zero))+ zs++mulAlt2 (Cons xb xs) (Cons yb ys) =+ let zs = xs*ys+ in Cons+ ((xb /= yb) /=+ let xi = Complex.imag xs+ yi = Complex.imag ys+ zi = Complex.imag zs+ in xi*yi<zero && xi*zi<zero)+ zs++div :: (RealField.C a) => T a -> T a -> T a+div x y = mul x (recip y)++recip :: (RealField.C a) => T a -> T a+recip (Cons b s) =+ Cons+ (b /= (Complex.imag s == zero && Complex.real s < zero))+ (NP.recip s)
src/Algebra/Absolute.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Absolute ( C(abs, signum), absOrd, signumOrd,@@ -7,7 +7,7 @@ import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive -import Algebra.Ring (one, ) -- fromInteger+import Algebra.Ring (one, ) import Algebra.Additive (zero, negate,) import Data.Int (Int, Int8, Int16, Int32, Int64, )
src/Algebra/Additive.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Additive ( -- * Class C,@@ -39,6 +39,12 @@ import NumericPrelude.Base +{- $setup+>>> import qualified Algebra.Additive as A+>>> import qualified Test.QuickCheck as QC+-}++ infixl 6 +, - {- |@@ -98,6 +104,8 @@ This avoids including a zero which is useful for types where no universal zero is available. ToDo: Should have NonEmpty type.++prop> \(QC.NonEmpty ns) -> A.sum ns == (A.sum1 ns :: Integer) -} sum1 :: (C a) => [a] -> a sum1 = foldl1 (+)@@ -109,19 +117,23 @@ Does this have a measurably effect on speed? Requires associativity.++prop> \ns -> A.sum ns == (A.sumNestedAssociative ns :: Integer) -} sumNestedAssociative :: (C a) => [a] -> a sumNestedAssociative [] = zero sumNestedAssociative [x] = x sumNestedAssociative xs = sumNestedAssociative (sum2 xs) -{-+{- | Make sure that the last entries in the list are equally often part of an addition. Maybe this can reduce rounding errors. The list that sum2 computes is a breadth-first-flattened binary tree. Requires associativity and commutativity.++prop> \ns -> A.sum ns == (A.sumNestedCommutative ns :: Integer) -} sumNestedCommutative :: (C a) => [a] -> a sumNestedCommutative [] = zero
src/Algebra/Algebraic.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Algebraic where import qualified Algebra.Field as Field--- import qualified Algebra.Units as Units import qualified Algebra.Laws as Laws import qualified Algebra.ToRational as ToRational import qualified Algebra.ToInteger as ToInteger
src/Algebra/Differential.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Differential where import qualified Algebra.Ring as Ring --- import NumericPrelude.Numeric--- import qualified Prelude {- | 'differentiate' is a general differentation operation
src/Algebra/DivisibleSpace.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.DivisibleSpace where
src/Algebra/Field.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Field ( {- * Class -} C,
src/Algebra/FloatingPoint.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.FloatingPoint where import qualified Algebra.RealRing as RealRing
src/Algebra/IntegralDomain.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.IntegralDomain ( {- * Class -} C,@@ -32,7 +32,6 @@ ) where import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable import Algebra.Ring ((*), fromInteger, )@@ -52,7 +51,15 @@ import qualified Prelude as P +{- $setup+>>> import Algebra.IntegralDomain (roundDown, roundUp, divUp)+>>> import qualified Test.QuickCheck as QC+>>> import NumericPrelude.Base as P+>>> import NumericPrelude.Numeric as NP+>>> import Prelude ()+-} + infixl 7 `div`, `mod` @@ -97,6 +104,9 @@ class (Ring.C a) => C a where {-# MINIMAL divMod | (div, mod) #-} div, mod :: a -> a -> a+ {- |+ prop> \n (QC.NonZero m) -> let (q,r) = divMod n m in n == (q*m+r :: Integer)+ -} divMod :: a -> a -> (a,a) {-# INLINE div #-}@@ -184,6 +194,8 @@ that is at most @n@. The parameter order is consistent with @div@ and friends, but maybe not useful for partial application.++prop> \n (QC.NonZero m) -> div n m * m == (roundDown n m :: Integer) -} roundDown :: C a => a -> a -> a roundDown n m = n - mod n m@@ -192,6 +204,10 @@ @roundUp n m@ rounds @n@ up to the next multiple of @m@. That is, @roundUp n m@ is the greatest multiple of @m@ that is at most @n@.++prop> \n (QC.NonZero m) -> divUp n m * m == (roundUp n m :: Integer)+prop> \n (QC.Positive m) -> let x = roundDown n m in n-m < x && x <= (n :: Integer)+prop> \n (QC.NonZero m) -> - roundDown n m == (roundUp (-n) m :: Integer) -} roundUp :: C a => a -> a -> a roundUp n m = n + mod (-n) m
src/Algebra/Lattice.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Lattice ( C(up, dn) , max, min, abs
src/Algebra/Module.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |
src/Algebra/ModuleBasis.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -15,14 +15,12 @@ import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.Module as Module--- import qualified Algebra.Additive as Additive import Algebra.Ring (one, fromInteger) import Algebra.Additive ((+), zero) import Data.List (map, length, (++)) import Prelude(Eq, (==), Bool, Int, Integer, Float, Double, asTypeOf, )--- import qualified Prelude as P {- | It must hold:
src/Algebra/NonNegative.hs view
@@ -25,11 +25,9 @@ ) where import qualified Algebra.Additive as Additive--- import qualified Algebra.RealRing as RealRing import qualified Algebra.Monoid as Monoid --- import Algebra.Absolute (abs, ) import Algebra.Additive ((-), ) import Prelude hiding (sum, (-), abs, )
src/Algebra/NormedSpace/Euclidean.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}
src/Algebra/NormedSpace/Maximum.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}
src/Algebra/NormedSpace/Sum.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}
src/Algebra/OccasionallyScalar.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}
src/Algebra/PrincipalIdealDomain.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.PrincipalIdealDomain ( {- * Class -} C,@@ -39,8 +39,6 @@ import qualified Algebra.Units as Units import qualified Algebra.IntegralDomain as Integral--- import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable import qualified Algebra.Laws as Laws@@ -63,7 +61,19 @@ import Test.QuickCheck ((==>), Property) +{- $setup+>>> import qualified Algebra.PrincipalIdealDomain as PID+>>> import Test.NumericPrelude.Utility ((/\))+>>> import qualified Test.QuickCheck as QC+>>>+>>> genResidueClass :: QC.Gen (Integer,Integer)+>>> genResidueClass = do+>>> m <- fmap QC.getNonZero $ QC.arbitrary+>>> a <- QC.choose (min 0 $ 1+m, max 0 $ m-1)+>>> return (m,a)+-} + {- | A principal ideal domain is a ring in which every ideal (the set of multiples of some generating set of elements)@@ -235,9 +245,9 @@ {- | Not efficient because it requires duplicate computations of GCDs.-However GCDs of neighbouring list elements were not computed before.+However GCDs of adjacent list elements were not computed before. It is also quite arbitrary,-because only neighbouring elements are used for balancing.+because only adjacent elements are used for balancing. There are certainly more sophisticated solutions. -} diophantineMultiMin :: C a => a -> [a] -> Maybe [a]@@ -279,10 +289,21 @@ -} {- |-For @Just (b,n) = chineseRemainder [(a0,m0), (a1,m1), ..., (an,mn)]@-and all @x@ with @x = b mod n@ the congruences-@x=a0 mod m0, x=a1 mod m1, ..., x=an mod mn@+For @Just (n,b) = chineseRemainderMulti [(m0,a0), (m1,a1), ..., (mk,ak)]@+and all @x@ with @x = b mod n@, the congruences+@x=a0 mod m0, x=a1 mod m1, ..., x=ak mod mk@ are fulfilled.+Also, @n@ is the least common multiplier of all @mi@.++>>> PID.chineseRemainderMulti [(100,21), (10000,2021::Integer)]+Just (10000,2021)+>>> PID.chineseRemainderMulti [(97,90),(99,10),(100,0::Integer)]+Just (960300,100000)+>>> PID.chineseRemainderMulti [(95,30),(97,27),(98,8),(99,1::Integer)]+Just (89403930,1000000)++prop> QC.listOf genResidueClass /\ \xs -> case PID.chineseRemainderMulti xs of Nothing -> True; Just (n,b) -> abs n == abs (foldl lcm 1 (map fst xs)) && map snd xs == map (mod b . fst) xs+prop> \(QC.NonEmpty ms) b -> let xs = map (\(QC.NonZero m) -> (m, mod b m)) ms in case PID.chineseRemainderMulti xs of Nothing -> False; Just (n,c) -> abs n == abs (foldl lcm 1 (map QC.getNonZero ms)) && mod b n == (c::Integer) -} chineseRemainderMulti :: C a => [(a,a)] -> Maybe (a,a) chineseRemainderMulti congs =
src/Algebra/RealField.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealField ( C, ) where@@ -10,8 +10,6 @@ import qualified Number.Ratio as Ratio --- import NumericPrelude.Base--- import qualified Prelude as P import Prelude (Float, Double, ) {- |
src/Algebra/RealIntegral.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Generally before using 'quot' and 'rem', think twice. In most cases 'divMod' and friends are the right choice,@@ -19,8 +19,6 @@ import qualified Algebra.ZeroTestable as ZeroTestable import qualified Algebra.IntegralDomain as Integral import qualified Algebra.Absolute as Absolute--- import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import Algebra.Absolute (signum, ) import Algebra.IntegralDomain (divMod, )
src/Algebra/RealRing.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealRing where import qualified Algebra.RealRing98 as RealRing98@@ -35,6 +35,20 @@ import NumericPrelude.Base +{- $setup+>>> import qualified Algebra.RealRing as RealRing+>>> import Data.Tuple.HT (mapFst)+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> infix 4 =~=+>>>+>>> (=~=) :: (Eq b) => (a -> b) -> (a -> b) -> a -> Bool+>>> (f =~= g) x = f x == g x+-}++ {- | Minimal complete definition: 'splitFraction' or 'floor'@@ -116,8 +130,23 @@ class (Absolute.C a, Ord a) => C a where {-# MINIMAL splitFraction | floor #-}+ {- |+ prop> \x -> (x::Rational) == (uncurry (+) $ mapFst fromInteger $ splitFraction x)+ prop> \x -> uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x+ prop> \x -> uncurry (==) $ mapFst (((x::Rational)-) . fromInteger) $ splitFraction x+ prop> \x -> splitFraction x == (floor (x::Double) :: Integer, fraction x)+ prop> \x -> splitFraction x == (floor (x::Rational) :: Integer, fraction x)+ -} splitFraction :: (Ring.C b) => a -> (b,a)- fraction :: a -> a+ {- |+ prop> \x -> let y = fraction (x::Double) in 0<=y && y<1+ prop> \x -> let y = fraction (x::Rational) in 0<=y && y<1+ -}+ fraction :: a -> a+ {- |+ prop> \x -> ceiling (-x) == negate (floor (x::Double) :: Integer)+ prop> \x -> ceiling (-x) == negate (floor (x::Rational) :: Integer)+ -} ceiling, floor :: (Ring.C b) => a -> b truncate :: (Ring.C b) => a -> b round :: (ToInteger.C b) => a -> b@@ -157,6 +186,7 @@ but is simply a kind of rounding that is the fastest on IEEE floating point architectures. -}+{-# NOINLINE [2] roundSimple #-} roundSimple :: (C a, Ring.C b) => a -> b roundSimple x = let (n,r) = splitFraction x@@ -530,6 +560,9 @@ If operations like multiplication with two and comparison need time proportional to the number of binary digits, then the overall rounding requires quadratic time.++prop> RealRing.genericFloor =~= (NP.floor :: Double -> Integer)+prop> RealRing.genericFloor =~= (NP.floor :: Rational -> Integer) -} genericFloor :: (Ord a, Ring.C a, Ring.C b) => a -> b genericFloor a =@@ -537,30 +570,50 @@ then genericPosFloor a else negate $ genericPosCeiling $ negate a +{- |+prop> RealRing.genericCeiling =~= (NP.ceiling :: Double -> Integer)+prop> RealRing.genericCeiling =~= (NP.ceiling :: Rational -> Integer)+-} genericCeiling :: (Ord a, Ring.C a, Ring.C b) => a -> b genericCeiling a = if a>=zero then genericPosCeiling a else negate $ genericPosFloor $ negate a +{- |+prop> RealRing.genericTruncate =~= (NP.truncate :: Double -> Integer)+prop> RealRing.genericTruncate =~= (NP.truncate :: Rational -> Integer)+-} genericTruncate :: (Ord a, Ring.C a, Ring.C b) => a -> b genericTruncate a = if a>=zero then genericPosFloor a else negate $ genericPosFloor $ negate a +{- |+prop> RealRing.genericRound =~= (NP.round :: Double -> Integer)+prop> RealRing.genericRound =~= (NP.round :: Rational -> Integer)+-} genericRound :: (Ord a, Ring.C a, Ring.C b) => a -> b genericRound a = if a>=zero then genericPosRound a else negate $ genericPosRound $ negate a +{- |+prop> RealRing.genericFraction =~= (NP.fraction :: Double -> Double)+prop> RealRing.genericFraction =~= (NP.fraction :: Rational -> Rational)+-} genericFraction :: (Ord a, Ring.C a) => a -> a genericFraction a = if a>=zero then genericPosFraction a else fixFraction $ negate $ genericPosFraction $ negate a +{- |+prop> RealRing.genericSplitFraction =~= (NP.splitFraction :: Double -> (Integer,Double))+prop> RealRing.genericSplitFraction =~= (NP.splitFraction :: Rational -> (Integer,Rational))+-} genericSplitFraction :: (Ord a, Ring.C a, Ring.C b) => a -> (b,a) genericSplitFraction a = if a>=zero
src/Algebra/RealTranscendental.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealTranscendental where import qualified Algebra.Transcendental as Trans
src/Algebra/RightModule.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.RightModule where@@ -6,8 +6,6 @@ import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive --- import NumericPrelude.Numeric--- import qualified Prelude -- Is this right?
src/Algebra/Ring.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Ring ( {- * Class -} C,@@ -41,7 +41,6 @@ import qualified Data.Complex as Complex98 import qualified Data.Ratio as Ratio98 import qualified Prelude as P--- import Test.QuickCheck infixl 7 *
src/Algebra/ToInteger.hs view
@@ -49,6 +49,7 @@ toInteger :: a -> Integer +{-# NOINLINE [2] fromIntegral #-} fromIntegral :: (C a, Ring.C b) => a -> b fromIntegral = fromInteger . toInteger
src/Algebra/ToRational.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.ToRational where import qualified Algebra.ZeroTestable as ZeroTestable@@ -68,6 +68,7 @@ such as converting 'Float' to 'Double'. This achieved by optimizer rules. -}+{-# NOINLINE [2] realToField #-} realToField :: (C a, Field.C b) => a -> b realToField = Field.fromRational' . toRational
src/Algebra/Transcendental.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Transcendental where import qualified Algebra.Algebraic as Algebraic--- import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.Laws as Laws
src/Algebra/Units.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Units ( {- * Class -} C,@@ -22,7 +22,6 @@ import qualified Algebra.IntegralDomain as Integral import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable import qualified Algebra.Laws as Laws
src/Algebra/Vector.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2004-2005 @@ -18,7 +18,6 @@ import Algebra.Additive ((+)) import Data.List (zipWith, foldl)--- import Data.Functor (Functor, fmap) import Prelude((.), (==), Bool, Functor, fmap) import qualified Prelude as P
src/Algebra/VectorSpace.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.VectorSpace where@@ -10,7 +10,6 @@ import qualified Data.Complex as Complex98 --- import NumericPrelude.Numeric import qualified Prelude as P
src/Algebra/ZeroTestable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.ZeroTestable where import qualified Algebra.Additive as Additive@@ -6,7 +6,6 @@ import Data.Int (Int, Int8, Int16, Int32, Int64, ) import Data.Word (Word, Word8, Word16, Word32, Word64, ) --- import qualified Prelude as P import Prelude (Integer, Float, Double, ) import NumericPrelude.Base
src/MathObj/Algebra.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Mikael Johansson 2006 Maintainer : mik@math.uni-jena.de
src/MathObj/DiscreteMap.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -41,7 +41,6 @@ import qualified Data.Map as Map import Data.Map (Map) --- import qualified Prelude as P import NumericPrelude.Base -- FIXME: Should this be implemented by isZero?
src/MathObj/LaurentPolynomial.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -26,7 +26,6 @@ import qualified Number.Complex as Complex --- import qualified NumericPrelude.Base as P import qualified NumericPrelude.Numeric as NP import NumericPrelude.Base hiding (const, reverse, )
src/MathObj/Matrix.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -68,6 +68,41 @@ import NumericPrelude.Base hiding (zipWith, ) +{- $setup+>>> import qualified MathObj.Matrix as Matrix+>>> import qualified Algebra.Ring as Ring+>>> import qualified Algebra.Laws as Laws+>>> import Test.NumericPrelude.Utility ((/\))+>>> import qualified Test.QuickCheck as QC+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+>>>+>>> import Control.Monad (replicateM, join)+>>> import Control.Applicative (liftA2)+>>> import Data.Function.HT (nest)+>>>+>>> genDimension :: QC.Gen Int+>>> genDimension = QC.choose (0,20)+>>>+>>> genMatrixFor :: (QC.Arbitrary a) => Int -> Int -> QC.Gen (Matrix.T a)+>>> genMatrixFor m n =+>>> fmap (Matrix.fromList m n) $ replicateM (m*n) QC.arbitrary+>>>+>>> genMatrix :: (QC.Arbitrary a) => QC.Gen (Matrix.T a)+>>> genMatrix = join $ liftA2 genMatrixFor genDimension genDimension+>>>+>>> genIntMatrix :: QC.Gen (Matrix.T Integer)+>>> genIntMatrix = genMatrix+>>>+>>> genFactorMatrix :: (QC.Arbitrary a) => Matrix.T a -> QC.Gen (Matrix.T a)+>>> genFactorMatrix a = genMatrixFor (Matrix.numColumns a) =<< genDimension+>>>+>>> genSameMatrix :: (QC.Arbitrary a) => Matrix.T a -> QC.Gen (Matrix.T a)+>>> genSameMatrix = uncurry genMatrixFor . Matrix.dimension+-}++ {- | A matrix is a twodimensional array, indexed by integers. -}@@ -79,6 +114,10 @@ {- | Transposition of matrices is just transposition in the sense of Data.List.++prop> genIntMatrix /\ \a -> Matrix.rows a == Matrix.columns (Matrix.transpose a)+prop> genIntMatrix /\ \a -> Matrix.columns a == Matrix.rows (Matrix.transpose a)+prop> genIntMatrix /\ \a -> genSameMatrix a /\ \b -> Laws.homomorphism Matrix.transpose (+) (+) a b -} transpose :: T a -> T a transpose (Cons m) =@@ -98,6 +137,9 @@ index :: T a -> Dimension -> Dimension -> a index (Cons m) i j = m ! (i,j) +{- |+prop> genIntMatrix /\ \a -> a == uncurry Matrix.fromRows (Matrix.dimension a) (Matrix.rows a)+-} fromRows :: Dimension -> Dimension -> [[a]] -> T a fromRows m n = Cons .@@ -106,6 +148,9 @@ List.zipWith (\r -> map (\(c,x) -> ((r,c),x))) allIndices . map (zip allIndices) +{- |+prop> genIntMatrix /\ \a -> a == uncurry Matrix.fromColumns (Matrix.dimension a) (Matrix.columns a)+-} fromColumns :: Dimension -> Dimension -> [[a]] -> T a fromColumns m n = Cons .@@ -146,6 +191,10 @@ -- These implementations may benefit from a better exception than -- just assertions to validate dimensionalities+{- |+prop> genIntMatrix /\ \a -> genSameMatrix a /\ \b -> Laws.commutative (+) a b+prop> genIntMatrix /\ \a -> genSameMatrix a /\ \b -> genSameMatrix b /\ \c -> Laws.associative (+) a b c+-} instance (Additive.C a) => Additive.C (T a) where (+) = zipWith (+) (-) = zipWith (-)@@ -159,6 +208,9 @@ in assert (d == dimension nM) $ uncurry fromList d (List.zipWith op em en) +{- |+prop> genIntMatrix /\ \a -> Laws.identity (+) (uncurry Matrix.zero $ Matrix.dimension a) a+-} zero :: (Additive.C a) => Dimension -> Dimension -> T a zero m n = fromList m n $@@ -172,6 +224,9 @@ (indexBounds n n) (map (\i -> ((i,i), Ring.one)) (indexRange n)) +{- |+prop> genDimension /\ \n -> Matrix.one n == Matrix.diagonal (replicate n Ring.one :: [Integer])+-} diagonal :: (Additive.C a) => [a] -> T a diagonal xs = let n = List.length xs@@ -183,6 +238,15 @@ scale :: (Ring.C a) => a -> T a -> T a scale s = Vector.functorScale s +{- |+prop> genIntMatrix /\ \a -> Laws.leftIdentity (*) (Matrix.one (Matrix.numRows a)) a+prop> genIntMatrix /\ \a -> Laws.rightIdentity (*) (Matrix.one (Matrix.numColumns a)) a+prop> genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> Laws.homomorphism Matrix.transpose (*) (flip (*)) a b+prop> genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> genFactorMatrix b /\ \c -> Laws.associative (*) a b c+prop> genIntMatrix /\ \b -> genSameMatrix b /\ \c -> genFactorMatrix b /\ \a -> Laws.leftDistributive (*) (+) a b c+prop> genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> genSameMatrix b /\ \c -> Laws.rightDistributive (*) (+) a b c+prop> QC.choose (0,10) /\ \k -> genDimension /\ \n -> genMatrixFor n n /\ \a -> a^k == nest (fromInteger k) ((a::Matrix.T Integer)*) (Matrix.one n)+-} instance (Ring.C a) => Ring.C (T a) where mM * nM = assert (numColumns mM == numRows nM) $
src/MathObj/Monoid.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.Monoid where import qualified Algebra.PrincipalIdealDomain as PID
src/MathObj/PartialFraction.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2007 Maintainer : numericprelude@henning-thielemann.de@@ -29,21 +29,89 @@ import Algebra.Additive((+), zero, negate) import Algebra.ZeroTestable (isZero) +import qualified Data.List.Reverse.StrictSpine as Rev+import qualified Data.List.Match as Match import qualified Data.List as List--import Data.Map(Map) import qualified Data.Map as Map-import Data.Maybe(fromMaybe, )-import qualified Data.List.Match as Match-import Data.List.HT (dropWhileRev, )-import Data.List (group, sortBy, mapAccumR, )+import Data.Map (Map)+import Data.List (group, sortBy, mapAccumR)+import Data.Maybe (fromMaybe) import NumericPrelude.Base hiding (zipWith) import NumericPrelude.Numeric(Int, fromInteger) +{- $setup+>>> import qualified MathObj.PartialFraction as PartialFraction+>>> import qualified MathObj.Polynomial.Core as PolyCore+>>> import qualified MathObj.Polynomial as Poly+>>> import qualified Algebra.PrincipalIdealDomain as PID+>>> import qualified Algebra.Indexable as Indexable+>>> import qualified Algebra.Laws as Laws+>>> import qualified Number.Ratio as Ratio+>>> import Test.NumericPrelude.Utility ((/\))+>>> import qualified Test.QuickCheck as QC+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+>>>+>>> import Control.Applicative (liftA2)+>>>+>>> {- |+>>> Generator of irreducible elements for tests.+>>> Choosing from a list of examples is a simple yet effective design.+>>> If we would construct irreducible elements by a clever algorithm+>>> we might obtain multiple primes only rarely.+>>> -} --+>>> genSmallPrime :: QC.Gen Integer+>>> genSmallPrime =+>>> let primes = [2,3,5,7,11,13]+>>> in QC.elements (primes ++ map negate primes)+>>>+>>> genPartialFractionInt :: QC.Gen (PartialFraction.T Integer)+>>> genPartialFractionInt =+>>> liftA2 PartialFraction.fromFactoredFraction+>>> (QC.listOf genSmallPrime) QC.arbitrary+>>>+>>>+>>> genIrreduciblePolynomial :: QC.Gen (Poly.T Rational)+>>> genIrreduciblePolynomial = do+>>> QC.NonZero unit <- QC.arbitrary+>>> fmap (Poly.fromCoeffs . map (unit*)) $+>>> QC.elements [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]]+>>>+>>> genPartialFractionPoly :: QC.Gen (PartialFraction.T (Poly.T Rational))+>>> genPartialFractionPoly =+>>> liftA2 PartialFraction.fromFactoredFraction+>>> (fmap (take 3) $ QC.listOf genIrreduciblePolynomial)+>>> (fmap (Poly.fromCoeffs . PolyCore.normalize . take 5) QC.arbitrary)+>>>+>>>+>>> fractionConv :: (PID.C a, Indexable.C a) => [a] -> a -> Bool+>>> fractionConv xs y =+>>> PartialFraction.toFraction (PartialFraction.fromFactoredFraction xs y) ==+>>> y % product xs+>>>+>>> fractionConvAlt :: (PID.C a, Indexable.C a) => [a] -> a -> Bool+>>> fractionConvAlt xs y =+>>> PartialFraction.fromFactoredFraction xs y ==+>>> PartialFraction.fromFactoredFractionAlt xs y+>>>+>>> scaleInt :: (PID.C a, Indexable.C a) => a -> PartialFraction.T a -> Bool+>>> scaleInt k a =+>>> PartialFraction.toFraction (PartialFraction.scaleInt k a) ==+>>> Ratio.scale k (PartialFraction.toFraction a)+>>>+>>> add, sub, mul ::+>>> (PID.C a, Indexable.C a) =>+>>> PartialFraction.T a -> PartialFraction.T a -> Bool+>>> add = Laws.homomorphism PartialFraction.toFraction (+) (+)+>>> sub = Laws.homomorphism PartialFraction.toFraction (-) (-)+>>> mul = Laws.homomorphism PartialFraction.toFraction (*) (*)+-} + {- | @Cons z (indexMapFromList [(x0,[y00,y01]), (x1,[y10]), (x2,[y20,y21,y22])])@ represents the partial fraction@@ -123,6 +191,9 @@ There are more direct methods for special cases like polynomials over rational numbers where the denominators are linear factors.++prop> QC.listOf genSmallPrime /\ fractionConv+prop> fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConv -} fromFactoredFraction :: (PID.C a, Indexable.C a) => [a] -> a -> T a fromFactoredFraction denoms0 numer0 =@@ -145,6 +216,10 @@ -- Is reduceHeads also necessary for polynomial partial fractions? in removeZeros $ reduceHeads $ Cons intPart (indexMapFromList pairs) +{- |+prop> QC.listOf genSmallPrime /\ fractionConvAlt+prop> fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConvAlt+-} fromFactoredFractionAlt :: (PID.C a, Indexable.C a) => [a] -> a -> T a fromFactoredFractionAlt denoms numer = foldl (\p d -> scaleFrac (one%d) p) (fromValue numer) denoms@@ -205,9 +280,7 @@ -} removeZeros :: (Indexable.C a, ZeroTestable.C a) => T a -> T a removeZeros (Cons z m) =- Cons z $- Map.filter (not . null) $- Map.map (dropWhileRev isZero) m+ Cons z $ Map.filter (not . null) $ Map.map (Rev.dropWhile isZero) m {-@@ -220,7 +293,16 @@ zipWith opS opV (Cons za ma) (Cons zb mb) = Cons (opS za zb) (Map.unionWith opV ma mb) -instance (Indexable.C a, Integral.C a, ZeroTestable.C a) => Additive.C (T a) where+{- |+prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> add x y+prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> sub x y++prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> add x y+prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> sub x y+-}+instance+ (Indexable.C a, Integral.C a, ZeroTestable.C a) =>+ Additive.C (T a) where a + b = removeZeros $ normalizeModulo $ zipWith (+) (+) a b {- This implementation is attracting but wrong. It fails if terms are present in b that are missing in a.@@ -343,6 +425,10 @@ (uncurry (:) . carryRipple ds . map (ns*)) scaleFracs m) +{- |+prop> genPartialFractionInt /\ \x k -> scaleInt k x+prop> genPartialFractionPoly /\ \x k -> scaleInt k x+-} scaleInt :: (PID.C a, Indexable.C a) => a -> T a -> T a scaleInt x (Cons z m) = removeZeros $ normalizeModulo $@@ -359,6 +445,10 @@ scaleFrac (one%d) (scaleInt numer a + acc)) zero l) (indexMapToList m)) +{- |+prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> mul x y+prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> mul x y+-} mulFast :: (PID.C a, Indexable.C a) => T a -> T a -> T a mulFast pa pb = let ra = toFactoredFraction pa
src/MathObj/Permutation.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2006 Maintainer : numericprelude@henning-thielemann.de@@ -16,8 +16,6 @@ import Data.Array(Ix) --- import NumericPrelude.Numeric (Integer)--- import NumericPrelude.Base {- |
src/MathObj/Permutation/CycleList.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Mikael Johansson 2006 Maintainer : mik@math.uni-jena.de
src/MathObj/Permutation/CycleList/Check.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2006 Maintainer : numericprelude@henning-thielemann.de@@ -12,19 +12,12 @@ import qualified MathObj.Permutation.Table as PermTable import qualified MathObj.Permutation as Perm -{--import qualified Algebra.Ring as Ring-import qualified Algebra.Additive as Additive-import Algebra.Ring((*),one,fromInteger)-import Algebra.Additive((+))--}-import Algebra.Monoid((<*>)) import qualified Algebra.Monoid as Monoid+import Algebra.Monoid((<*>)) -import Data.Array((!), Ix) import qualified Data.Array as Array+import Data.Array((!), Ix) --- import NumericPrelude.Numeric (Integer) import NumericPrelude.Base hiding (cycle) {- |
src/MathObj/Permutation/Table.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2006 Maintainer : numericprelude@henning-thielemann.de@@ -23,7 +23,6 @@ import Data.Tuple.HT (swap, ) import Data.Maybe.HT (toMaybe, ) --- import NumericPrelude.Numeric (Integer) import NumericPrelude.Base hiding (cycle)
src/MathObj/Polynomial.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -81,7 +81,36 @@ import qualified Prelude as P98 +{- $setup+>>> import qualified MathObj.Polynomial as Poly+>>> import qualified Algebra.IntegralDomain as Integral+>>> import qualified Algebra.Laws as Laws+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> intPoly :: Poly.T Integer -> Poly.T Integer+>>> intPoly = id+>>>+>>> ratioPoly :: Poly.T Rational -> Poly.T Rational+>>> ratioPoly = id+-}++{- |+prop> Laws.identity (+) zero . intPoly+prop> Laws.commutative (+) . intPoly+prop> Laws.associative (+) . intPoly+prop> Laws.identity (*) one . intPoly+prop> Laws.commutative (*) . intPoly+prop> Laws.associative (*) . intPoly+prop> Laws.leftDistributive (*) (+) . intPoly+prop> Integral.propInverse . ratioPoly+-} newtype T a = Cons {coeffs :: [a]}++{-+>>> import Test.QuickCheck ((==>))+-} {-# INLINE fromCoeffs #-}
src/MathObj/Polynomial/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | This module implements polynomial functions on plain lists. We use such functions in order to implement methods of other datatypes.@@ -31,11 +31,11 @@ import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable +import qualified Data.List.Reverse.StrictSpine as Rev import qualified Data.List as List import NumericPrelude.List (zipWithOverlap, ) import Data.Tuple.HT (mapPair, mapFst, forcePair, )-import Data.List.HT- (dropWhileRev, switchL, shear, shearTranspose, outerProduct, )+import Data.List.HT (switchL, shear, shearTranspose, outerProduct) import qualified NumericPrelude.Base as P import qualified NumericPrelude.Numeric as NP@@ -44,6 +44,25 @@ import NumericPrelude.Numeric hiding (divMod, negate, stdUnit, ) +{- $setup+>>> import qualified MathObj.Polynomial.Core as PolyCore+>>> import qualified MathObj.Polynomial as Poly+>>> import qualified Data.List as List+>>> import qualified Test.QuickCheck as QC+>>> import Test.QuickCheck ((==>))+>>> import Data.Tuple.HT (mapPair, mapSnd)+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> intPoly :: [Integer] -> [Integer]+>>> intPoly = id+>>>+>>> ratioPoly :: [Rational] -> [Rational]+>>> ratioPoly = id+-}++ {- | Horner's scheme for evaluating a polynomial in a ring. -}@@ -69,7 +88,7 @@ -} {-# INLINE normalize #-} normalize :: (ZeroTestable.C a) => [a] -> [a]-normalize = dropWhileRev isZero+normalize = Rev.dropWhile isZero {- | Multiply by the variable, used internally.@@ -113,6 +132,9 @@ all (==zero) xs && all (==zero) ys +{- |+prop> \(QC.NonEmpty xs) (QC.NonEmpty ys) -> PolyCore.tensorProduct xs ys == List.transpose (PolyCore.tensorProduct ys (intPoly xs))+-} {-# INLINE tensorProduct #-} tensorProduct :: Ring.C a => [a] -> [a] -> [[a]] tensorProduct = outerProduct (*)@@ -135,6 +157,9 @@ -- this one fails on infinite lists -- mul xs = foldr (\y zs -> add (scale y xs) (shift zs)) [] +{- |+prop> \xs ys -> PolyCore.equal (intPoly $ PolyCore.mul xs ys) (PolyCore.mulShear xs ys)+-} {-# INLINE mulShear #-} mulShear :: Ring.C a => [a] -> [a] -> [a] mulShear xs ys = map sum (shear (tensorProduct xs ys))@@ -144,6 +169,11 @@ mulShearTranspose xs ys = map sum (shearTranspose (tensorProduct xs ys)) +{- |+prop> \x y -> case (PolyCore.normalize x, PolyCore.normalize y) of (nx, ny) -> not (null (ratioPoly ny)) ==> mapSnd PolyCore.normalize (PolyCore.divMod nx ny) == mapPair (PolyCore.normalize, PolyCore.normalize) (PolyCore.divMod x y)+prop> \x y -> not (isZero (ratioPoly y)) ==> let z = fst $ PolyCore.divMod (Poly.coeffs x) y in PolyCore.normalize z == z+prop> \x y -> case PolyCore.normalize $ ratioPoly y of ny -> not (null ny) ==> List.length (snd $ PolyCore.divMod x y) < List.length ny+-} divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a]) divMod x y = mapPair (List.reverse, List.reverse) $
src/MathObj/PowerSeries.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -27,6 +27,17 @@ import NumericPrelude.Numeric +{- $setup+>>> import qualified MathObj.PowerSeries.Core as PS+>>> import qualified MathObj.PowerSeries as PST+>>> import qualified Test.QuickCheck as QC+>>> import Test.NumericPrelude.Utility (equalTrunc, (/\))+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+-}++ newtype T a = Cons {coeffs :: [a]} deriving (Ord) {-# INLINE fromCoeffs #-}@@ -126,6 +137,9 @@ (-) = lift2 Poly.sub zero = lift0 [] +{- |+prop> QC.choose (1,10) /\ \expon (QC.Positive x) xs -> let xt = x:xs in equalTrunc 15 (PS.pow (const x) (1 % expon) (PST.coeffs (PST.fromCoeffs xt ^ expon)) ++ repeat zero) (xt ++ repeat zero)+-} instance (Ring.C a) => Ring.C (T a) where one = const one fromInteger n = const (fromInteger n)
src/MathObj/PowerSeries/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries.Core where import qualified MathObj.Polynomial.Core as Poly@@ -20,6 +20,32 @@ sin, cos, tan, asin, acos, atan) +{- $setup+>>> import qualified MathObj.PowerSeries.Core as PS+>>> import qualified MathObj.PowerSeries.Example as PSE+>>> import Test.NumericPrelude.Utility (equalTrunc, (/\))+>>> import qualified Test.QuickCheck as QC+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+>>> import Control.Applicative (liftA3)+>>>+>>> checkHoles ::+>>> Int -> ([Rational] -> [Rational]) ->+>>> Rational -> [Rational] -> QC.Property+>>> checkHoles trunc f x xs =+>>> QC.choose (1,10) /\ \expon ->+>>> equalTrunc trunc+>>> (f (PS.insertHoles expon (x:xs)) ++ repeat zero)+>>> (PS.insertHoles expon (f (x:xs)) ++ repeat zero)+>>>+>>> genInvertible :: QC.Gen [Rational]+>>> genInvertible =+>>> liftA3 (\x0 x1 xs -> x0:x1:xs)+>>> QC.arbitrary (fmap QC.getNonZero QC.arbitrary) QC.arbitrary+-}++ {-# INLINE evaluate #-} evaluate :: Ring.C a => [a] -> a -> a evaluate = flip Poly.horner@@ -78,6 +104,8 @@ {- | For power series of @f x@, compute the power series of @f(x^n)@.++prop> QC.choose (1,10) /\ \m -> QC.choose (1,10) /\ \n xs -> equalTrunc 100 (PS.insertHoles m $ PS.insertHoles n xs) (PS.insertHoles (m*n) xs) -} insertHoles :: Additive.C a => Int -> [a] -> [a] insertHoles n =@@ -158,6 +186,10 @@ We need to compute the square root only of the first term. That is, if the first term is rational, then all terms of the series are rational.++prop> equalTrunc 50 PSE.sqrtExpl (PS.sqrt (\1 -> 1) [1,1])+prop> equalTrunc 500 (1:1:repeat 0) (PS.sqrt (\1 -> 1) (PS.mul [1,1] [1,1]))+prop> checkHoles 50 (PS.sqrt (\1 -> 1)) 1 -} sqrt :: Field.C a => (a -> a) -> [a] -> [a] sqrt _ [] = []@@ -181,6 +213,11 @@ {- | Input series must start with a non-zero term, even better with a positive one.++prop> equalTrunc 100 (PSE.powExpl (-1/3)) (PS.pow (\1 -> 1) (-1/3) [1,1])+prop> equalTrunc 50 (PSE.powExpl (-1/3)) (PS.exp (\0 -> 1) (PS.scale (-1/3) PSE.log))+prop> checkHoles 30 (PS.pow (\1 -> 1) (1/3)) 1+prop> checkHoles 30 (PS.pow (\1 -> 1) (2/5)) 1 -} pow :: (Field.C a) => (a -> a) -> a -> [a] -> [a] pow f0 expon x =@@ -196,6 +233,10 @@ > (exp . x)' = (exp . x) * x' > (sin . x)' = (cos . x) * x' > (cos . x)' = - (sin . x) * x'++prop> equalTrunc 500 PSE.expExpl (PS.exp (\0 -> 1) [0,1])+prop> equalTrunc 100 (1:1:repeat 0) (PS.exp (\0 -> 1) PSE.log)+prop> checkHoles 30 (PS.exp (\0 -> 1)) 0 -} exp :: Field.C a => (a -> a) -> [a] -> [a] exp f0 x =@@ -214,10 +255,25 @@ sinCosScalar :: Transcendental.C a => a -> (a,a) sinCosScalar x = (Transcendental.sin x, Transcendental.cos x) -sin, cos :: Field.C a => (a -> (a,a)) -> [a] -> [a]+{- |+prop> equalTrunc 500 PSE.sinExpl (PS.sin (\0 -> (0,1)) [0,1])+prop> equalTrunc 50 (0:1:repeat 0) (PS.sin (\0 -> (0,1)) PSE.asin)+prop> checkHoles 20 (PS.sin (\0 -> (0,1))) 0+-}+sin :: Field.C a => (a -> (a,a)) -> [a] -> [a] sin f0 = fst . sinCos f0+{- |+prop> equalTrunc 500 PSE.cosExpl (PS.cos (\0 -> (0,1)) [0,1])+prop> checkHoles 20 (PS.cos (\0 -> (0,1))) 0+-}+cos :: Field.C a => (a -> (a,a)) -> [a] -> [a] cos f0 = snd . sinCos f0 +{- |+prop> equalTrunc 50 PSE.tanExpl (PS.tan (\0 -> (0,1)) [0,1])+prop> equalTrunc 50 (0:1:repeat 0) (PS.tan (\0 -> (0,1)) PSE.atan)+prop> checkHoles 20 (PS.tan (\0 -> (0,1))) 0+-} tan :: (Field.C a) => (a -> (a,a)) -> [a] -> [a] tan f0 = uncurry divide . sinCos f0 @@ -229,6 +285,10 @@ {- | Input series must start with non-zero term.++prop> equalTrunc 500 PSE.logExpl (PS.log (\1 -> 0) [1,1])+prop> equalTrunc 100 (0:1:repeat 0) (PS.log (\1 -> 0) PSE.exp)+prop> checkHoles 30 (PS.log (\1 -> 0)) 1 -} log :: (Field.C a) => (a -> a) -> [a] -> [a] log f0 x = integrate (f0 (head x)) (derivedLog x)@@ -239,17 +299,33 @@ derivedLog :: (Field.C a) => [a] -> [a] derivedLog x = divide (differentiate x) x +{- |+prop> equalTrunc 500 PSE.atan (PS.atan (\0 -> 0) [0,1])+prop> equalTrunc 50 (0:1:repeat 0) (PS.atan (\0 -> 0) PSE.tan)+prop> checkHoles 20 (PS.atan (\0 -> 0)) 0+-} atan :: (Field.C a) => (a -> a) -> [a] -> [a] atan f0 x = let x' = differentiate x in integrate (f0 (head x)) (divide x' ([1] + mul x x)) -asin, acos :: (Field.C a) =>- (a -> a) -> (a -> a) -> [a] -> [a]+{- |+prop> equalTrunc 100 (0:1:repeat 0) (PS.asin (\1 -> 1) (\0 -> 0) PSE.sin)+prop> equalTrunc 50 PSE.asin (PS.asin (\1 -> 1) (\0 -> 0) [0,1])+prop> checkHoles 30 (PS.asin (\1 -> 1) (\0 -> 0)) 0+-}+asin :: (Field.C a) => (a -> a) -> (a -> a) -> [a] -> [a] asin sqrt0 f0 x = let x' = differentiate x in integrate (f0 (head x)) (divide x' (sqrt sqrt0 ([1] - mul x x)))++{- |+Would be a nice test, but we cannot compute exactly with 'pi':++> equalTrunc 50 PSE.acos (PS.acos (\1 -> 1) (\0 -> pi/2) [0,1])+-}+acos :: (Field.C a) => (a -> a) -> (a -> a) -> [a] -> [a] acos = asin {- |@@ -303,6 +379,8 @@ This needs cubic run-time and thus is exceptionally slow. Computing inverse series for special power series might be faster.++prop> genInvertible /\ \xs -> let (y,ys) = PS.inv xs; (z,zs) = PS.invDiff xs in y==z && equalTrunc 15 ys zs -} -- how about NonEmpty.T here? inv :: (Eq a, Field.C a) => [a] -> (a, [a])
src/MathObj/PowerSeries/DifferentialEquation.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Lazy evaluation allows for the solution of differential equations in terms of power series.
src/MathObj/PowerSeries/Example.hs view
@@ -1,11 +1,10 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries.Example where import qualified MathObj.PowerSeries.Core as PS import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable import qualified Algebra.Transcendental as Transcendental @@ -19,6 +18,16 @@ import NumericPrelude.Base -- (Bool, const, map, zipWith, id, (&&), (==)) +{- $setup+>>> import qualified MathObj.PowerSeries.Core as PS+>>> import qualified MathObj.PowerSeries.Example as PSE+>>> import Test.NumericPrelude.Utility (equalTrunc)+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+-}++ {- * Default implementations. -} recip :: (Ring.C a) => [a]@@ -42,6 +51,8 @@ cosh = coshODE atanh = atanhODE ++-- | prop> \m n -> equalTrunc 30 (PS.mul (PSE.pow m) (PSE.pow n)) (PSE.pow (m+n)) pow :: (Field.C a) => a -> [a] pow = powExpl sqrt = sqrtExpl@@ -52,34 +63,54 @@ recipExpl :: (Ring.C a) => [a] recipExpl = cycle [1,-1] -expExpl, sinExpl, cosExpl :: (Field.C a) => [a]+-- | prop> equalTrunc 500 PSE.expExpl PSE.expODE+expExpl :: (Field.C a) => [a] expExpl = scanl (*) one PS.recipProgression+-- | prop> equalTrunc 500 PSE.sinExpl PSE.sinODE+sinExpl :: (Field.C a) => [a] sinExpl = zero : PS.holes2alternate (tail expExpl)-cosExpl = PS.holes2alternate expExpl+-- | prop> equalTrunc 500 PSE.cosExpl PSE.cosODE+cosExpl :: (Field.C a) => [a]+cosExpl = PS.holes2alternate expExpl -tanExpl, tanExplSieve :: (ZeroTestable.C a, Field.C a) => [a]+-- | prop> equalTrunc 50 PSE.tanExpl PSE.tanODE+tanExpl :: (ZeroTestable.C a, Field.C a) => [a] tanExpl = PS.divide sinExpl cosExpl -- ignore zero values+-- | prop> equalTrunc 50 PSE.tanExpl PSE.tanExplSieve+tanExplSieve :: (ZeroTestable.C a, Field.C a) => [a] tanExplSieve = concatMap (\x -> [zero,x]) (PS.divide (sieve 2 (tail sin)) (sieve 2 cos)) -logExpl, atanExpl, sqrtExpl :: (Field.C a) => [a]+-- | prop> equalTrunc 500 PSE.logExpl PSE.logODE+logExpl :: (Field.C a) => [a] logExpl = zero : PS.alternate PS.recipProgression+-- | prop> equalTrunc 500 PSE.atanExpl PSE.atanODE+atanExpl :: (Field.C a) => [a] atanExpl = zero : PS.holes2alternate PS.recipProgression -sinhExpl, coshExpl, atanhExpl :: (Field.C a) => [a]+-- | prop> equalTrunc 500 PSE.sinhExpl PSE.sinhODE+sinhExpl :: (Field.C a) => [a] sinhExpl = zero : PS.holes2 (tail expExpl)+-- | prop> equalTrunc 500 PSE.coshExpl PSE.coshODE+coshExpl :: (Field.C a) => [a] coshExpl = PS.holes2 expExpl+-- | prop> equalTrunc 500 PSE.atanhExpl PSE.atanhODE+atanhExpl :: (Field.C a) => [a] atanhExpl = zero : PS.holes2 PS.recipProgression {- * Power series of (1+x)^expon using the binomial series. -} +-- | prop> \expon -> equalTrunc 50 (PSE.powODE expon) (PSE.powExpl expon) powExpl :: (Field.C a) => a -> [a] powExpl expon = scanl (*) 1 (zipWith (/) (iterate (subtract 1) expon) PS.progression)++-- | prop> equalTrunc 100 PSE.sqrtExpl PSE.sqrtODE+sqrtExpl :: (Field.C a) => [a] sqrtExpl = powExpl (1/2) {- |@@ -110,11 +141,13 @@ == cos x ^ (-2) -} -expODE, sinODE, cosODE, tanODE, tanODESieve :: (Field.C a) => [a]+expODE, sinODE, cosODE, tanODE :: (Field.C a) => [a] expODE = PS.integrate 1 expODE sinODE = PS.integrate 0 cosODE cosODE = PS.integrate 1 (PS.negate sinODE) tanODE = PS.integrate 0 (PS.add [1] (PS.mul tanODE tanODE))+-- | prop> equalTrunc 50 PSE.tanODE PSE.tanODESieve+tanODESieve :: (Field.C a) => [a] tanODESieve = -- sieve is too strict here because it wants to detect end of lists let tan2 = map head (iterate (drop 2) (tail tanODESieve))@@ -126,9 +159,11 @@ atan' x == 1/(1+x^2) -} -logODE, recipCircle, asinODE, atanODE, sqrtODE :: (Field.C a) => [a]+logODE, recipCircle, atanODE, sqrtODE :: (Field.C a) => [a] logODE = PS.integrate zero recip recipCircle = intersperse zero (PS.alternate (powODE (-1/2)))+-- | prop> equalTrunc 50 PSE.asinODE (snd $ PS.inv PSE.sinODE)+asinODE :: (Field.C a) => [a] asinODE = PS.integrate 0 recipCircle atanODE = PS.integrate zero (cycle [1,0,-1,0]) sqrtODE = powODE (1/2)
src/MathObj/PowerSeries/Mean.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | This module computes power series for representing some means as generalized $f$-means.
src/MathObj/PowerSeries2.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -18,11 +18,6 @@ import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive import qualified Algebra.ZeroTestable as ZeroTestable--{--import qualified NumericPrelude.Numeric as NP-import qualified NumericPrelude.Base as P--} import Data.List (isPrefixOf, ) import qualified Data.List.Match as Match
src/MathObj/PowerSeries2/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries2.Core where import qualified MathObj.PowerSeries as PS@@ -11,7 +11,6 @@ import qualified Algebra.Additive as Additive import NumericPrelude.Base--- import NumericPrelude.Numeric hiding (negate, sqrt, ) type T a = [[a]]
src/MathObj/PowerSum.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |
src/MathObj/RefinementMask2.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.RefinementMask2 ( T, coeffs, fromCoeffs, fromPolynomial,@@ -29,6 +29,43 @@ import NumericPrelude.Numeric +{- $setup+>>> import qualified MathObj.RefinementMask2 as Mask+>>> import qualified MathObj.Polynomial as Poly+>>> import qualified MathObj.Polynomial.Core as PolyCore+>>>+>>> import qualified Algebra.Differential as D+>>> import qualified Algebra.Ring as Ring+>>> import Test.NumericPrelude.Utility ((/\))+>>> import qualified Test.QuickCheck as QC+>>> import NumericPrelude.Numeric as NP+>>> import NumericPrelude.Base as P+>>> import Prelude ()+>>>+>>> import Data.Function.HT (nest)+>>> import Data.Maybe (fromMaybe)+>>>+>>>+>>> hasMultipleZero :: (Ring.C a, Eq a) => Int -> a -> Poly.T a -> Bool+>>> hasMultipleZero n x poly =+>>> all (zero==) $ take n $+>>> map (flip Poly.evaluate x) $+>>> iterate D.differentiate poly+>>>+>>> genAdmissibleMask :: QC.Gen (Mask.T Rational, Poly.T Rational)+>>> genAdmissibleMask =+>>> QC.suchThatMap QC.arbitrary $+>>> \mask -> fmap ((,) mask) $ Mask.toPolynomial mask+>>>+>>> polyFromMask :: Mask.T a -> Poly.T a+>>> polyFromMask = Poly.fromCoeffs . Mask.coeffs+>>>+>>> genShortPolynomial :: Int -> QC.Gen (Poly.T Rational)+>>> genShortPolynomial n =+>>> fmap (Poly.fromCoeffs . PolyCore.normalize . take n) $ QC.arbitrary+-}++ newtype T a = Cons {coeffs :: [a]} @@ -85,6 +122,11 @@ p2 = L * R^(-1) * m R * L^(-1) * p2 = m+++prop> genAdmissibleMask /\ \(mask,poly) -> hasMultipleZero (fromMaybe 0 $ Poly.degree poly) 1 (polyFromMask (Mask.fromPolynomial poly) - polyFromMask mask)++prop> genShortPolynomial 5 /\ \poly -> maybe False (Poly.collinear poly) $ Mask.toPolynomial $ Mask.fromPolynomial poly -} fromPolynomial :: (Field.C a) => Poly.T a -> T a@@ -115,6 +157,9 @@ {- | If the mask does not sum up to a power of @1/2@ then the function returns 'Nothing'.++>>> fmap ((6::Rational) *>) $ Mask.toPolynomial (Mask.fromCoeffs [0.1, 0.02, 0.005::Rational])+Just (Polynomial.fromCoeffs [-12732 % 109375,272 % 625,-18 % 25,1 % 1]) -} toPolynomial :: (RealField.C a) => T a -> Maybe (Poly.T a)@@ -131,10 +176,6 @@ in ip + Poly.const (correctConstant (fmap (k/s*) mask) ip)) (Poly.const 1) ks0 _ -> Nothing-{--> fmap (6 Vector.*>) $ toPolynomial (Cons [0.1, 0.02, 0.005::Rational])-Just (Polynomial.fromCoeffs [-12732 % 109375, 272 % 625, -18 % 25, 1 % 1])--} {- The constant term must be zero,@@ -162,17 +203,18 @@ (Poly.const 1) ks0 _ -> Nothing +{- |+prop> genShortPolynomial 5 /\ \poly -> poly == Mask.refinePolynomial (Mask.fromPolynomial poly) poly++>>> fmap (round :: Double -> Integer) $ fmap (1000000*) $ nest 50 (Mask.refinePolynomial (Mask.fromCoeffs [0.1, 0.02, 0.005])) (Poly.fromCoeffs [0,0,0,1])+Polynomial.fromCoeffs [-116407,435200,-720000,1000000]+-} refinePolynomial :: (Ring.C a) => T a -> Poly.T a -> Poly.T a refinePolynomial mask = Poly.shrink 2 . Vector.linearComb (coeffs mask) . iterate (Poly.translate 1)-{--> mapM_ print $ take 50 $ iterate (refinePolynomial (Cons [0.1, 0.02, 0.005])) (Poly.fromCoeffs [0,0,0,1::Double])-...-Polynomial.fromCoeffs [-0.11640685714285712,0.4351999999999999,-0.7199999999999999,1.0]--} convolve :: (Ring.C a) => T a -> T a -> T a
src/MathObj/RootSet.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2004-2005
src/Number/Complex.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- Rules should be processed -}@@ -48,7 +48,6 @@ defltPow, ) where --- import qualified Number.Ratio as Ratio import qualified Algebra.NormedSpace.Euclidean as NormedEuc import qualified Algebra.NormedSpace.Sum as NormedSum@@ -93,7 +92,6 @@ import Text.Read.HT (readsInfixPrec, ) --- import qualified Data.Typeable as Ty infix 6 +:, `Cons`
src/Number/DimensionTerm/SI.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Special physical units: SI unit system -}@@ -31,10 +31,8 @@ SI.exa, SI.zetta, SI.yotta, ) where --- import qualified Algebra.Transcendental as Trans import qualified Algebra.Field as Field --- import qualified Algebra.DimensionTerm as Dim import qualified Number.DimensionTerm as DN import qualified Number.SI.Unit as SI
src/Number/FixedPoint.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2006 @@ -17,14 +17,13 @@ module Number.FixedPoint where import qualified Algebra.RealRing as RealRing--- import qualified Algebra.Additive as Additive--- import qualified Algebra.ZeroTestable as ZeroTestable import qualified Algebra.Transcendental as Trans import qualified MathObj.PowerSeries.Example as PSE +import qualified Data.List.Reverse.StrictElement as Rev import NumericPrelude.List (mapLast, ) import Data.Function.HT (powerAssociative, )-import Data.List.HT (dropWhileRev, padLeft, )+import Data.List.HT (padLeft) import Data.Maybe.HT (toMaybe, ) import Data.List (transpose, unfoldr, ) import Data.Char (intToDigit, )@@ -60,7 +59,7 @@ basis = ringPower packetSize 10 (int,frac) = toPositional basis den x in show int ++ "." ++- concat (mapLast (dropWhileRev ('0'==))+ concat (mapLast (Rev.dropWhile ('0'==)) (map (padLeft '0' packetSize . show) frac)) showPositionalHex :: Integer -> Integer -> String
src/Number/FixedPoint/Check.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.FixedPoint.Check where import qualified Number.FixedPoint as FP
src/Number/GaloisField2p32m5.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {- | This number type is intended for tests of functions over fields,@@ -7,7 +7,7 @@ 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.+Thus division is not always defined, where it is for rational numbers. -} module Number.GaloisField2p32m5 where @@ -30,6 +30,30 @@ import NumericPrelude.Numeric +{- $setup+>>> import qualified Number.GaloisField2p32m5 as GF+>>> import qualified Algebra.Laws as Laws+>>> import Test.QuickCheck ((==>))+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> gf :: GF.T -> GF.T+>>> gf = id+-}++{- |+prop> Laws.identity (+) zero . gf+prop> Laws.commutative (+) . gf+prop> Laws.associative (+) . gf+prop> Laws.inverse (+) negate zero . gf+prop> \x -> Laws.inverse (+) (x-) (gf x)+prop> Laws.identity (*) one . gf+prop> Laws.commutative (*) . gf+prop> Laws.associative (*) . gf+prop> \y -> gf y /= zero ==> Laws.inverse (*) recip one y+prop> \y x -> gf y /= zero ==> Laws.inverse (*) (x/) x y+-} newtype T = Cons {decons :: Word32} deriving Eq
src/Number/NonNegative.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-@@ -46,7 +46,6 @@ import qualified Algebra.ToInteger as ToInteger import qualified Algebra.ToRational as ToRational--- import Test.QuickCheck (Arbitrary(arbitrary)) import qualified Number.Ratio as R
src/Number/OccasionallyScalarExpression.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |
src/Number/PartiallyTranscendental.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Define Transcendental functions on arbitrary fields. These functions are defined for only a few (in most cases only one) arguments,@@ -15,7 +15,6 @@ import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive--- import qualified Algebra.ZeroTestable as ZeroTestable import NumericPrelude.Numeric import NumericPrelude.Base
src/Number/Peano.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright : (c) Henning Thielemann 2007-2012 Maintainer : numericprelude@henning-thielemann.de@@ -32,14 +32,10 @@ import Data.Maybe (catMaybes, ) import Data.Array(Ix(..)) -import qualified Prelude as P98-{--import qualified NumericPrelude.Base as P-import qualified NumericPrelude.Numeric as NP--} import Data.List.HT (mapAdjacent, shearTranspose, ) import Data.Tuple.HT (mapFst, ) +import qualified Prelude as P98 import NumericPrelude.Base import NumericPrelude.Numeric
src/Number/Physical.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |
src/Number/Physical/Read.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Convert a human readable string to a physical value. -}@@ -8,7 +8,6 @@ import qualified Number.Physical as Value import qualified Number.Physical.UnitDatabase as Db import qualified Algebra.VectorSpace as VectorSpace--- import Algebra.Module((*>)) import qualified Algebra.Field as Field import qualified Data.Map as Map import Data.Map (Map)
src/Number/Physical/Show.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Convert a physical value to a human readable string. -}
src/Number/Physical/Unit.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Abstract Physical Units -}
src/Number/Physical/UnitDatabase.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Tools for creating a data base of physical units and for extracting data from it@@ -9,7 +9,6 @@ import qualified Number.Physical.Unit as Unit import qualified Algebra.Field as Field --- import Algebra.Module((*>)) import Algebra.NormedSpace.Sum(norm) import Data.Maybe.HT (toMaybe)
src/Number/Positional.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Exact Real Arithmetic - Computable reals. Inspired by ''The most unreliable technique for computing pi.''@@ -11,7 +11,6 @@ import qualified Algebra.IntegralDomain as Integral import qualified Algebra.Ring as Ring--- import qualified Algebra.Additive as Additive import qualified Algebra.ToInteger as ToInteger import qualified Prelude as P98@@ -421,7 +420,7 @@ This would create finite representations in some cases (input is finite, and the result is finite) but will cause infinite loop otherwise.- dropWhileRev (0==) . compressMant bDst+ Rev.dropWhile (0==) . compressMant bDst -} cmpr (mag,xs) = (mag - unit, compressMant bSrc xs)
src/Number/Positional/Check.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Interface to "Number.Positional" which dynamically checks for equal bases. -}@@ -8,7 +8,6 @@ import qualified Number.Complex as Complex --- import qualified Algebra.Module as Module import qualified Algebra.RealTranscendental as RealTrans import qualified Algebra.Transcendental as Trans import qualified Algebra.Algebraic as Algebraic@@ -23,7 +22,6 @@ import qualified Algebra.EqualityDecision as EqDec import qualified Algebra.OrderDecision as OrdDec --- import qualified NumericPrelude.Base as P import qualified Prelude as P98 import NumericPrelude.Base as P
src/Number/Quaternion.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -55,11 +55,9 @@ import qualified NumericPrelude.Elementwise as Elem import Algebra.Additive ((<*>.+), (<*>.-), (<*>.-$), ) --- import qualified Data.Typeable as Ty import Data.Array (Array, (!)) import qualified Data.Array as Array --- import qualified Prelude as P import NumericPrelude.Base import NumericPrelude.Numeric hiding (signum) import Text.Show.HT (showsInfixPrec, )
src/Number/Ratio.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Module : Number.Ratio Copyright : (c) Henning Thielemann 2011-2012
src/Number/ResidueClass.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass where import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.IntegralDomain as Integral--- import qualified Algebra.Additive as Additive--- import qualified Algebra.ZeroTestable as ZeroTestable import NumericPrelude.Base import NumericPrelude.Numeric hiding (recip)
src/Number/ResidueClass/Check.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Check where import qualified Number.ResidueClass as Res
src/Number/ResidueClass/Func.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Func where import qualified Number.ResidueClass as Res
src/Number/ResidueClass/Maybe.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Maybe where import qualified Number.ResidueClass as Res
src/Number/ResidueClass/Reader.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Reader where import qualified Number.ResidueClass as Res@@ -13,9 +13,7 @@ import Control.Monad (liftM, liftM2, liftM4, ap) import Control.Applicative (Applicative(pure, (<*>)))--- import Control.Monad.Reader (MonadReader) --- import qualified Prelude as P import qualified NumericPrelude.Numeric as NP
src/Number/SI.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
src/Number/SI/Unit.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Special physical units: SI unit system -}
src/NumericPrelude/List/Checked.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Some functions that are counterparts of functions from "Data.List" using NumericPrelude.Numeric type classes.@@ -13,7 +13,6 @@ ) where import qualified Algebra.ToInteger as ToInteger--- import qualified Algebra.Ring as Ring import Algebra.Ring (one, ) import Algebra.Additive (zero, (-), )
src/NumericPrelude/List/Generic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Functions that are counterparts of the @generic@ functions in "Data.List" using NumericPrelude.Numeric type classes.
src/NumericPrelude/Numeric.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module NumericPrelude.Numeric ( {- Additive -} (+), (-), negate, zero, subtract, sum, sum1, {- ZeroTestable -} isZero,
test/Demo.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Main where import Number.Complex((+:), (-:), )
− test/Number/ComplexSquareRoot.hs
@@ -1,117 +0,0 @@-module Number.ComplexSquareRoot where---- import qualified Algebra.Algebraic as Algebraic-import qualified Algebra.RealField as RealField-import qualified Algebra.RealRing as RealRing--- import qualified Algebra.Field as Field-import qualified Algebra.Ring as Ring-import qualified Algebra.Additive as Additive-import qualified Algebra.ZeroTestable as ZeroTestable--import qualified Number.Complex as Complex--import Test.QuickCheck (Arbitrary, arbitrary, )--import Control.Monad (liftM2, )--import qualified NumericPrelude.Numeric as NP-import NumericPrelude.Numeric hiding (recip, )-import NumericPrelude.Base-import Prelude ()--{- |-Represent the square root of a complex number-without actually having to compute a square root.-If the Bool is False,-then the square root is represented with positive real part-or zero real part and positive imaginary part.-If the Bool is True the square root is negated.--}-data T a = Cons Bool (Complex.T a)- deriving (Show)--{- |-You must use @fmap@ only for number type conversion.--}-instance Functor T where- fmap f (Cons n x) = Cons n (fmap f x)--instance (ZeroTestable.C a) => ZeroTestable.C (T a) where- isZero (Cons _b s) = isZero s--instance (ZeroTestable.C a, Eq a) => Eq (T a) where- (Cons xb xs) == (Cons yb ys) =- isZero xs && isZero ys ||- xb==yb && xs==ys--instance (Arbitrary a) => Arbitrary (T a) where- arbitrary = liftM2 Cons arbitrary arbitrary---fromNumber :: (RealRing.C a) => Complex.T a -> T a-fromNumber x =- Cons- (case compare zero (Complex.real x) of- LT -> False- GT -> True- EQ -> Complex.imag x < zero)- (x^2)---- htam:Wavelet.DyadicResultant.parityFlip-toNumber :: (RealRing.C a, Complex.Power a) => T a -> Complex.T a-toNumber (Cons n x) =- case sqrt x of y -> if n then NP.negate y else y---one :: (Ring.C a) => T a-one = Cons False NP.one--inUpperHalfplane :: (Additive.C a, Ord a) => Complex.T a -> Bool-inUpperHalfplane x =- case compare (Complex.imag x) zero of- GT -> True- LT -> False- EQ -> Complex.real x < zero--mul, mulAlt, mulAlt2 :: (RealRing.C a) => T a -> T a -> T a-mul (Cons xb xs) (Cons yb ys) =- let zs = xs*ys- in Cons- ((xb /= yb) /=- case (inUpperHalfplane xs,- inUpperHalfplane ys,- inUpperHalfplane zs) of- (True,True,False) -> True- (False,False,True) -> True- _ -> False)- zs--mulAlt (Cons xb xs) (Cons yb ys) =- let zs = xs*ys- in Cons- ((xb /= yb) /=- let xi = Complex.imag xs- yi = Complex.imag ys- zi = Complex.imag zs- in (xi>=zero) /= (yi>=zero) &&- (xi>=zero) /= (zi>=zero))- zs--mulAlt2 (Cons xb xs) (Cons yb ys) =- let zs = xs*ys- in Cons- ((xb /= yb) /=- let xi = Complex.imag xs- yi = Complex.imag ys- zi = Complex.imag zs- in xi*yi<zero && xi*zi<zero)- zs--div :: (RealField.C a) => T a -> T a -> T a-div x y = mul x (recip y)--recip :: (RealField.C a) => T a -> T a-recip (Cons b s) =- Cons- (b /= (Complex.imag s == zero && Complex.real s < zero))- (NP.recip s)
test/Test/Algebra/Additive.hs view
@@ -1,35 +1,28 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.Algebra.Additive where--import qualified Algebra.Additive as A--import Test.NumericPrelude.Utility (testUnit, )-import Test.QuickCheck (Testable, quickCheck, )-import qualified Test.HUnit as HUnit--import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP-+-- Do not edit! Automatically created with doctest-extract from src/Algebra/Additive.hs+{-# LINE 42 "src/Algebra/Additive.hs" #-} -test ::- (Testable t) =>- ([Integer] -> t) -> IO ()-test = quickCheck+module Test.Algebra.Additive where +import qualified Test.DocTest.Driver as DocTest -tests :: HUnit.Test-tests =- HUnit.TestLabel "additive group" $- HUnit.TestList $- map testUnit $- testList+{-# LINE 43 "src/Algebra/Additive.hs" #-}+import qualified Algebra.Additive as A+import qualified Test.QuickCheck as QC -testList :: [(String, IO ())]-testList =- ("sum1", test $ \ns n ->- A.sum (n:ns) == A.sum1 (n:ns)) :- ("sumNestedAssociative", test $ \ns ->- A.sum ns == A.sumNestedAssociative ns) :- ("sumNestedCommutative", test $ \ns ->- A.sum ns == A.sumNestedCommutative ns) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "Algebra.Additive:108: "+{-# LINE 108 "src/Algebra/Additive.hs" #-}+ DocTest.property+{-# LINE 108 "src/Algebra/Additive.hs" #-}+ (\(QC.NonEmpty ns) -> A.sum ns == (A.sum1 ns :: Integer))+ DocTest.printPrefix "Algebra.Additive:121: "+{-# LINE 121 "src/Algebra/Additive.hs" #-}+ DocTest.property+{-# LINE 121 "src/Algebra/Additive.hs" #-}+ (\ns -> A.sum ns == (A.sumNestedAssociative ns :: Integer))+ DocTest.printPrefix "Algebra.Additive:136: "+{-# LINE 136 "src/Algebra/Additive.hs" #-}+ DocTest.property+{-# LINE 136 "src/Algebra/Additive.hs" #-}+ (\ns -> A.sum ns == (A.sumNestedCommutative ns :: Integer))
test/Test/Algebra/IntegralDomain.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.Algebra.IntegralDomain where--import Algebra.IntegralDomain (roundDown, roundUp, divUp, )--import Test.NumericPrelude.Utility (testUnit, )-import Test.QuickCheck (Testable, quickCheck, (==>), )-import qualified Test.HUnit as HUnit--import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP-+-- Do not edit! Automatically created with doctest-extract from src/Algebra/IntegralDomain.hs+{-# LINE 54 "src/Algebra/IntegralDomain.hs" #-} -test ::- (Testable t) =>- (Integer -> t) -> IO ()-test = quickCheck+module Test.Algebra.IntegralDomain where +import qualified Test.DocTest.Driver as DocTest -tests :: HUnit.Test-tests =- HUnit.TestLabel "integral domain functions" $- HUnit.TestList $- map testUnit $- testList+{-# LINE 55 "src/Algebra/IntegralDomain.hs" #-}+import Algebra.IntegralDomain (roundDown, roundUp, divUp)+import qualified Test.QuickCheck as QC+import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+import Prelude () -testList :: [(String, IO ())]-testList =- ("divMod", test $ \n m ->- m/=0 ==> let (q,r) = divMod n m in n == q*m+r) :- ("divRound", test $ \n m ->- m/=0 ==> div n m * m == roundDown n m) :- ("divUpRound", test $ \n m ->- m/=0 ==> divUp n m * m == roundUp n m) :- ("floorLimit", test $ \n m0 ->- let m = 1 + abs m0- x = roundDown n m- in n-m < x && x <=n) :- ("floorCeiling", test $ \n m ->- m/=0 ==> - roundDown n m == roundUp (-n) m) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "Algebra.IntegralDomain:108: "+{-# LINE 108 "src/Algebra/IntegralDomain.hs" #-}+ DocTest.property+{-# LINE 108 "src/Algebra/IntegralDomain.hs" #-}+ (\n (QC.NonZero m) -> let (q,r) = divMod n m in n == (q*m+r :: Integer))+ DocTest.printPrefix "Algebra.IntegralDomain:198: "+{-# LINE 198 "src/Algebra/IntegralDomain.hs" #-}+ DocTest.property+{-# LINE 198 "src/Algebra/IntegralDomain.hs" #-}+ (\n (QC.NonZero m) -> div n m * m == (roundDown n m :: Integer))+ DocTest.printPrefix "Algebra.IntegralDomain:208: "+{-# LINE 208 "src/Algebra/IntegralDomain.hs" #-}+ DocTest.property+{-# LINE 208 "src/Algebra/IntegralDomain.hs" #-}+ (\n (QC.NonZero m) -> divUp n m * m == (roundUp n m :: Integer))+ DocTest.printPrefix "Algebra.IntegralDomain:209: "+{-# LINE 209 "src/Algebra/IntegralDomain.hs" #-}+ DocTest.property+{-# LINE 209 "src/Algebra/IntegralDomain.hs" #-}+ (\n (QC.Positive m) -> let x = roundDown n m in n-m < x && x <= (n :: Integer))+ DocTest.printPrefix "Algebra.IntegralDomain:210: "+{-# LINE 210 "src/Algebra/IntegralDomain.hs" #-}+ DocTest.property+{-# LINE 210 "src/Algebra/IntegralDomain.hs" #-}+ (\n (QC.NonZero m) -> - roundDown n m == (roundUp (-n) m :: Integer))
+ test/Test/Algebra/PrincipalIdealDomain.hs view
@@ -0,0 +1,49 @@+-- Do not edit! Automatically created with doctest-extract from src/Algebra/PrincipalIdealDomain.hs+{-# LINE 64 "src/Algebra/PrincipalIdealDomain.hs" #-}++module Test.Algebra.PrincipalIdealDomain where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 65 "src/Algebra/PrincipalIdealDomain.hs" #-}+import qualified Algebra.PrincipalIdealDomain as PID+import Test.NumericPrelude.Utility ((/\))+import qualified Test.QuickCheck as QC++genResidueClass :: QC.Gen (Integer,Integer)+genResidueClass = do+ m <- fmap QC.getNonZero $ QC.arbitrary+ a <- QC.choose (min 0 $ 1+m, max 0 $ m-1)+ return (m,a)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Algebra.PrincipalIdealDomain:305: "+{-# LINE 305 "src/Algebra/PrincipalIdealDomain.hs" #-}+ DocTest.property+{-# LINE 305 "src/Algebra/PrincipalIdealDomain.hs" #-}+ (QC.listOf genResidueClass /\ \xs -> case PID.chineseRemainderMulti xs of Nothing -> True; Just (n,b) -> abs n == abs (foldl lcm 1 (map fst xs)) && map snd xs == map (mod b . fst) xs)+ DocTest.printPrefix "Algebra.PrincipalIdealDomain:306: "+{-# LINE 306 "src/Algebra/PrincipalIdealDomain.hs" #-}+ DocTest.property+{-# LINE 306 "src/Algebra/PrincipalIdealDomain.hs" #-}+ (\(QC.NonEmpty ms) b -> let xs = map (\(QC.NonZero m) -> (m, mod b m)) ms in case PID.chineseRemainderMulti xs of Nothing -> False; Just (n,c) -> abs n == abs (foldl lcm 1 (map QC.getNonZero ms)) && mod b n == (c::Integer))+ DocTest.printPrefix "Algebra.PrincipalIdealDomain:298: "+{-# LINE 298 "src/Algebra/PrincipalIdealDomain.hs" #-}+ DocTest.example+{-# LINE 298 "src/Algebra/PrincipalIdealDomain.hs" #-}+ (PID.chineseRemainderMulti [(100,21), (10000,2021::Integer)])+ [ExpectedLine [LineChunk "Just (10000,2021)"]]+ DocTest.printPrefix "Algebra.PrincipalIdealDomain:300: "+{-# LINE 300 "src/Algebra/PrincipalIdealDomain.hs" #-}+ DocTest.example+{-# LINE 300 "src/Algebra/PrincipalIdealDomain.hs" #-}+ (PID.chineseRemainderMulti [(97,90),(99,10),(100,0::Integer)])+ [ExpectedLine [LineChunk "Just (960300,100000)"]]+ DocTest.printPrefix "Algebra.PrincipalIdealDomain:302: "+{-# LINE 302 "src/Algebra/PrincipalIdealDomain.hs" #-}+ DocTest.example+{-# LINE 302 "src/Algebra/PrincipalIdealDomain.hs" #-}+ (PID.chineseRemainderMulti [(95,30),(97,27),(98,8),(99,1::Integer)])+ [ExpectedLine [LineChunk "Just (89403930,1000000)"]]
test/Test/Algebra/RealRing.hs view
@@ -1,40 +1,126 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.Algebra.RealRing where--import qualified Algebra.RealRing as RealRing--import Test.NumericPrelude.Utility (testUnit, )-import Test.QuickCheck (quickCheck, )-import qualified Test.HUnit as HUnit--import Data.Tuple.HT (mapFst, )+-- Do not edit! Automatically created with doctest-extract from src/Algebra/RealRing.hs+{-# LINE 38 "src/Algebra/RealRing.hs" #-} -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+module Test.Algebra.RealRing where +import qualified Test.DocTest.Driver as DocTest -test :: (Eq a) => (Double -> a) -> (Double -> a) -> IO ()-test f g =- quickCheck (\x -> f x == g x)+{-# LINE 39 "src/Algebra/RealRing.hs" #-}+import qualified Algebra.RealRing as RealRing+import Data.Tuple.HT (mapFst)+import NumericPrelude.Numeric as NP+import NumericPrelude.Base+import Prelude () +infix 4 =~= -tests :: HUnit.Test-tests =- HUnit.TestLabel "rounding functions" $- HUnit.TestList $- map testUnit $- ("round", test RealRing.genericRound (NP.round :: Double -> Integer)) :- ("truncate", test RealRing.genericTruncate (NP.truncate :: Double -> Integer)) :- ("ceiling", test RealRing.genericCeiling (NP.ceiling :: Double -> Integer)) :- ("floor", test RealRing.genericFloor (NP.floor :: Double -> Integer)) :- ("fraction", test RealRing.genericFraction (NP.fraction :: Double -> Double)) :- ("splitFraction", test RealRing.genericSplitFraction (NP.splitFraction :: Double -> (Integer, Double))) :+(=~=) :: (Eq b) => (a -> b) -> (a -> b) -> a -> Bool+(f =~= g) x = f x == g x -{-- ("splitFractionId", quickCheck (\x -> (x::Double) == (uncurry (+) $ mapFst fromInteger $ splitFraction x))) :--}- ("splitFractionId", quickCheck (\x -> uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x)) :- ("splitFractionFloorFraction", quickCheck (\x -> (floor (x::Double) :: Integer, fraction x) == splitFraction x)) :- ("fractionBound", quickCheck (\x -> let y = fraction (x::Double) in 0<=y && y<1)) :- ("floorCeiling", quickCheck (\x -> negate (floor (x::Double) :: Integer) == ceiling (-x))) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "Algebra.RealRing:134: "+{-# LINE 134 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 134 "src/Algebra/RealRing.hs" #-}+ (\x -> (x::Rational) == (uncurry (+) $ mapFst fromInteger $ splitFraction x))+ DocTest.printPrefix "Algebra.RealRing:135: "+{-# LINE 135 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 135 "src/Algebra/RealRing.hs" #-}+ (\x -> uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x)+ DocTest.printPrefix "Algebra.RealRing:136: "+{-# LINE 136 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 136 "src/Algebra/RealRing.hs" #-}+ (\x -> uncurry (==) $ mapFst (((x::Rational)-) . fromInteger) $ splitFraction x)+ DocTest.printPrefix "Algebra.RealRing:137: "+{-# LINE 137 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 137 "src/Algebra/RealRing.hs" #-}+ (\x -> splitFraction x == (floor (x::Double) :: Integer, fraction x))+ DocTest.printPrefix "Algebra.RealRing:138: "+{-# LINE 138 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 138 "src/Algebra/RealRing.hs" #-}+ (\x -> splitFraction x == (floor (x::Rational) :: Integer, fraction x))+ DocTest.printPrefix "Algebra.RealRing:142: "+{-# LINE 142 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 142 "src/Algebra/RealRing.hs" #-}+ (\x -> let y = fraction (x::Double) in 0<=y && y<1)+ DocTest.printPrefix "Algebra.RealRing:143: "+{-# LINE 143 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 143 "src/Algebra/RealRing.hs" #-}+ (\x -> let y = fraction (x::Rational) in 0<=y && y<1)+ DocTest.printPrefix "Algebra.RealRing:147: "+{-# LINE 147 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 147 "src/Algebra/RealRing.hs" #-}+ (\x -> ceiling (-x) == negate (floor (x::Double) :: Integer))+ DocTest.printPrefix "Algebra.RealRing:148: "+{-# LINE 148 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 148 "src/Algebra/RealRing.hs" #-}+ (\x -> ceiling (-x) == negate (floor (x::Rational) :: Integer))+ DocTest.printPrefix "Algebra.RealRing:564: "+{-# LINE 564 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 564 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericFloor =~= (NP.floor :: Double -> Integer))+ DocTest.printPrefix "Algebra.RealRing:565: "+{-# LINE 565 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 565 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericFloor =~= (NP.floor :: Rational -> Integer))+ DocTest.printPrefix "Algebra.RealRing:574: "+{-# LINE 574 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 574 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericCeiling =~= (NP.ceiling :: Double -> Integer))+ DocTest.printPrefix "Algebra.RealRing:575: "+{-# LINE 575 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 575 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericCeiling =~= (NP.ceiling :: Rational -> Integer))+ DocTest.printPrefix "Algebra.RealRing:584: "+{-# LINE 584 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 584 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericTruncate =~= (NP.truncate :: Double -> Integer))+ DocTest.printPrefix "Algebra.RealRing:585: "+{-# LINE 585 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 585 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericTruncate =~= (NP.truncate :: Rational -> Integer))+ DocTest.printPrefix "Algebra.RealRing:594: "+{-# LINE 594 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 594 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericRound =~= (NP.round :: Double -> Integer))+ DocTest.printPrefix "Algebra.RealRing:595: "+{-# LINE 595 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 595 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericRound =~= (NP.round :: Rational -> Integer))+ DocTest.printPrefix "Algebra.RealRing:604: "+{-# LINE 604 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 604 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericFraction =~= (NP.fraction :: Double -> Double))+ DocTest.printPrefix "Algebra.RealRing:605: "+{-# LINE 605 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 605 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericFraction =~= (NP.fraction :: Rational -> Rational))+ DocTest.printPrefix "Algebra.RealRing:614: "+{-# LINE 614 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 614 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericSplitFraction =~= (NP.splitFraction :: Double -> (Integer,Double)))+ DocTest.printPrefix "Algebra.RealRing:615: "+{-# LINE 615 "src/Algebra/RealRing.hs" #-}+ DocTest.property+{-# LINE 615 "src/Algebra/RealRing.hs" #-}+ (RealRing.genericSplitFraction =~= (NP.splitFraction :: Rational -> (Integer,Rational)))
test/Test/MathObj/Gaussian/Bell.hs view
@@ -1,103 +1,157 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.MathObj.Gaussian.Bell where--import qualified MathObj.Gaussian.Bell as G--import qualified Algebra.Laws as Laws+-- Do not edit! Automatically created with doctest-extract from gaussian/MathObj/Gaussian/Bell.hs+{-# LINE 30 "gaussian/MathObj/Gaussian/Bell.hs" #-} -import qualified Number.Complex as Complex+module Test.MathObj.Gaussian.Bell where -import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Testable, quickCheck, (==>))-import qualified Test.HUnit as HUnit+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest -import Data.Function.HT (nest, )+{-# LINE 31 "gaussian/MathObj/Gaussian/Bell.hs" #-}+import qualified MathObj.Gaussian.Bell as G+import qualified Algebra.ZeroTestable as ZeroTestable+import qualified Algebra.Laws as Laws+import qualified Number.Complex as Complex+import Number.Complex ((+:))+import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+import Prelude ()+import qualified Test.QuickCheck as QC+import Data.Function.HT (Id, nest) -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+asRational :: Id (G.T Rational)+asRational = id +withRational :: Id (G.T Rational -> a)+withRational = id -simple ::- (Testable t) =>- (G.T Rational -> t) -> IO ()-simple = quickCheck+isConstant :: ZeroTestable.C a => G.T a -> Bool+isConstant (G.Cons _amp _a b c) = isZero b && isZero c -tests :: HUnit.Test-tests =- HUnit.TestLabel "polynomial" $- HUnit.TestList $- map testUnit $-{-- ("convolution, dirac",- simple $ Laws.identity (+) zero) :--}- ("convolution, commutative",- simple $ Laws.commutative G.convolve) :- ("convolution, associative",- simple $ Laws.associative G.convolve) :- ("convolution by constant function",- {-- using a G.norm1 we could exactly compute the amplitude- of the resulting constant function.- -}- simple $ \x ->- case G.convolve x (G.constant) of- G.Cons _amp _a b c -> isZero b && isZero c) :- ("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)) :- ("convolution via translation",- simple $ \x y ->- G.convolve x y- == G.convolveByTranslation x y) :- ("convolution via fourier",- simple $ \x y ->- G.convolve x y- == G.convolveByFourier x y) :- ("fourier by translation",- simple $ \x -> G.fourier x == G.fourierByTranslation x) :- ("fourier reverse",- simple $ \x -> nest 2 G.fourier x == G.reverse x) :- ("reverse identity",- simple $ \x -> nest 2 G.reverse x == x) :- ("fourier unit",- quickCheck $ G.fourier G.unit == (G.unit :: 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))) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Gaussian.Bell:108: "+{-# LINE 108 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 108 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (Laws.identity G.multiply G.constant . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:109: "+{-# LINE 109 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 109 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (Laws.commutative G.multiply . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:110: "+{-# LINE 110 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 110 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (Laws.associative G.multiply . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:152: "+{-# LINE 152 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 152 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (Laws.commutative G.convolve . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:153: "+{-# LINE 153 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 153 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (Laws.associative G.convolve . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:161: "+{-# LINE 161 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 161 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (isConstant . G.convolve G.constant . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Bell:149: "+{-# LINE 149 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.example+{-# LINE 149 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (let x=G.Cons 2 (1+:3) (4+:5) (7::Rational); y=G.Cons 7 (1+:4) (3+:2) (5::Rational) in G.convolve x y)+ [ExpectedLine [LineChunk "Cons {amp = 7 % 6, c0 = 13 % 6 +: 55 % 8, c1 = 41 % 12 +: 13 % 4, c2 = 35 % 12}"]]+ DocTest.printPrefix "MathObj.Gaussian.Bell:200: "+{-# LINE 200 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 200 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x y -> G.convolve x y == G.convolveByTranslation x y)+ DocTest.printPrefix "MathObj.Gaussian.Bell:217: "+{-# LINE 217 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 217 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x y -> G.convolve x y == G.convolveByFourier x y)+ DocTest.printPrefix "MathObj.Gaussian.Bell:225: "+{-# LINE 225 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 225 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y))+ DocTest.printPrefix "MathObj.Gaussian.Bell:226: "+{-# LINE 226 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 226 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x -> nest 2 G.fourier x == G.reverse x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:227: "+{-# LINE 227 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 227 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (G.fourier G.unit == (asRational G.unit))+ DocTest.printPrefix "MathObj.Gaussian.Bell:228: "+{-# LINE 228 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 228 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a -> G.fourier (G.translate a x) == G.modulate a (G.fourier x))+ DocTest.printPrefix "MathObj.Gaussian.Bell:229: "+{-# LINE 229 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 229 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x)))+ DocTest.printPrefix "MathObj.Gaussian.Bell:244: "+{-# LINE 244 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 244 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x -> G.fourier x == G.fourierByTranslation x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:312: "+{-# LINE 312 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 312 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a b -> G.translate a (G.translate b x) == G.translate (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:326: "+{-# LINE 326 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 326 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a b -> G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:327: "+{-# LINE 327 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 327 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a -> G.translateComplex (Complex.fromReal a) x == G.translate a x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:341: "+{-# LINE 341 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 341 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a b -> G.modulate a (G.modulate b x) == G.modulate (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:342: "+{-# LINE 342 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 342 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x a b -> G.modulate b (G.translate a x) == G.turn (a*b) (G.translate a (G.modulate b x)))+ DocTest.printPrefix "MathObj.Gaussian.Bell:361: "+{-# LINE 361 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 361 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x -> nest 2 G.reverse x == x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:369: "+{-# LINE 369 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 369 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:370: "+{-# LINE 370 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 370 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:381: "+{-# LINE 381 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 381 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x)+ DocTest.printPrefix "MathObj.Gaussian.Bell:382: "+{-# LINE 382 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ DocTest.property+{-# LINE 382 "gaussian/MathObj/Gaussian/Bell.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x)
+ test/Test/MathObj/Gaussian/ExponentTuple.hs view
@@ -0,0 +1,26 @@+-- Do not edit! Automatically created with doctest-extract from gaussian/MathObj/Gaussian/ExponentTuple.hs+{-# LINE 14 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}++module Test.MathObj.Gaussian.ExponentTuple where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 15 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}+import MathObj.Gaussian.ExponentTuple (HoelderConjugates(HoelderConjugates))+import MathObj.Gaussian.ExponentTuple (YoungConjugates(YoungConjugates))+import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+import Prelude ()++test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Gaussian.ExponentTuple:26: "+{-# LINE 26 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}+ DocTest.property+{-# LINE 26 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}+ (\(HoelderConjugates p q) -> p>=1 && q>=1 && 1/p + 1/q == 1)+ DocTest.printPrefix "MathObj.Gaussian.ExponentTuple:53: "+{-# LINE 53 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}+ DocTest.property+{-# LINE 53 "gaussian/MathObj/Gaussian/ExponentTuple.hs" #-}+ (\(YoungConjugates p q r) -> p>=1 && q>=1 && r>=1 && 1/p + 1/q == 1/r + 1)
test/Test/MathObj/Gaussian/Polynomial.hs view
@@ -1,165 +1,215 @@-{-# 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+-- Do not edit! Automatically created with doctest-extract from gaussian/MathObj/Gaussian/Polynomial.hs+{-# LINE 60 "gaussian/MathObj/Gaussian/Polynomial.hs" #-} -import qualified Number.NonNegative as NonNeg-import Data.Function.HT (nest, )-import Data.Tuple.HT (mapSnd, )+{-# OPTIONS_GHC -XRebindableSyntax #-} --- import Debug.Trace (trace, )+module Test.MathObj.Gaussian.Polynomial where -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest +{-# LINE 63 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+import qualified MathObj.Gaussian.Polynomial as G+import qualified MathObj.Gaussian.Bell as Bell+import qualified MathObj.Polynomial as Poly+import qualified Algebra.Laws as Laws+import qualified Number.Complex as Complex+import Number.Complex ((+:))+import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+import qualified Test.QuickCheck as QC+import Data.Function.HT (Id, nest)+import Data.Tuple.HT (mapSnd) -simple ::- (Testable t) =>- (G.T Rational -> t) -> IO ()-simple f =- quickCheck (\x -> f (x :: G.T Rational))+asRational :: Id (G.T Rational)+asRational = id -tests :: HUnit.Test-tests =- HUnit.TestLabel "polynomial" $- HUnit.TestList $- map testUnit $- testList+withRational :: Id (G.T Rational -> a)+withRational = id -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) :-{-- ("convolution by differentiation vs. fourier",- simple $ \x y ->- G.convolveByDifferentiation x y- == G.convolveByFourier x y) :--}- ("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)) :- ("differentiate integrate",- simple $ \x@(G.Cons b p) ->- let (xoff,xint) = G.integrate x- in G.differentiate xint == G.Cons b (p + Poly.const xoff)) :- ("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}) :- ("differentiate convolve",- simple $ \x y ->- G.convolve (G.differentiate x) y ==- G.convolve x (G.differentiate 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) :- []+mulLinear2i :: Id (G.T Rational)+mulLinear2i x =+ x{G.polynomial = Poly.fromCoeffs [0, 0+:2] * G.polynomial x} -{--inequalities:+rotateQuarter :: Int -> Id (G.T Rational)+rotateQuarter n =+ G.scaleComplex (negate Complex.imaginaryUnit ^ fromIntegral n) -Heisenberg's uncertainty relation- needs integrals and thus needs product of exponential numbers and roots--}+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:185: "+{-# LINE 185 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 185 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (QC.forAll (QC.choose (0,3)) $ \n -> G.eigenfunctionDifferential n == asRational (G.eigenfunctionIterative n))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:193: "+{-# LINE 193 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 193 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (G.eigenfunction0 == asRational (G.eigenfunctionDifferential 0))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:198: "+{-# LINE 198 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 198 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (G.eigenfunction1 == asRational (G.eigenfunctionDifferential 1))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:203: "+{-# LINE 203 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 203 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (G.eigenfunction2 == asRational (G.eigenfunctionDifferential 2))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:208: "+{-# LINE 208 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 208 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (G.eigenfunction3 == asRational (G.eigenfunctionDifferential 3))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:215: "+{-# LINE 215 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 215 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (QC.forAll (QC.choose (0,15)) $ \n -> let x = G.eigenfunctionDifferential n in G.fourier x == rotateQuarter n x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:224: "+{-# LINE 224 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 224 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (QC.forAll (QC.choose (0,15)) $ \n -> let x = G.eigenfunctionIterative n in G.fourier x == rotateQuarter n x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:246: "+{-# LINE 246 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 246 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ Laws.identity G.multiply G.constant)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:247: "+{-# LINE 247 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 247 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ Laws.commutative G.multiply)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:248: "+{-# LINE 248 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 248 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ Laws.associative G.multiply)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:258: "+{-# LINE 258 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 258 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ Laws.commutative G.convolve)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:259: "+{-# LINE 259 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 259 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ Laws.associative G.convolve)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:301: "+{-# LINE 301 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 301 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:302: "+{-# LINE 302 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 302 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x -> nest 2 G.fourier x == G.reverse x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:303: "+{-# LINE 303 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 303 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a -> G.fourier (G.translate a x) == G.modulate a (G.fourier x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:304: "+{-# LINE 304 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 304 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x)))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:305: "+{-# LINE 305 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 305 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x -> G.fourier (G.differentiate x) == mulLinear2i (G.fourier x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:323: "+{-# LINE 323 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 323 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x y -> G.convolve (G.differentiate x) y == G.convolve x (G.differentiate y))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:348: "+{-# LINE 348 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 348 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x -> G.integrate (G.differentiate x) == (zero, x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:349: "+{-# LINE 349 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 349 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x@(G.Cons b p) -> let (xoff,xint) = G.integrate x in G.differentiate xint == G.Cons b (p + Poly.const xoff))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:345: "+{-# LINE 345 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.example+{-# LINE 345 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (snd $ G.integrate $ G.differentiate $ G.Cons Bell.unit (Poly.fromCoeffs [7,7,7,7 :: Complex.T Rational]))+ [ExpectedLine [LineChunk "Cons {bell = Cons {amp = 1 % 1, c0 = 0 % 1 +: 0 % 1, c1 = 0 % 1 +: 0 % 1, c2 = 1 % 1}, polynomial = Polynomial.fromCoeffs [7 % 1 +: 0 % 1,7 % 1 +: 0 % 1,7 % 1 +: 0 % 1,7 % 1 +: 0 % 1]}"]]+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:409: "+{-# LINE 409 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 409 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a b -> G.translate a (G.translate b x) == G.translate (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:416: "+{-# LINE 416 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 416 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a b -> G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:417: "+{-# LINE 417 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 417 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a -> G.translateComplex (Complex.fromReal a) x == G.translate a x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:426: "+{-# LINE 426 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 426 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a b -> G.modulate a (G.modulate b x) == G.modulate (a+b) x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:427: "+{-# LINE 427 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 427 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x a b -> G.modulate b (G.translate a x) == G.turn (a*b) (G.translate a (G.modulate b x)))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:442: "+{-# LINE 442 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 442 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x -> nest 2 G.reverse x == x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:451: "+{-# LINE 451 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 451 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:452: "+{-# LINE 452 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 452 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:461: "+{-# LINE 461 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 461 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:462: "+{-# LINE 462 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 462 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x)+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:490: "+{-# LINE 490 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 490 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.NonZero unit) d -> G.approximateByBells unit (G.translateComplex d x) == map (mapSnd (Bell.translateComplex d)) (G.approximateByBells unit x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:491: "+{-# LINE 491 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 491 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.NonZero unit) (QC.NonZero d) -> G.approximateByBells unit (G.dilate d x) == map (mapSnd (Bell.dilate d)) (G.approximateByBells (unit/d) x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:492: "+{-# LINE 492 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 492 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (withRational $ \x (QC.NonZero unit) (QC.NonZero d) -> G.approximateByBells unit (G.shrink d x) == map (mapSnd (Bell.shrink d)) (G.approximateByBells (unit*d) x))+ DocTest.printPrefix "MathObj.Gaussian.Polynomial:512: "+{-# LINE 512 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ DocTest.property+{-# LINE 512 "gaussian/MathObj/Gaussian/Polynomial.hs" #-}+ (\(QC.NonZero unit) d s p0 -> let p = Poly.fromCoeffs $ take 10 p0 in G.approximateByBellsAtOnce unit d s p == G.approximateByBellsByTranslation unit d (s::Rational) p)
test/Test/MathObj/Gaussian/Variance.hs view
@@ -1,227 +1,142 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.MathObj.Gaussian.Variance where--import qualified MathObj.Gaussian.Variance as G-import qualified Number.Root as Root---- import qualified Algebra.Ring as Ring--import qualified Algebra.Laws as Laws--import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Testable, quickCheck, (==>), Arbitrary, arbitrary, )-import qualified Test.HUnit as HUnit--import Control.Monad (liftM2, liftM3, )--import Data.Function.HT (nest, compose2, )--import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP---newtype PositiveInteger = PositiveInteger Integer- deriving Show--instance Arbitrary PositiveInteger where- arbitrary =- fmap (\p -> PositiveInteger $ 1 + abs p) arbitrary---{- |-For @(HoelderConjugates p q)@ it holds--> 1/p + 1/q = 1--}-data HoelderConjugates = HoelderConjugates Rational Rational- deriving Show--{--instance Arbitrary HoelderConjugates where- arbitrary = liftM2- (\(PositiveInteger p) (PositiveInteger q) ->- let s = 1%p + 1%q- in HoelderConjugates (fromInteger p * s) (fromInteger q * s))- arbitrary arbitrary--}-instance Arbitrary HoelderConjugates where- arbitrary = liftM2- (\(PositiveInteger p) (PositiveInteger q) ->- let s = p + q- in HoelderConjugates (s % p) (s % q))- arbitrary arbitrary--{- |-For @(YoungConjugates p q r)@ it holds--> 1/p + 1/q = 1/r + 1--}-data YoungConjugates = YoungConjugates Rational Rational Rational- deriving Show--{--Find positive natural numbers @a, b, c, d@ with--> a + b = c + d--and--> d >= a, d >= b, d >= c--then set--> p=d/a, q=d/b, r=d/c---a+b<=c-b+c<=a--> 2b <= 0--}-instance Arbitrary YoungConjugates where- arbitrary = liftM3- (\(PositiveInteger a0) (PositiveInteger b0) (PositiveInteger c0) ->- let guardSwap cond (x,y) =- if cond x y then (x,y) else (y,x)- {-- If a+b<=c, then from b>0 it follows a<c and thus c+b>a.- Swapping a and c is enough and we have not to consider more cases.- -}- (a1,c1) = guardSwap (\a c -> a+b0>c) (a0,c0)- b1 = b0- d1 = a1+b1-c1- ((a2,b2),(c2,d2)) =- guardSwap (compose2 (<=) snd)- (guardSwap (<=) (a1,b1),- guardSwap (<=) (c1,d1))- in YoungConjugates (d2%a2) (d2%b2) (d2%c2))- arbitrary arbitrary arbitrary--{--This is simpler, but may yield exponents smaller than 1.--instance Arbitrary YoungConjugates where- arbitrary = liftM3- (\(PositiveInteger a0) (PositiveInteger b0) (PositiveInteger c0) ->- let {-- If a+b<=c, then from b>0 it follows a<c and thus c+b>a.- Swapping a and c is enough and we have not to consider more cases.- -}- (a1,c1) = if a0+b0<=c0 then (c0,a0) else (a0,c0)- b1 = b0- d1 = a1+b1-c1- in YoungConjugates (d1%a1) (d1%b1) (d1%c1))- arbitrary arbitrary arbitrary--}+-- Do not edit! Automatically created with doctest-extract from gaussian/MathObj/Gaussian/Variance.hs+{-# LINE 34 "gaussian/MathObj/Gaussian/Variance.hs" #-} +module Test.MathObj.Gaussian.Variance where -simple ::- (Testable t) =>- (G.T Rational -> t) -> IO ()-simple f =- quickCheck (\x -> f (x :: G.T Rational))+import qualified Test.DocTest.Driver as DocTest -tests :: HUnit.Test-tests =- HUnit.TestLabel "variance" $- HUnit.TestList $- map testUnit $- testList+{-# LINE 35 "gaussian/MathObj/Gaussian/Variance.hs" #-}+import qualified MathObj.Gaussian.Variance as G+import MathObj.Gaussian.ExponentTuple (HoelderConjugates(HoelderConjugates))+import MathObj.Gaussian.ExponentTuple (YoungConjugates(YoungConjugates))+import qualified Algebra.Laws as Laws+import qualified Number.Root as Root+import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+import Prelude ()+import qualified Test.QuickCheck as QC+import Data.Function.HT (Id, nest) -testList :: [(String, IO ())]-testList =-{-- ("convolution, dirac",- simple $ Laws.identity (+) zero) :--}- ("convolution, commutative",- simple $ Laws.commutative G.convolve) :- ("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 via fourier",- simple $ \x y ->- G.fourier (G.convolve x y)- == G.multiply (G.fourier x) (G.fourier y)) :- ("fourier identity",- simple $ \x -> nest 4 G.fourier x == 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))) :- ("fourier, unitary",- simple $ \x y ->- G.scalarProductRoot x y- == G.scalarProductRoot (G.fourier x) (G.fourier y)) :- ("norm1 vs. normP 1",- simple $ \x -> G.norm1Root x == G.normPRoot 1 x) :- ("norm2 vs. normP 2",- simple $ \x -> G.norm2Root x == G.normPRoot 2 x) :-{--I would have liked to test for a monotony of norms.-Unfortunately, it does not hold.+asRational :: Id (G.T Rational)+asRational = id -Means contain a division by the size of the domain.-Norms do not have this division.-Means are monotonic with respect to the degree.-Norms are not.-We cannot turn the norms into means since the size of the domain-(the complete real axis) is infinitely large.- ("norm monotony",- simple $ \x p0 q0 ->- let p = 1 + abs p0- q = 1 + abs q0- in case compare p q of- EQ -> G.normPRoot p x == G.normPRoot q x- LT -> G.normPRoot p x <= G.normPRoot q x- GT -> G.normPRoot p x >= G.normPRoot q x) :+withRational :: Id (G.T Rational -> a)+withRational = id -This should also fail,-but QuickCheck does not seem to try counterexamples.- ("infinity norm upper bound",- simple $ \x p0 ->- let p = 1 + abs p0- in G.normPRoot p x <= G.normInfRoot x) :--}- ("Cauchy-Schwarz inequality",- simple $ \x y ->- G.scalarProductRoot x y- <= G.norm2Root x `Root.mul` G.norm2Root y) :- ("Hoelder conjugates",- quickCheck $ \(HoelderConjugates p q) ->- p>=1 && q>=1 && 1/p + 1/q == 1) :- ("Hoelder inequality with infinity norm",- simple $ \x y ->- G.scalarProductRoot x y- <= G.norm1Root x `Root.mul` G.normInfRoot y) :- ("Hoelder inequality",- simple $ \x y (HoelderConjugates p q) ->- G.scalarProductRoot x y- <= G.normPRoot p x `Root.mul` G.normPRoot q y) :- ("Young inequality with two infinity norms",- simple $ \x y ->- G.normInfRoot (G.convolve x y)- <= G.norm1Root x `Root.mul` G.normInfRoot y) :- ("Young inequality with infinity norm",- simple $ \x y (HoelderConjugates p q) ->- G.normInfRoot (G.convolve x y)- <= G.normPRoot p x `Root.mul` G.normPRoot q y) :- ("Young conjugates",- quickCheck $ \(YoungConjugates p q r) ->- p>=1 && q>=1 && r>=1 && 1/p + 1/q == 1/r + 1) :- ("Young inequality",- simple $ \x y (YoungConjugates p q r) ->- G.normPRoot r (G.convolve x y)- <= G.normPRoot p x `Root.mul` G.normPRoot q y) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Gaussian.Variance:95: "+{-# LINE 95 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 95 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.scalarProductRoot x y <= G.norm2Root x `Root.mul` G.norm2Root y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:99: "+{-# LINE 99 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 99 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.scalarProductRoot x y <= G.norm1Root x `Root.mul` G.normInfRoot y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:100: "+{-# LINE 100 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 100 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y (HoelderConjugates p q) -> G.scalarProductRoot x y <= G.normPRoot p x `Root.mul` G.normPRoot q y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:108: "+{-# LINE 108 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 108 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x -> G.norm1Root x == G.normPRoot 1 x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:114: "+{-# LINE 114 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 114 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x -> G.norm2Root x == G.normPRoot 2 x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:186: "+{-# LINE 186 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 186 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.varianceRational (G.dilate a x) == a^2 * G.varianceRational x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:187: "+{-# LINE 187 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 187 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.varianceRational (G.convolve x y) == G.varianceRational x + G.varianceRational y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:193: "+{-# LINE 193 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 193 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (Laws.identity G.multiply G.constant . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Variance:194: "+{-# LINE 194 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 194 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (Laws.commutative G.multiply . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Variance:195: "+{-# LINE 195 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 195 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (Laws.associative G.multiply . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Variance:228: "+{-# LINE 228 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 228 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (Laws.commutative G.convolve . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Variance:229: "+{-# LINE 229 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 229 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (Laws.associative G.convolve . asRational)+ DocTest.printPrefix "MathObj.Gaussian.Variance:233: "+{-# LINE 233 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 233 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.normInfRoot (G.convolve x y) <= G.norm1Root x `Root.mul` G.normInfRoot y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:234: "+{-# LINE 234 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 234 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y (HoelderConjugates p q) -> G.normInfRoot (G.convolve x y) <= G.normPRoot p x `Root.mul` G.normPRoot q y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:235: "+{-# LINE 235 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 235 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y (YoungConjugates p q r) -> G.normPRoot r (G.convolve x y) <= G.normPRoot p x `Root.mul` G.normPRoot q y)+ DocTest.printPrefix "MathObj.Gaussian.Variance:251: "+{-# LINE 251 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 251 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.fourier (G.convolve x y) == G.multiply (G.fourier x) (G.fourier y))+ DocTest.printPrefix "MathObj.Gaussian.Variance:252: "+{-# LINE 252 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 252 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x -> nest 4 G.fourier x == x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:253: "+{-# LINE 253 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 253 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x)))+ DocTest.printPrefix "MathObj.Gaussian.Variance:254: "+{-# LINE 254 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 254 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x y -> G.scalarProductRoot x y == G.scalarProductRoot (G.fourier x) (G.fourier y))+ DocTest.printPrefix "MathObj.Gaussian.Variance:265: "+{-# LINE 265 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 265 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) (QC.Positive b) -> G.dilate a (G.dilate b x) == G.dilate (a*b) x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:266: "+{-# LINE 266 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 266 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a x == G.dilate (recip a) x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:273: "+{-# LINE 273 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 273 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.dilate a (G.shrink a x) == x)+ DocTest.printPrefix "MathObj.Gaussian.Variance:274: "+{-# LINE 274 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ DocTest.property+{-# LINE 274 "gaussian/MathObj/Gaussian/Variance.hs" #-}+ (withRational $ \x (QC.Positive a) -> G.shrink a (G.dilate a x) == x)
test/Test/MathObj/Matrix.hs view
@@ -1,107 +1,122 @@-{-# 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 System.Random as Random+-- Do not edit! Automatically created with doctest-extract from src/MathObj/Matrix.hs+{-# LINE 71 "src/MathObj/Matrix.hs" #-} -import Data.Function.HT (nest, )+module Test.MathObj.Matrix where -import Test.NumericPrelude.Utility (testUnit, )-import Test.QuickCheck (Arbitrary(arbitrary), quickCheck, )-import qualified Test.QuickCheck as QC-import qualified Test.HUnit as HUnit+import qualified Test.DocTest.Driver as DocTest +{-# LINE 72 "src/MathObj/Matrix.hs" #-}+import qualified MathObj.Matrix as Matrix+import qualified Algebra.Ring as Ring+import qualified Algebra.Laws as Laws+import Test.NumericPrelude.Utility ((/\))+import qualified Test.QuickCheck as QC+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude () -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+import Control.Monad (replicateM, join)+import Control.Applicative (liftA2)+import Data.Function.HT (nest) +genDimension :: QC.Gen Int+genDimension = QC.choose (0,20) -type Seed = Int-newtype Dimension = Dimension {unDim :: Int}- deriving (Show)+genMatrixFor :: (QC.Arbitrary a) => Int -> Int -> QC.Gen (Matrix.T a)+genMatrixFor m n =+ fmap (Matrix.fromList m n) $ replicateM (m*n) QC.arbitrary -instance Arbitrary Dimension where- arbitrary = fmap Dimension $ QC.choose (0,20)+genMatrix :: (QC.Arbitrary a) => QC.Gen (Matrix.T a)+genMatrix = join $ liftA2 genMatrixFor genDimension genDimension +genIntMatrix :: QC.Gen (Matrix.T Integer)+genIntMatrix = genMatrix -random :: Dimension -> Dimension -> Seed -> Matrix.T Integer-random mn nn seed =- fst $- Matrix.random (unDim mn) (unDim nn) $- Random.mkStdGen seed+genFactorMatrix :: (QC.Arbitrary a) => Matrix.T a -> QC.Gen (Matrix.T a)+genFactorMatrix a = genMatrixFor (Matrix.numColumns a) =<< genDimension +genSameMatrix :: (QC.Arbitrary a) => Matrix.T a -> QC.Gen (Matrix.T a)+genSameMatrix = uncurry genMatrixFor . Matrix.dimension -tests :: HUnit.Test-tests =- HUnit.TestLabel "matrix" $- HUnit.TestList $- map testUnit $- ("dimension",- quickCheck (\m n a ->- (unDim m, unDim 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 (unDim m) (unDim n) (Matrix.rows a))) :- ("to and from columns",- quickCheck (\m n a' ->- let a = random m n a'- in a == Matrix.fromColumns (unDim m) (unDim 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 (unDim m) (unDim 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 = unDim 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 (unDim m)) (random m n a))) :- ("multiplication, one right",- quickCheck (\m n a ->- Laws.rightIdentity (*) (Matrix.one (unDim 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))) :- ("multiplication vs. power",- quickCheck (\m a n0 ->- let x = random m m a- n = mod n0 10- in x^n == nest (fromInteger n) (x*) (Matrix.one (unDim m)))) :-{-- ("division", quickCheck (\x -> Integral.propInverse (x :: Poly.T Rational))) :--}- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Matrix:118: "+{-# LINE 118 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 118 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> Matrix.rows a == Matrix.columns (Matrix.transpose a))+ DocTest.printPrefix "MathObj.Matrix:119: "+{-# LINE 119 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 119 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> Matrix.columns a == Matrix.rows (Matrix.transpose a))+ DocTest.printPrefix "MathObj.Matrix:120: "+{-# LINE 120 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 120 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genSameMatrix a /\ \b -> Laws.homomorphism Matrix.transpose (+) (+) a b)+ DocTest.printPrefix "MathObj.Matrix:141: "+{-# LINE 141 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 141 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> a == uncurry Matrix.fromRows (Matrix.dimension a) (Matrix.rows a))+ DocTest.printPrefix "MathObj.Matrix:152: "+{-# LINE 152 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 152 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> a == uncurry Matrix.fromColumns (Matrix.dimension a) (Matrix.columns a))+ DocTest.printPrefix "MathObj.Matrix:195: "+{-# LINE 195 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 195 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genSameMatrix a /\ \b -> Laws.commutative (+) a b)+ DocTest.printPrefix "MathObj.Matrix:196: "+{-# LINE 196 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 196 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genSameMatrix a /\ \b -> genSameMatrix b /\ \c -> Laws.associative (+) a b c)+ DocTest.printPrefix "MathObj.Matrix:212: "+{-# LINE 212 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 212 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> Laws.identity (+) (uncurry Matrix.zero $ Matrix.dimension a) a)+ DocTest.printPrefix "MathObj.Matrix:228: "+{-# LINE 228 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 228 "src/MathObj/Matrix.hs" #-}+ (genDimension /\ \n -> Matrix.one n == Matrix.diagonal (replicate n Ring.one :: [Integer]))+ DocTest.printPrefix "MathObj.Matrix:242: "+{-# LINE 242 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 242 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> Laws.leftIdentity (*) (Matrix.one (Matrix.numRows a)) a)+ DocTest.printPrefix "MathObj.Matrix:243: "+{-# LINE 243 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 243 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> Laws.rightIdentity (*) (Matrix.one (Matrix.numColumns a)) a)+ DocTest.printPrefix "MathObj.Matrix:244: "+{-# LINE 244 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 244 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> Laws.homomorphism Matrix.transpose (*) (flip (*)) a b)+ DocTest.printPrefix "MathObj.Matrix:245: "+{-# LINE 245 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 245 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> genFactorMatrix b /\ \c -> Laws.associative (*) a b c)+ DocTest.printPrefix "MathObj.Matrix:246: "+{-# LINE 246 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 246 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \b -> genSameMatrix b /\ \c -> genFactorMatrix b /\ \a -> Laws.leftDistributive (*) (+) a b c)+ DocTest.printPrefix "MathObj.Matrix:247: "+{-# LINE 247 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 247 "src/MathObj/Matrix.hs" #-}+ (genIntMatrix /\ \a -> genFactorMatrix a /\ \b -> genSameMatrix b /\ \c -> Laws.rightDistributive (*) (+) a b c)+ DocTest.printPrefix "MathObj.Matrix:248: "+{-# LINE 248 "src/MathObj/Matrix.hs" #-}+ DocTest.property+{-# LINE 248 "src/MathObj/Matrix.hs" #-}+ (QC.choose (0,10) /\ \k -> genDimension /\ \n -> genMatrixFor n n /\ \a -> a^k == nest (fromInteger k) ((a::Matrix.T Integer)*) (Matrix.one n))
test/Test/MathObj/PartialFraction.hs view
@@ -1,206 +1,137 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.MathObj.PartialFraction where--import qualified MathObj.PartialFraction as PartialFraction-import qualified MathObj.Polynomial as Poly-import qualified Number.Ratio as Ratio--import qualified Algebra.PrincipalIdealDomain as PID--- import qualified Algebra.Ring as Ring-import qualified Algebra.Indexable as Indexable-import qualified Algebra.Vector as Vector--- import Algebra.Vector((*>))--import qualified Algebra.Laws as Laws-import qualified Test.QuickCheck as QC--import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (quickCheck)-import qualified Test.HUnit as HUnit---import qualified Control.Monad.HT as M--import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP---{- * Properties for generic types -}--fractionConv :: (PID.C a, Indexable.C a) => [a] -> a -> Bool-fractionConv xs y =- PartialFraction.toFraction (PartialFraction.fromFactoredFraction xs y) ==- y % product xs--fractionConvAlt :: (PID.C a, Indexable.C a) => [a] -> a -> Bool-fractionConvAlt xs y =- PartialFraction.fromFactoredFraction xs y ==- PartialFraction.fromFactoredFractionAlt xs y--scaleInt :: (PID.C a, Indexable.C a) => a -> PartialFraction.T a -> Bool-scaleInt k a =- PartialFraction.toFraction (PartialFraction.scaleInt k a) ==- Ratio.scale k (PartialFraction.toFraction a)--add :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool-add = Laws.homomorphism PartialFraction.toFraction (+) (+)--sub :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool-sub = Laws.homomorphism PartialFraction.toFraction (-) (-)--mul :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool-mul = Laws.homomorphism PartialFraction.toFraction (*) (*)----{- * Properties for Integers -}--{- |-Arbitrary instance of that type generates irreducible elements for tests.-Choosing from a list of examples is a simple yet effective design.-If we would construct irreducible elements by a clever algorithm-we might obtain multiple primes only rarely.--}-newtype SmallPrime = SmallPrime {intFromSmallPrime :: Integer}--type IntFraction = ([SmallPrime],Integer)--instance QC.Arbitrary SmallPrime where- arbitrary =- let primes = [2,3,5,7,11,13]- in fmap SmallPrime $ QC.elements (primes ++ map negate primes)--instance Show SmallPrime where- show = show . intFromSmallPrime---fractionConvInt :: [SmallPrime] -> Integer -> Bool-fractionConvInt =- fractionConv . map intFromSmallPrime--fractionConvAltInt :: [SmallPrime] -> Integer -> Bool-fractionConvAltInt =- fractionConvAlt . map intFromSmallPrime--fromSmallPrimes :: IntFraction -> PartialFraction.T Integer-fromSmallPrimes (xs,y) =- PartialFraction.fromFactoredFraction (map intFromSmallPrime xs) y---scaleIntInt :: Integer -> IntFraction -> Bool-scaleIntInt k a =- scaleInt k (fromSmallPrimes a)--addInt :: IntFraction -> IntFraction -> Bool-addInt q0 q1 =- add- (fromSmallPrimes q0)- (fromSmallPrimes q1)--subInt :: IntFraction -> IntFraction -> Bool-subInt q0 q1 =- sub- (fromSmallPrimes q0)- (fromSmallPrimes q1)--mulInt :: IntFraction -> IntFraction -> Bool-mulInt q0 q1 =- mul- (fromSmallPrimes q0)- (fromSmallPrimes q1)---intTests :: HUnit.Test-intTests =- HUnit.TestLabel "integer" $- HUnit.TestList $- map testUnit $- ("conversion between partial and ordinary fraction", quickCheck fractionConvInt) :- ("two conversion routines from factored fractions", quickCheck fractionConvAltInt) :- ("integer scaling", quickCheck scaleIntInt) :- ("addition", quickCheck addInt) :- ("subtraction", quickCheck subInt) :- ("multiplication", quickCheck mulInt) :- []+-- Do not edit! Automatically created with doctest-extract from src/MathObj/PartialFraction.hs+{-# LINE 45 "src/MathObj/PartialFraction.hs" #-} +module Test.MathObj.PartialFraction where -{- * Properties for Polynomials -}+import qualified Test.DocTest.Driver as DocTest -newtype IrredPoly = IrredPoly {polyFromIrredPoly :: Poly.T Rational}+{-# LINE 46 "src/MathObj/PartialFraction.hs" #-}+import qualified MathObj.PartialFraction as PartialFraction+import qualified MathObj.Polynomial.Core as PolyCore+import qualified MathObj.Polynomial as Poly+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Indexable as Indexable+import qualified Algebra.Laws as Laws+import qualified Number.Ratio as Ratio+import Test.NumericPrelude.Utility ((/\))+import qualified Test.QuickCheck as QC+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude () -type RatPolynomial = Poly.T Rational-type PolyFraction = ([IrredPoly],RatPolynomial)+import Control.Applicative (liftA2) -instance QC.Arbitrary IrredPoly where- arbitrary =- do poly <- QC.elements (map Poly.fromCoeffs [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]])- unit <- M.until (not. isZero) QC.arbitrary- return (IrredPoly (unit Vector.*> poly))+{- |+Generator of irreducible elements for tests.+Choosing from a list of examples is a simple yet effective design.+If we would construct irreducible elements by a clever algorithm+we might obtain multiple primes only rarely.+-} --+genSmallPrime :: QC.Gen Integer+genSmallPrime =+ let primes = [2,3,5,7,11,13]+ in QC.elements (primes ++ map negate primes) -instance Show IrredPoly where- show = show . polyFromIrredPoly+genPartialFractionInt :: QC.Gen (PartialFraction.T Integer)+genPartialFractionInt =+ liftA2 PartialFraction.fromFactoredFraction+ (QC.listOf genSmallPrime) QC.arbitrary -fractionConvPoly :: [IrredPoly] -> RatPolynomial -> Bool-fractionConvPoly =- fractionConv . map polyFromIrredPoly--fractionConvAltPoly :: [IrredPoly] -> RatPolynomial -> Bool-fractionConvAltPoly =- fractionConvAlt . map polyFromIrredPoly+genIrreduciblePolynomial :: QC.Gen (Poly.T Rational)+genIrreduciblePolynomial = do+ QC.NonZero unit <- QC.arbitrary+ fmap (Poly.fromCoeffs . map (unit*)) $+ QC.elements [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]] -fromIrredPolys :: PolyFraction -> PartialFraction.T RatPolynomial-fromIrredPolys (xs,y) =- PartialFraction.fromFactoredFraction (map polyFromIrredPoly xs) y+genPartialFractionPoly :: QC.Gen (PartialFraction.T (Poly.T Rational))+genPartialFractionPoly =+ liftA2 PartialFraction.fromFactoredFraction+ (fmap (take 3) $ QC.listOf genIrreduciblePolynomial)+ (fmap (Poly.fromCoeffs . PolyCore.normalize . take 5) QC.arbitrary) -scaleIntPoly :: RatPolynomial -> PolyFraction -> Bool-scaleIntPoly k a =- scaleInt k (fromIrredPolys a)--addPoly :: PolyFraction -> PolyFraction -> Bool-addPoly q0 q1 =- add- (fromIrredPolys q0)- (fromIrredPolys q1)--subPoly :: PolyFraction -> PolyFraction -> Bool-subPoly q0 q1 =- sub- (fromIrredPolys q0)- (fromIrredPolys q1)--mulPoly :: PolyFraction -> PolyFraction -> Bool-mulPoly q0 q1 =- mul- (fromIrredPolys q0)- (fromIrredPolys q1)-+fractionConv :: (PID.C a, Indexable.C a) => [a] -> a -> Bool+fractionConv xs y =+ PartialFraction.toFraction (PartialFraction.fromFactoredFraction xs y) ==+ y % product xs +fractionConvAlt :: (PID.C a, Indexable.C a) => [a] -> a -> Bool+fractionConvAlt xs y =+ PartialFraction.fromFactoredFraction xs y ==+ PartialFraction.fromFactoredFractionAlt xs y -polyTests :: HUnit.Test-polyTests =- HUnit.TestLabel "polynomial" $- HUnit.TestList $- map testUnit $-{- this test fails, because addition may result in leading zero coefficients,- that is, polynomial addition does not contain a normalization- if it would contain one, we would exclude computable reals -}--- wrong ("conversion between partial and ordinary fraction", quickCheck fractionConvPoly) :--- wrong ("two conversion routines from factored fractions", quickCheck fractionConvAltPoly) :--- too slow ("integer scaling", quickCheck scaleIntPoly) :--- too slow ("addition", quickCheck addPoly) :--- too slow ("subtraction", quickCheck subPoly) :--- too slow ("multiplication", quickCheck mulPoly) :- []+scaleInt :: (PID.C a, Indexable.C a) => a -> PartialFraction.T a -> Bool+scaleInt k a =+ PartialFraction.toFraction (PartialFraction.scaleInt k a) ==+ Ratio.scale k (PartialFraction.toFraction a) +add, sub, mul ::+ (PID.C a, Indexable.C a) =>+ PartialFraction.T a -> PartialFraction.T a -> Bool+add = Laws.homomorphism PartialFraction.toFraction (+) (+)+sub = Laws.homomorphism PartialFraction.toFraction (-) (-)+mul = Laws.homomorphism PartialFraction.toFraction (*) (*) -tests :: HUnit.Test-tests =- HUnit.TestLabel "partial fraction" $- HUnit.TestList $- intTests :--- polyTests :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.PartialFraction:195: "+{-# LINE 195 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 195 "src/MathObj/PartialFraction.hs" #-}+ (QC.listOf genSmallPrime /\ fractionConv)+ DocTest.printPrefix "MathObj.PartialFraction:196: "+{-# LINE 196 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 196 "src/MathObj/PartialFraction.hs" #-}+ (fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConv)+ DocTest.printPrefix "MathObj.PartialFraction:220: "+{-# LINE 220 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 220 "src/MathObj/PartialFraction.hs" #-}+ (QC.listOf genSmallPrime /\ fractionConvAlt)+ DocTest.printPrefix "MathObj.PartialFraction:221: "+{-# LINE 221 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 221 "src/MathObj/PartialFraction.hs" #-}+ (fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConvAlt)+ DocTest.printPrefix "MathObj.PartialFraction:297: "+{-# LINE 297 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 297 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> add x y)+ DocTest.printPrefix "MathObj.PartialFraction:298: "+{-# LINE 298 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 298 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> sub x y)+ DocTest.printPrefix "MathObj.PartialFraction:300: "+{-# LINE 300 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 300 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> add x y)+ DocTest.printPrefix "MathObj.PartialFraction:301: "+{-# LINE 301 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 301 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> sub x y)+ DocTest.printPrefix "MathObj.PartialFraction:429: "+{-# LINE 429 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 429 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionInt /\ \x k -> scaleInt k x)+ DocTest.printPrefix "MathObj.PartialFraction:430: "+{-# LINE 430 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 430 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionPoly /\ \x k -> scaleInt k x)+ DocTest.printPrefix "MathObj.PartialFraction:449: "+{-# LINE 449 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 449 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> mul x y)+ DocTest.printPrefix "MathObj.PartialFraction:450: "+{-# LINE 450 "src/MathObj/PartialFraction.hs" #-}+ DocTest.property+{-# LINE 450 "src/MathObj/PartialFraction.hs" #-}+ (genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> mul x y)
test/Test/MathObj/Polynomial.hs view
@@ -1,88 +1,63 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.MathObj.Polynomial where--import qualified MathObj.Polynomial as Poly-import qualified MathObj.Polynomial.Core as PolyCore--import qualified Algebra.IntegralDomain as Integral-import qualified Algebra.Ring as Ring--import qualified Algebra.ZeroTestable as ZeroTestable-import qualified Algebra.Laws as Laws--import qualified Data.List as List-import Data.Tuple.HT (mapPair, mapSnd, )--import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Property, quickCheck, (==>), Testable, )-import qualified Test.HUnit as HUnit---import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP---tensorProductTranspose :: (Ring.C a, Eq a) => [a] -> [a] -> Property-tensorProductTranspose xs ys =- not (null xs) && not (null ys) ==>- PolyCore.tensorProduct xs ys == List.transpose (PolyCore.tensorProduct ys xs)---mul :: (Ring.C a, Eq a, ZeroTestable.C a) => [a] -> [a] -> Bool-mul xs ys = PolyCore.equal (PolyCore.mul xs ys) (PolyCore.mulShear xs ys)--divNormal :: [Rational] -> [Rational] -> Property-divNormal x y =- case (PolyCore.normalize x, PolyCore.normalize y) of- (nx, ny) ->- not (null ny) ==>- mapSnd PolyCore.normalize (PolyCore.divMod nx ny)- ==- mapPair- (PolyCore.normalize, PolyCore.normalize)- (PolyCore.divMod x y)--normalizedQuotient :: [Rational] -> [Rational] -> Property-normalizedQuotient x y =- case PolyCore.normalize x of- nx ->- not (isZero y) ==>- let z = fst $ PolyCore.divMod nx y- in PolyCore.normalize z == z+-- Do not edit! Automatically created with doctest-extract from src/MathObj/Polynomial.hs+{-# LINE 84 "src/MathObj/Polynomial.hs" #-} -modulusSize :: [Rational] -> [Rational] -> Property-modulusSize x y =- case PolyCore.normalize y of- ny ->- not (null ny) ==>- List.length (snd $ PolyCore.divMod x y)- <- List.length ny+module Test.MathObj.Polynomial where +import qualified Test.DocTest.Driver as DocTest -test :: Testable a => (Poly.T Integer -> a) -> IO ()-test = quickCheck+{-# LINE 85 "src/MathObj/Polynomial.hs" #-}+import qualified MathObj.Polynomial as Poly+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Laws as Laws+import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude () -testRat :: Testable a => (Poly.T Rational -> a) -> IO ()-testRat = quickCheck+intPoly :: Poly.T Integer -> Poly.T Integer+intPoly = id +ratioPoly :: Poly.T Rational -> Poly.T Rational+ratioPoly = id -tests :: HUnit.Test-tests =- HUnit.TestLabel "polynomial" $- HUnit.TestList $- map testUnit $- ("tensor product", quickCheck (tensorProductTranspose :: [Integer] -> [Integer] -> Property)) :- ("mul speed", quickCheck (mul :: [Integer] -> [Integer] -> Bool)) :- ("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) :- ("division, normalize", quickCheck divNormal) :- ("normalized quotient", quickCheck normalizedQuotient) :- ("modulus size", quickCheck modulusSize) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Polynomial:100: "+{-# LINE 100 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 100 "src/MathObj/Polynomial.hs" #-}+ (Laws.identity (+) zero . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:101: "+{-# LINE 101 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 101 "src/MathObj/Polynomial.hs" #-}+ (Laws.commutative (+) . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:102: "+{-# LINE 102 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 102 "src/MathObj/Polynomial.hs" #-}+ (Laws.associative (+) . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:103: "+{-# LINE 103 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 103 "src/MathObj/Polynomial.hs" #-}+ (Laws.identity (*) one . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:104: "+{-# LINE 104 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 104 "src/MathObj/Polynomial.hs" #-}+ (Laws.commutative (*) . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:105: "+{-# LINE 105 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 105 "src/MathObj/Polynomial.hs" #-}+ (Laws.associative (*) . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:106: "+{-# LINE 106 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 106 "src/MathObj/Polynomial.hs" #-}+ (Laws.leftDistributive (*) (+) . intPoly)+ DocTest.printPrefix "MathObj.Polynomial:107: "+{-# LINE 107 "src/MathObj/Polynomial.hs" #-}+ DocTest.property+{-# LINE 107 "src/MathObj/Polynomial.hs" #-}+ (Integral.propInverse . ratioPoly)
+ test/Test/MathObj/Polynomial/Core.hs view
@@ -0,0 +1,51 @@+-- Do not edit! Automatically created with doctest-extract from src/MathObj/Polynomial/Core.hs+{-# LINE 47 "src/MathObj/Polynomial/Core.hs" #-}++module Test.MathObj.Polynomial.Core where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 48 "src/MathObj/Polynomial/Core.hs" #-}+import qualified MathObj.Polynomial.Core as PolyCore+import qualified MathObj.Polynomial as Poly+import qualified Data.List as List+import qualified Test.QuickCheck as QC+import Test.QuickCheck ((==>))+import Data.Tuple.HT (mapPair, mapSnd)+import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude ()++intPoly :: [Integer] -> [Integer]+intPoly = id++ratioPoly :: [Rational] -> [Rational]+ratioPoly = id++test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.Polynomial.Core:136: "+{-# LINE 136 "src/MathObj/Polynomial/Core.hs" #-}+ DocTest.property+{-# LINE 136 "src/MathObj/Polynomial/Core.hs" #-}+ (\(QC.NonEmpty xs) (QC.NonEmpty ys) -> PolyCore.tensorProduct xs ys == List.transpose (PolyCore.tensorProduct ys (intPoly xs)))+ DocTest.printPrefix "MathObj.Polynomial.Core:161: "+{-# LINE 161 "src/MathObj/Polynomial/Core.hs" #-}+ DocTest.property+{-# LINE 161 "src/MathObj/Polynomial/Core.hs" #-}+ (\xs ys -> PolyCore.equal (intPoly $ PolyCore.mul xs ys) (PolyCore.mulShear xs ys))+ DocTest.printPrefix "MathObj.Polynomial.Core:173: "+{-# LINE 173 "src/MathObj/Polynomial/Core.hs" #-}+ DocTest.property+{-# LINE 173 "src/MathObj/Polynomial/Core.hs" #-}+ (\x y -> case (PolyCore.normalize x, PolyCore.normalize y) of (nx, ny) -> not (null (ratioPoly ny)) ==> mapSnd PolyCore.normalize (PolyCore.divMod nx ny) == mapPair (PolyCore.normalize, PolyCore.normalize) (PolyCore.divMod x y))+ DocTest.printPrefix "MathObj.Polynomial.Core:174: "+{-# LINE 174 "src/MathObj/Polynomial/Core.hs" #-}+ DocTest.property+{-# LINE 174 "src/MathObj/Polynomial/Core.hs" #-}+ (\x y -> not (isZero (ratioPoly y)) ==> let z = fst $ PolyCore.divMod (Poly.coeffs x) y in PolyCore.normalize z == z)+ DocTest.printPrefix "MathObj.Polynomial.Core:175: "+{-# LINE 175 "src/MathObj/Polynomial/Core.hs" #-}+ DocTest.property+{-# LINE 175 "src/MathObj/Polynomial/Core.hs" #-}+ (\x y -> case PolyCore.normalize $ ratioPoly y of ny -> not (null ny) ==> List.length (snd $ PolyCore.divMod x y) < List.length ny)
test/Test/MathObj/PowerSeries.hs view
@@ -1,165 +1,23 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.MathObj.PowerSeries where--import qualified MathObj.PowerSeries as PST-import qualified MathObj.PowerSeries.Core as PS-import qualified MathObj.PowerSeries.Example as PSE--import qualified Test.QuickCheck.Modifiers as Mod-import Test.NumericPrelude.Utility (equalInfLists, testUnit)-import Test.QuickCheck (quickCheck)--- import Test.QuickCheck (Property, quickCheck, (==>))-import qualified Test.HUnit as HUnit---import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP---identitiesExplODE, identitiesSeriesFunction, identitiesInverses ::- [(String, Int, [Rational],[Rational])]--identitiesExplODE =- ("exp", 500, PSE.expExpl, PSE.expODE) :- ("sin", 500, PSE.sinExpl, PSE.sinODE) :- ("cos", 500, PSE.cosExpl, PSE.cosODE) :- ("tan", 50, PSE.tanExpl, PSE.tanODE) :- ("tan", 50, PSE.tanExpl, PSE.tanExplSieve) :- ("tan", 50, PSE.tanODE, PSE.tanODESieve) :- ("log", 500, PSE.logExpl, PSE.logODE) :- ("asin", 50, PSE.asinODE, snd (PS.inv PSE.sinODE)) :- ("atan", 500, PSE.atanExpl, PSE.atanODE) :- ("sinh", 500, PSE.sinhExpl, PSE.sinhODE) :- ("cosh", 500, PSE.coshExpl, PSE.coshODE) :- ("atanh", 500, PSE.atanhExpl, PSE.atanhODE) :- ("sqrt", 100, PSE.sqrtExpl, PSE.sqrtODE) :- []--identitiesSeriesFunction =- ("exp", 500, PSE.expExpl, PS.exp (\0 -> 1) [0,1]) :- ("sin", 500, PSE.sinExpl, PS.sin (\0 -> (0,1)) [0,1]) :- ("cos", 500, PSE.cosExpl, PS.cos (\0 -> (0,1)) [0,1]) :- ("tan", 50, PSE.tanExpl, PS.tan (\0 -> (0,1)) [0,1]) :- ("sqrt", 50, PSE.sqrtExpl, PS.sqrt (\1 -> 1) [1,1]) :- ("power", 500, PSE.powExpl (-1/3), PS.pow (\1 -> 1) (-1/3) [1,1]) :- ("power", 50, PSE.powExpl (-1/3), PS.exp (\0 -> 1) (PS.scale (-1/3) PSE.log)) :- ("log", 500, PSE.logExpl, PS.log (\1 -> 0) [1,1]) :- ("asin", 50, PSE.asin, PS.asin (\1 -> 1) (\0 -> 0) [0,1]) :- -- ("acos", 50, PSE.acos, PS.acos (\1 -> 1) (\0 -> pi/2) [0,1]) :- ("atan", 500, PSE.atan, PS.atan (\0 -> 0) [0,1]) :- []--identitiesInverses =- ("exp", 100, 1:1:repeat 0, PS.exp (\0 -> 1) PSE.log) :- ("log", 100, 0:1:repeat 0, PS.log (\1 -> 0) PSE.exp) :- ("tan", 50, 0:1:repeat 0, PS.tan (\0 -> (0,1)) PSE.atan) :- ("atan", 50, 0:1:repeat 0, PS.atan (\0 -> 0) PSE.tan) :- ("sin", 50, 0:1:repeat 0, PS.sin (\0 -> (0,1)) PSE.asin) :- ("asin", 100, 0:1:repeat 0, PS.asin (\1 -> 1) (\0 -> 0) PSE.sin) :- ("sqrt", 500, 1:1:repeat 0, PS.sqrt (\1 -> 1) (PS.mul [1,1] [1,1])) :- []--identitiesHoles :: [(String, Int, [Rational] -> [Rational], Rational)]-identitiesHoles =- ("exp", 30, PS.exp (\0 -> 1), 0) :- ("log", 30, PS.log (\1 -> 0), 1) :- ("tan", 20, PS.tan (\0 -> (0,1)), 0) :- ("atan", 20, PS.atan (\0 -> 0), 0) :- ("sin", 20, PS.sin (\0 -> (0,1)), 0) :- ("cos", 20, PS.cos (\0 -> (0,1)), 0) :- ("asin", 30, PS.asin (\1 -> 1) (\0 -> 0), 0) :- ("sqrt", 50, PS.sqrt (\1 -> 1), 1) :- ("pow13", 30, PS.pow (\1 -> 1) (1/3), 1) :- ("pow25", 30, PS.pow (\1 -> 1) (2/5), 1) :- []--testSeriesIdentity :: (String, Int, [Rational], [Rational]) -> HUnit.Test-testSeriesIdentity (label, len, x, y) =- HUnit.test (HUnit.assertBool label (equalInfLists len [x,y]))--testSeriesIdentities ::- String -> [(String, Int, [Rational], [Rational])] -> HUnit.Test-testSeriesIdentities label ids =- HUnit.TestLabel label $- HUnit.TestList $ map testSeriesIdentity ids--_checkSeriesIdentities ::- [(String, Int, [Rational], [Rational])] -> [(String,Bool)]-_checkSeriesIdentities =- map (\(label, len, x, y) -> (label, equalInfLists len [x,y]))---holesMultiplicative :: Int -> Int -> Int -> [Rational] -> Bool-holesMultiplicative trunc expon0 expon1 xs =- let n0 = 1 + mod expon0 10- n1 = 1 + mod expon1 10- in equalInfLists trunc- [PS.insertHoles n0 $ PS.insertHoles n1 xs,- PS.insertHoles n1 $ PS.insertHoles n0 xs,- PS.insertHoles (n0*n1) xs]--testHolesIdentity ::- (String, Int, [Rational] -> [Rational], Rational) -> HUnit.Test-testHolesIdentity (label, len, f, x0) =- HUnit.test $ testUnit $ (,) ("holes in " ++ label) $- quickCheck $ \expon0 xs -> checkHoles len expon0 f x0 xs---checkHoles ::- Int -> Int -> ([Rational] -> [Rational]) ->- Rational -> [Rational] -> Bool-checkHoles trunc expon0 f x xs =- let expon = 1 + mod expon0 10- in equalInfLists trunc- [(f $ PS.insertHoles expon (x:xs)) ++ repeat zero,- (PS.insertHoles expon $ f $ x:xs) ++ repeat zero]---powerMultSeries :: Int -> Integer -> Mod.Positive Rational -> [Rational] -> Bool-powerMultSeries trunc expon0 xp xs =- let expon = 1 + mod expon0 10- x = Mod.getPositive xp- xt = x:xs- in equalInfLists trunc- [PS.pow- (const x) (1 % expon)- (PST.coeffs (PST.fromCoeffs xt ^ expon))- ++ repeat zero,- xt ++ repeat zero]--powerMult :: Int -> Rational -> Rational -> Bool-powerMult trunc exp0 exp1 =- equalInfLists trunc- [PS.mul (PSE.pow exp0) (PSE.pow exp1), PSE.pow (exp0+exp1)]+-- Do not edit! Automatically created with doctest-extract from src/MathObj/PowerSeries.hs+{-# LINE 30 "src/MathObj/PowerSeries.hs" #-} -powerExplODE :: Int -> Rational -> Bool-powerExplODE trunc expon =- equalInfLists trunc [PSE.powODE expon, PSE.powExpl expon]+module Test.MathObj.PowerSeries where -invDiff :: Int -> Rational -> Mod.NonZero Rational -> [Rational] -> Bool-invDiff trunc x0 x1 xs_ =- let xs = x0 : Mod.getNonZero x1 : xs_- (y,ys) = PS.inv xs- (z,zs) = PS.invDiff xs- in y==z && equalInfLists trunc [ys, zs]+import qualified Test.DocTest.Driver as DocTest +{-# LINE 31 "src/MathObj/PowerSeries.hs" #-}+import qualified MathObj.PowerSeries.Core as PS+import qualified MathObj.PowerSeries as PST+import qualified Test.QuickCheck as QC+import Test.NumericPrelude.Utility (equalTrunc, (/\))+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude () -tests :: HUnit.Test-tests =- HUnit.TestLabel "power series" $- HUnit.TestList [- testSeriesIdentities "explicit vs. ODE solution" identitiesExplODE,- testSeriesIdentities "transcendent functions of series" identitiesSeriesFunction,- testSeriesIdentities "inverses of some series" identitiesInverses,- HUnit.TestLabel "laws" $- HUnit.TestList $- map testHolesIdentity identitiesHoles- ++- (map testUnit $- ("multiplicative holes", quickCheck (holesMultiplicative 100)) :- ("powers of series", quickCheck (powerMultSeries 15)) :- ("products of powers", quickCheck (powerMult 30)) :- ("power explicit vs. ODE", quickCheck (powerExplODE 50)) :- ("inv vs. invDiff", quickCheck (invDiff 15)) :- [])- ]+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.PowerSeries:141: "+{-# LINE 141 "src/MathObj/PowerSeries.hs" #-}+ DocTest.property+{-# LINE 141 "src/MathObj/PowerSeries.hs" #-}+ (QC.choose (1,10) /\ \expon (QC.Positive x) xs -> let xt = x:xs in equalTrunc 15 (PS.pow (const x) (1 % expon) (PST.coeffs (PST.fromCoeffs xt ^ expon)) ++ repeat zero) (xt ++ repeat zero))
+ test/Test/MathObj/PowerSeries/Core.hs view
@@ -0,0 +1,178 @@+-- Do not edit! Automatically created with doctest-extract from src/MathObj/PowerSeries/Core.hs+{-# LINE 23 "src/MathObj/PowerSeries/Core.hs" #-}++module Test.MathObj.PowerSeries.Core where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 24 "src/MathObj/PowerSeries/Core.hs" #-}+import qualified MathObj.PowerSeries.Core as PS+import qualified MathObj.PowerSeries.Example as PSE+import Test.NumericPrelude.Utility (equalTrunc, (/\))+import qualified Test.QuickCheck as QC+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude ()+import Control.Applicative (liftA3)++checkHoles ::+ Int -> ([Rational] -> [Rational]) ->+ Rational -> [Rational] -> QC.Property+checkHoles trunc f x xs =+ QC.choose (1,10) /\ \expon ->+ equalTrunc trunc+ (f (PS.insertHoles expon (x:xs)) ++ repeat zero)+ (PS.insertHoles expon (f (x:xs)) ++ repeat zero)++genInvertible :: QC.Gen [Rational]+genInvertible =+ liftA3 (\x0 x1 xs -> x0:x1:xs)+ QC.arbitrary (fmap QC.getNonZero QC.arbitrary) QC.arbitrary++test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.PowerSeries.Core:108: "+{-# LINE 108 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 108 "src/MathObj/PowerSeries/Core.hs" #-}+ (QC.choose (1,10) /\ \m -> QC.choose (1,10) /\ \n xs -> equalTrunc 100 (PS.insertHoles m $ PS.insertHoles n xs) (PS.insertHoles (m*n) xs))+ DocTest.printPrefix "MathObj.PowerSeries.Core:190: "+{-# LINE 190 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 190 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 PSE.sqrtExpl (PS.sqrt (\1 -> 1) [1,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:191: "+{-# LINE 191 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 191 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 (1:1:repeat 0) (PS.sqrt (\1 -> 1) (PS.mul [1,1] [1,1])))+ DocTest.printPrefix "MathObj.PowerSeries.Core:192: "+{-# LINE 192 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 192 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 50 (PS.sqrt (\1 -> 1)) 1)+ DocTest.printPrefix "MathObj.PowerSeries.Core:217: "+{-# LINE 217 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 217 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 100 (PSE.powExpl (-1/3)) (PS.pow (\1 -> 1) (-1/3) [1,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:218: "+{-# LINE 218 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 218 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 (PSE.powExpl (-1/3)) (PS.exp (\0 -> 1) (PS.scale (-1/3) PSE.log)))+ DocTest.printPrefix "MathObj.PowerSeries.Core:219: "+{-# LINE 219 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 219 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 30 (PS.pow (\1 -> 1) (1/3)) 1)+ DocTest.printPrefix "MathObj.PowerSeries.Core:220: "+{-# LINE 220 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 220 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 30 (PS.pow (\1 -> 1) (2/5)) 1)+ DocTest.printPrefix "MathObj.PowerSeries.Core:237: "+{-# LINE 237 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 237 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 PSE.expExpl (PS.exp (\0 -> 1) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:238: "+{-# LINE 238 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 238 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 100 (1:1:repeat 0) (PS.exp (\0 -> 1) PSE.log))+ DocTest.printPrefix "MathObj.PowerSeries.Core:239: "+{-# LINE 239 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 239 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 30 (PS.exp (\0 -> 1)) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:259: "+{-# LINE 259 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 259 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 PSE.sinExpl (PS.sin (\0 -> (0,1)) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:260: "+{-# LINE 260 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 260 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 (0:1:repeat 0) (PS.sin (\0 -> (0,1)) PSE.asin))+ DocTest.printPrefix "MathObj.PowerSeries.Core:261: "+{-# LINE 261 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 261 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 20 (PS.sin (\0 -> (0,1))) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:266: "+{-# LINE 266 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 266 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 PSE.cosExpl (PS.cos (\0 -> (0,1)) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:267: "+{-# LINE 267 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 267 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 20 (PS.cos (\0 -> (0,1))) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:273: "+{-# LINE 273 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 273 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 PSE.tanExpl (PS.tan (\0 -> (0,1)) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:274: "+{-# LINE 274 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 274 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 (0:1:repeat 0) (PS.tan (\0 -> (0,1)) PSE.atan))+ DocTest.printPrefix "MathObj.PowerSeries.Core:275: "+{-# LINE 275 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 275 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 20 (PS.tan (\0 -> (0,1))) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:289: "+{-# LINE 289 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 289 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 PSE.logExpl (PS.log (\1 -> 0) [1,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:290: "+{-# LINE 290 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 290 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 100 (0:1:repeat 0) (PS.log (\1 -> 0) PSE.exp))+ DocTest.printPrefix "MathObj.PowerSeries.Core:291: "+{-# LINE 291 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 291 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 30 (PS.log (\1 -> 0)) 1)+ DocTest.printPrefix "MathObj.PowerSeries.Core:303: "+{-# LINE 303 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 303 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 500 PSE.atan (PS.atan (\0 -> 0) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:304: "+{-# LINE 304 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 304 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 (0:1:repeat 0) (PS.atan (\0 -> 0) PSE.tan))+ DocTest.printPrefix "MathObj.PowerSeries.Core:305: "+{-# LINE 305 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 305 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 20 (PS.atan (\0 -> 0)) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:313: "+{-# LINE 313 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 313 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 100 (0:1:repeat 0) (PS.asin (\1 -> 1) (\0 -> 0) PSE.sin))+ DocTest.printPrefix "MathObj.PowerSeries.Core:314: "+{-# LINE 314 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 314 "src/MathObj/PowerSeries/Core.hs" #-}+ (equalTrunc 50 PSE.asin (PS.asin (\1 -> 1) (\0 -> 0) [0,1]))+ DocTest.printPrefix "MathObj.PowerSeries.Core:315: "+{-# LINE 315 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 315 "src/MathObj/PowerSeries/Core.hs" #-}+ (checkHoles 30 (PS.asin (\1 -> 1) (\0 -> 0)) 0)+ DocTest.printPrefix "MathObj.PowerSeries.Core:383: "+{-# LINE 383 "src/MathObj/PowerSeries/Core.hs" #-}+ DocTest.property+{-# LINE 383 "src/MathObj/PowerSeries/Core.hs" #-}+ (genInvertible /\ \xs -> let (y,ys) = PS.inv xs; (z,zs) = PS.invDiff xs in y==z && equalTrunc 15 ys zs)
+ test/Test/MathObj/PowerSeries/Example.hs view
@@ -0,0 +1,92 @@+-- Do not edit! Automatically created with doctest-extract from src/MathObj/PowerSeries/Example.hs+{-# LINE 21 "src/MathObj/PowerSeries/Example.hs" #-}++module Test.MathObj.PowerSeries.Example where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 22 "src/MathObj/PowerSeries/Example.hs" #-}+import qualified MathObj.PowerSeries.Core as PS+import qualified MathObj.PowerSeries.Example as PSE+import Test.NumericPrelude.Utility (equalTrunc)+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude ()++test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.PowerSeries.Example:55: "+{-# LINE 55 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 55 "src/MathObj/PowerSeries/Example.hs" #-}+ (\m n -> equalTrunc 30 (PS.mul (PSE.pow m) (PSE.pow n)) (PSE.pow (m+n)))+ DocTest.printPrefix "MathObj.PowerSeries.Example:66: "+{-# LINE 66 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 66 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.expExpl PSE.expODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:69: "+{-# LINE 69 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 69 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.sinExpl PSE.sinODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:72: "+{-# LINE 72 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 72 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.cosExpl PSE.cosODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:76: "+{-# LINE 76 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 76 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 50 PSE.tanExpl PSE.tanODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:80: "+{-# LINE 80 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 80 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 50 PSE.tanExpl PSE.tanExplSieve)+ DocTest.printPrefix "MathObj.PowerSeries.Example:87: "+{-# LINE 87 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 87 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.logExpl PSE.logODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:90: "+{-# LINE 90 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 90 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.atanExpl PSE.atanODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:94: "+{-# LINE 94 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 94 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.sinhExpl PSE.sinhODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:97: "+{-# LINE 97 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 97 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.coshExpl PSE.coshODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:100: "+{-# LINE 100 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 100 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 500 PSE.atanhExpl PSE.atanhODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:106: "+{-# LINE 106 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 106 "src/MathObj/PowerSeries/Example.hs" #-}+ (\expon -> equalTrunc 50 (PSE.powODE expon) (PSE.powExpl expon))+ DocTest.printPrefix "MathObj.PowerSeries.Example:112: "+{-# LINE 112 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 112 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 100 PSE.sqrtExpl PSE.sqrtODE)+ DocTest.printPrefix "MathObj.PowerSeries.Example:149: "+{-# LINE 149 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 149 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 50 PSE.tanODE PSE.tanODESieve)+ DocTest.printPrefix "MathObj.PowerSeries.Example:165: "+{-# LINE 165 "src/MathObj/PowerSeries/Example.hs" #-}+ DocTest.property+{-# LINE 165 "src/MathObj/PowerSeries/Example.hs" #-}+ (equalTrunc 50 PSE.asinODE (snd $ PS.inv PSE.sinODE))
test/Test/MathObj/RefinementMask2.hs view
@@ -1,78 +1,72 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Test.MathObj.RefinementMask2 where--import qualified MathObj.RefinementMask2 as Mask-import qualified Algebra.Differential as D--import qualified MathObj.Polynomial as Poly-import qualified MathObj.Polynomial.Core as PolyCore--import qualified Algebra.RealField as RealField-import qualified Algebra.Ring as Ring--import qualified Algebra.ZeroTestable as ZeroTestable--import Data.Maybe (fromMaybe, )--import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Property, quickCheck, (==>), Testable, )-import qualified Test.HUnit as HUnit---import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP--+-- Do not edit! Automatically created with doctest-extract from src/MathObj/RefinementMask2.hs+{-# LINE 32 "src/MathObj/RefinementMask2.hs" #-} -hasMultipleZero :: (Ring.C a, Eq a) => Int -> a -> Poly.T a -> Bool-hasMultipleZero n x poly =- all (zero==) $ take n $- map (flip Poly.evaluate x) $- iterate D.differentiate poly+module Test.MathObj.RefinementMask2 where -inverse0 :: (RealField.C a, ZeroTestable.C a) => Mask.T a -> Property-inverse0 mask0 =- let (b,poly) =- case Mask.toPolynomial mask0 of- Just p -> (True, p)- Nothing -> (False, error "RefinementMask2.inverse0: no admissible mask")- mask1 = Mask.fromPolynomial poly- maskD =- Poly.fromCoeffs (Mask.coeffs mask1) -- Poly.fromCoeffs (Mask.coeffs mask0)- in b ==>- hasMultipleZero (fromMaybe 0 $ Poly.degree poly)- 1 maskD+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest -truncatePolynomial :: (ZeroTestable.C a) => Int -> Poly.T a -> Poly.T a-truncatePolynomial n =- Poly.fromCoeffs . PolyCore.normalize . take n . Poly.coeffs+{-# LINE 33 "src/MathObj/RefinementMask2.hs" #-}+import qualified MathObj.RefinementMask2 as Mask+import qualified MathObj.Polynomial as Poly+import qualified MathObj.Polynomial.Core as PolyCore -inverse1 :: (RealField.C a) => Poly.T a -> Bool-inverse1 poly0 =- case Mask.toPolynomial (Mask.fromPolynomial poly0) of- Just poly1 -> Poly.collinear poly0 poly1- Nothing -> False+import qualified Algebra.Differential as D+import qualified Algebra.Ring as Ring+import Test.NumericPrelude.Utility ((/\))+import qualified Test.QuickCheck as QC+import NumericPrelude.Numeric as NP+import NumericPrelude.Base as P+import Prelude () -refining :: (RealField.C a, ZeroTestable.C a) => Poly.T a -> Bool-refining poly =- poly == Mask.refinePolynomial (Mask.fromPolynomial poly) poly+import Data.Function.HT (nest)+import Data.Maybe (fromMaybe) +hasMultipleZero :: (Ring.C a, Eq a) => Int -> a -> Poly.T a -> Bool+hasMultipleZero n x poly =+ all (zero==) $ take n $+ map (flip Poly.evaluate x) $+ iterate D.differentiate poly -test :: Testable a => (Poly.T Integer -> a) -> IO ()-test = quickCheck+genAdmissibleMask :: QC.Gen (Mask.T Rational, Poly.T Rational)+genAdmissibleMask =+ QC.suchThatMap QC.arbitrary $+ \mask -> fmap ((,) mask) $ Mask.toPolynomial mask -testRat :: Testable a => (Poly.T Rational -> a) -> IO ()-testRat = quickCheck+polyFromMask :: Mask.T a -> Poly.T a+polyFromMask = Poly.fromCoeffs . Mask.coeffs +genShortPolynomial :: Int -> QC.Gen (Poly.T Rational)+genShortPolynomial n =+ fmap (Poly.fromCoeffs . PolyCore.normalize . take n) $ QC.arbitrary -tests :: HUnit.Test-tests =- HUnit.TestLabel "refinement mask" $- HUnit.TestList $- map testUnit $- ("inverse0", quickCheck (inverse0 :: Mask.T Rational -> Property)) :- ("inverse1", quickCheck (inverse1 . truncatePolynomial 5 :: Poly.T Rational -> Bool)) :- ("refining", quickCheck (refining . truncatePolynomial 5 :: Poly.T Rational -> Bool)) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "MathObj.RefinementMask2:127: "+{-# LINE 127 "src/MathObj/RefinementMask2.hs" #-}+ DocTest.property+{-# LINE 127 "src/MathObj/RefinementMask2.hs" #-}+ (genAdmissibleMask /\ \(mask,poly) -> hasMultipleZero (fromMaybe 0 $ Poly.degree poly) 1 (polyFromMask (Mask.fromPolynomial poly) - polyFromMask mask))+ DocTest.printPrefix "MathObj.RefinementMask2:129: "+{-# LINE 129 "src/MathObj/RefinementMask2.hs" #-}+ DocTest.property+{-# LINE 129 "src/MathObj/RefinementMask2.hs" #-}+ (genShortPolynomial 5 /\ \poly -> maybe False (Poly.collinear poly) $ Mask.toPolynomial $ Mask.fromPolynomial poly)+ DocTest.printPrefix "MathObj.RefinementMask2:161: "+{-# LINE 161 "src/MathObj/RefinementMask2.hs" #-}+ DocTest.example+{-# LINE 161 "src/MathObj/RefinementMask2.hs" #-}+ (fmap ((6::Rational) *>) $ Mask.toPolynomial (Mask.fromCoeffs [0.1, 0.02, 0.005::Rational]))+ [ExpectedLine [LineChunk "Just (Polynomial.fromCoeffs [-12732 % 109375,272 % 625,-18 % 25,1 % 1])"]]+ DocTest.printPrefix "MathObj.RefinementMask2:207: "+{-# LINE 207 "src/MathObj/RefinementMask2.hs" #-}+ DocTest.property+{-# LINE 207 "src/MathObj/RefinementMask2.hs" #-}+ (genShortPolynomial 5 /\ \poly -> poly == Mask.refinePolynomial (Mask.fromPolynomial poly) poly)+ DocTest.printPrefix "MathObj.RefinementMask2:209: "+{-# LINE 209 "src/MathObj/RefinementMask2.hs" #-}+ DocTest.example+{-# LINE 209 "src/MathObj/RefinementMask2.hs" #-}+ (fmap (round :: Double -> Integer) $ fmap (1000000*) $ nest 50 (Mask.refinePolynomial (Mask.fromCoeffs [0.1, 0.02, 0.005])) (Poly.fromCoeffs [0,0,0,1]))+ [ExpectedLine [LineChunk "Polynomial.fromCoeffs [-116407,435200,-720000,1000000]"]]
test/Test/Number/ComplexSquareRoot.hs view
@@ -1,50 +1,56 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.Number.ComplexSquareRoot where--import qualified Number.ComplexSquareRoot as S-import qualified Number.Complex as Complex---- import qualified Algebra.Ring as Ring--import qualified Algebra.Laws as Laws--import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Testable, quickCheck, (==>), )-import qualified Test.HUnit as HUnit+-- Do not edit! Automatically created with doctest-extract from playground/Number/ComplexSquareRoot.hs+{-# LINE 21 "playground/Number/ComplexSquareRoot.hs" #-} -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+module Test.Number.ComplexSquareRoot where +import qualified Test.DocTest.Driver as DocTest -simple ::- (Testable t) =>- (S.T Rational -> t) -> IO ()-simple = quickCheck+{-# LINE 22 "playground/Number/ComplexSquareRoot.hs" #-}+import qualified Number.ComplexSquareRoot as SR+import qualified Number.Complex as Complex+import qualified Algebra.Laws as Laws+import Test.QuickCheck ((==>))+import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude () -tests :: HUnit.Test-tests =- HUnit.TestLabel "complex square root" $- HUnit.TestList $- map testUnit $- testList+sr :: SR.T Rational -> SR.T Rational+sr = id -testList :: [(String, IO ())]-testList =- ("multiplication, one",- simple $ Laws.identity S.mul S.one) :- ("multiplication, commutative",- simple $ Laws.commutative S.mul) :- ("multiplication, associative",- simple $ Laws.associative S.mul) :- ("multiplication, homomorphism",- quickCheck $ Laws.homomorphism S.fromNumber- (\x y -> (x :: Complex.T Rational) * y) S.mul) :- ("division, one",- simple $ Laws.rightIdentity S.div S.one) :- ("recip recip",- simple $ \x -> not (isZero x) ==> S.recip (S.recip x) == x) :- ("recip inverts multiplication",- simple $ \x -> not (isZero x) ==> Laws.inverse S.mul S.recip S.one x) :- []+test :: DocTest.T ()+test = do+ DocTest.printPrefix "Number.ComplexSquareRoot:42: "+{-# LINE 42 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 42 "playground/Number/ComplexSquareRoot.hs" #-}+ (Laws.identity SR.mul SR.one . sr)+ DocTest.printPrefix "Number.ComplexSquareRoot:43: "+{-# LINE 43 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 43 "playground/Number/ComplexSquareRoot.hs" #-}+ (Laws.commutative SR.mul . sr)+ DocTest.printPrefix "Number.ComplexSquareRoot:44: "+{-# LINE 44 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 44 "playground/Number/ComplexSquareRoot.hs" #-}+ (Laws.associative SR.mul . sr)+ DocTest.printPrefix "Number.ComplexSquareRoot:45: "+{-# LINE 45 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 45 "playground/Number/ComplexSquareRoot.hs" #-}+ (Laws.homomorphism SR.fromNumber (\x y -> x * (y :: Complex.T Rational)) SR.mul)+ DocTest.printPrefix "Number.ComplexSquareRoot:46: "+{-# LINE 46 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 46 "playground/Number/ComplexSquareRoot.hs" #-}+ (Laws.rightIdentity SR.div SR.one . sr)+ DocTest.printPrefix "Number.ComplexSquareRoot:47: "+{-# LINE 47 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 47 "playground/Number/ComplexSquareRoot.hs" #-}+ (\x -> not (isZero x) ==> SR.recip (SR.recip x) == sr x)+ DocTest.printPrefix "Number.ComplexSquareRoot:48: "+{-# LINE 48 "playground/Number/ComplexSquareRoot.hs" #-}+ DocTest.property+{-# LINE 48 "playground/Number/ComplexSquareRoot.hs" #-}+ (\x -> not (isZero x) ==> Laws.inverse SR.mul SR.recip SR.one (sr x))
test/Test/Number/GaloisField2p32m5.hs view
@@ -1,37 +1,70 @@-{-# 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-+-- Do not edit! Automatically created with doctest-extract from src/Number/GaloisField2p32m5.hs+{-# LINE 33 "src/Number/GaloisField2p32m5.hs" #-} -import NumericPrelude.Base as P-import NumericPrelude.Numeric as NP+module Test.Number.GaloisField2p32m5 where +import qualified Test.DocTest.Driver as DocTest -test :: Testable a => (GF.T -> a) -> IO ()-test = quickCheck+{-# LINE 34 "src/Number/GaloisField2p32m5.hs" #-}+import qualified Number.GaloisField2p32m5 as GF+import qualified Algebra.Laws as Laws+import Test.QuickCheck ((==>))+import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude () +gf :: GF.T -> GF.T+gf = id -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 :: DocTest.T ()+test = do+ DocTest.printPrefix "Number.GaloisField2p32m5:46: "+{-# LINE 46 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 46 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.identity (+) zero . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:47: "+{-# LINE 47 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 47 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.commutative (+) . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:48: "+{-# LINE 48 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 48 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.associative (+) . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:49: "+{-# LINE 49 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 49 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.inverse (+) negate zero . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:50: "+{-# LINE 50 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 50 "src/Number/GaloisField2p32m5.hs" #-}+ (\x -> Laws.inverse (+) (x-) (gf x))+ DocTest.printPrefix "Number.GaloisField2p32m5:51: "+{-# LINE 51 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 51 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.identity (*) one . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:52: "+{-# LINE 52 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 52 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.commutative (*) . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:53: "+{-# LINE 53 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 53 "src/Number/GaloisField2p32m5.hs" #-}+ (Laws.associative (*) . gf)+ DocTest.printPrefix "Number.GaloisField2p32m5:54: "+{-# LINE 54 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 54 "src/Number/GaloisField2p32m5.hs" #-}+ (\y -> gf y /= zero ==> Laws.inverse (*) recip one y)+ DocTest.printPrefix "Number.GaloisField2p32m5:55: "+{-# LINE 55 "src/Number/GaloisField2p32m5.hs" #-}+ DocTest.property+{-# LINE 55 "src/Number/GaloisField2p32m5.hs" #-}+ (\y x -> gf y /= zero ==> Laws.inverse (*) (x/) x y)
test/Test/NumericPrelude/Utility.hs view
@@ -1,21 +1,17 @@--- cf. utility-ht Test.Utility module Test.NumericPrelude.Utility where -import Data.List.HT (mapAdjacent, )-import qualified Data.List as List-import qualified Test.HUnit as HUnit+import qualified Test.QuickCheck as QC +import qualified NumericPrelude.Numeric as NP -testUnit :: (String, IO ()) -> HUnit.Test-testUnit (label, check) =- HUnit.TestLabel label (HUnit.TestCase check)+import Data.Eq.HT (equating) --- compare the lists simultaneously-equalLists :: Eq a => [[a]] -> Bool-equalLists xs =- let equalElems ys =- and (mapAdjacent (==) ys) && length xs == length ys- in all equalElems (List.transpose xs) -equalInfLists :: Eq a => Int -> [[a]] -> Bool-equalInfLists n xs = equalLists (map (take n) xs)+equalTrunc :: Int -> [NP.Rational] -> [NP.Rational] -> Bool+equalTrunc n = equating (take n)+++infixr 0 /\++(/\) :: (Show a, QC.Testable test) => QC.Gen a -> (a -> test) -> QC.Property+(/\) = QC.forAll
test/Test/Run.hs view
@@ -1,36 +1,44 @@+-- Do not edit! Automatically created with doctest-extract. module Main where -import qualified Test.MathObj.RefinementMask2 as RefinementMask2-import qualified Test.Algebra.RealRing as RealRing-import qualified Test.Algebra.IntegralDomain as Integral-import qualified Test.Algebra.Additive as Additive-import qualified Test.MathObj.Gaussian.Polynomial as GaussPoly-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.ComplexSquareRoot as CSqRt-import qualified Test.Number.GaloisField2p32m5 as GF-import qualified Test.HUnit.Text as HUnitText-import qualified Test.HUnit as HUnit+import qualified Test.Algebra.Additive+import qualified Test.Algebra.IntegralDomain+import qualified Test.Algebra.PrincipalIdealDomain+import qualified Test.Algebra.RealRing+import qualified Test.MathObj.Gaussian.Bell+import qualified Test.MathObj.Gaussian.Polynomial+import qualified Test.MathObj.Gaussian.ExponentTuple+import qualified Test.MathObj.Gaussian.Variance+import qualified Test.MathObj.Matrix+import qualified Test.MathObj.PartialFraction+import qualified Test.MathObj.Polynomial+import qualified Test.MathObj.Polynomial.Core+import qualified Test.MathObj.PowerSeries+import qualified Test.MathObj.PowerSeries.Core+import qualified Test.MathObj.PowerSeries.Example+import qualified Test.MathObj.RefinementMask2+import qualified Test.Number.ComplexSquareRoot+import qualified Test.Number.GaloisField2p32m5 +import qualified Test.DocTest.Driver as DocTest+ main :: IO ()-main =- print =<<- HUnitText.runTestTT (HUnit.TestList $- RefinementMask2.tests :- RealRing.tests :- Integral.tests :- Additive.tests :- GaussVariance.tests :- GaussBell.tests :- GaussPoly.tests :- PartialFraction.tests :- Matrix.tests :- Polynomial.tests :- PowerSeries.tests :- CSqRt.tests :- GF.tests :- [])+main = DocTest.run $ do+ Test.Algebra.Additive.test+ Test.Algebra.IntegralDomain.test+ Test.Algebra.PrincipalIdealDomain.test+ Test.Algebra.RealRing.test+ Test.MathObj.Gaussian.Bell.test+ Test.MathObj.Gaussian.Polynomial.test+ Test.MathObj.Gaussian.ExponentTuple.test+ Test.MathObj.Gaussian.Variance.test+ Test.MathObj.Matrix.test+ Test.MathObj.PartialFraction.test+ Test.MathObj.Polynomial.test+ Test.MathObj.Polynomial.Core.test+ Test.MathObj.PowerSeries.test+ Test.MathObj.PowerSeries.Core.test+ Test.MathObj.PowerSeries.Example.test+ Test.MathObj.RefinementMask2.test+ Test.Number.ComplexSquareRoot.test+ Test.Number.GaloisField2p32m5.test