numhask-prelude 0.0.3.0 → 0.0.4.0
raw patch · 7 files changed
+578/−173 lines, 7 files
Files
- numhask-prelude.cabal +3/−1
- src/NumHask/Error.hs +9/−0
- src/NumHask/Examples.hs +29/−0
- src/NumHask/Laws.hs +267/−152
- src/NumHask/Prelude.hs +18/−9
- stack.yaml +1/−1
- test/test.hs +251/−10
numhask-prelude.cabal view
@@ -1,5 +1,5 @@ name: numhask-prelude-version: 0.0.3.0+version: 0.0.4.0 synopsis: A numeric prelude description: A numeric prelude, combining protolude and numhask. category: mathematics@@ -39,6 +39,7 @@ , tasty-quickcheck >= 0.9.2 && <1.0 exposed-modules: NumHask.Prelude+ NumHask.Error NumHask.Examples NumHask.Laws other-modules:@@ -53,6 +54,7 @@ default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax build-depends: base >=4.7 && <5+ , QuickCheck >=2.8 && <3 , doctest , numhask-prelude , tasty
+ src/NumHask/Error.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module NumHask.Error where++import Protolude+import Protolude.Panic (panic)++impossible :: HasCallStack => Text -> a+impossible = panic
src/NumHask/Examples.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE OverloadedLists #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-}@@ -55,6 +57,21 @@ -- >>> 1 / fromIntegral (1::Int) -- 1.0 --+-- RebindableSyntax removes the Haskell98 link between literal numbers and base classes. Literal numbers are pre-processed by ghc as `fromInteger 1` and `fromRational 1.0`.+--+-- >>> :t 1+-- 1 :: Num p => p+--+-- >>> :t 1.0+-- 1.0 :: Fractional p => p+--+-- >>> :set -XRebindableSyntax+-- >>> :t 1+-- 1 :: FromInteger a => a+--+-- >>> :t 1.0+-- 1.0 :: FromRatio b => b+-- -- 'Float' and 'Double' are 'NumHask.Algebra.Fields.Field' instances. -- -- >>> zero == 0.0@@ -110,3 +127,15 @@ -- 6 :+ 8 -- >>> (1 :+ (-1)) / (2 :+ 2) -- 0.0 :+ (-0.5)++newtype PositiveFloat = PositiveFloat { unPositive :: Float } deriving (Show, Eq, AdditiveMagma, AdditiveAssociative, AdditiveUnital, AdditiveCommutative, Additive, MultiplicativeMagma, MultiplicativeUnital, MultiplicativeAssociative, MultiplicativeCommutative, Multiplicative, MultiplicativeInvertible, MultiplicativeGroup, Distribution, Semiring, Ring, CRing, Semifield, UpperBoundedField)++instance AdditiveInvertible PositiveFloat where+ negate _ = nan++instance AdditiveGroup PositiveFloat++instance Bounded PositiveFloat where+ minBound = zero+ maxBound = infinity+
src/NumHask/Laws.hs view
@@ -1,4 +1,9 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-} module NumHask.Laws ( LawArity(..)@@ -9,22 +14,28 @@ , testLawOf2 , idempotentLaws , additiveLaws+ , additiveLaws_ , additiveLawsFail , additiveGroupLaws , multiplicativeLaws , multiplicativeLawsFail , multiplicativeMonoidalLaws , multiplicativeGroupLaws+ , multiplicativeGroupLaws_ , distributionLaws , distributionLawsFail , integralLaws+ , rationalLaws , signedLaws- , metricFloatLaws - , metricComplexFloatLaws- , boundedFieldFloatLaws+ , normedLaws+ , normedBoundedLaws+ , metricIntegralLaws+ , metricIntegralBoundedLaws+ , metricRationalLaws+ , upperBoundedFieldLaws+ , lowerBoundedFieldLaws , quotientFieldLaws , expFieldLaws- , expFieldComplexLooseLaws , additiveBasisLaws , additiveGroupBasisLaws , multiplicativeBasisLaws@@ -33,20 +44,31 @@ , additiveGroupModuleLaws , multiplicativeModuleLaws , multiplicativeGroupModuleLawsFail- , expFieldNaperianLaws- , metricNaperianFloatLaws+ , expFieldContainerLaws , tensorProductLaws , banachLaws , hilbertLaws , semiringLaws , ringLaws , starSemiringLaws+ , involutiveRingLaws+ , integralsLaws ) where import NumHask.Prelude import Test.Tasty.QuickCheck hiding ((><)) import Test.Tasty (TestName, TestTree) +smallRational :: (FromRatio a) => a+smallRational = 10.0++smallRationalPower :: (FromRatio a) => a+smallRationalPower = 6.0++smallIntegralPower :: (FromInteger a) => a+smallIntegralPower = 6++-- | unification of law equations data LawArity a = Nonary Bool | Unary (a -> Bool)@@ -55,18 +77,21 @@ | Ornary (a -> a -> a -> a -> Bool) | Failiary (a -> Property) +type Law a = (TestName, LawArity a)++-- | unification of law equations with 2 types data LawArity2 a b- = Unary2 (a -> Bool)- | Binary2 (a -> b -> Bool)- | Ternary2 (a -> a -> b -> Bool)- | Ternary2' (a -> b -> b -> Bool)- | Ternary2'' (a -> a -> a -> Bool)+ = Unary10 (a -> Bool)+ | Unary01 (b -> Bool)+ | Binary11 (a -> b -> Bool)+ | Binary20 (a -> a -> Bool)+ | Ternary21 (a -> a -> b -> Bool)+ | Ternary12 (a -> b -> b -> Bool)+ | Ternary30 (a -> a -> a -> Bool) | Quad31 (a -> a -> a -> b -> Bool) | Quad22 (a -> a -> b -> b -> Bool) | Failiary2 (a -> Property) -type Law a = (TestName, LawArity a)- type Law2 a b = (TestName, LawArity2 a b) testLawOf :: (Arbitrary a, Show a) => [a] -> Law a -> TestTree@@ -82,11 +107,13 @@ => [(a, b)] -> Law2 a b -> TestTree-testLawOf2 _ (name, Unary2 f) = testProperty name f-testLawOf2 _ (name, Binary2 f) = testProperty name f-testLawOf2 _ (name, Ternary2 f) = testProperty name f-testLawOf2 _ (name, Ternary2' f) = testProperty name f-testLawOf2 _ (name, Ternary2'' f) = testProperty name f+testLawOf2 _ (name, Unary10 f) = testProperty name f+testLawOf2 _ (name, Unary01 f) = testProperty name f+testLawOf2 _ (name, Binary11 f) = testProperty name f+testLawOf2 _ (name, Binary20 f) = testProperty name f+testLawOf2 _ (name, Ternary21 f) = testProperty name f+testLawOf2 _ (name, Ternary12 f) = testProperty name f+testLawOf2 _ (name, Ternary30 f) = testProperty name f testLawOf2 _ (name, Quad22 f) = testProperty name f testLawOf2 _ (name, Quad31 f) = testProperty name f testLawOf2 _ (name, Failiary2 f) = testProperty name f@@ -98,7 +125,7 @@ , ("idempotent: a * a == a", Unary (\a -> a * a == a)) ] --- additive+-- | additive additiveLaws :: (Eq a, Additive a) => [Law a] additiveLaws = [ ( "associative: (a + b) + c = a + (b + c)"@@ -108,6 +135,17 @@ , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a)) ] +-- | additive with approximate association equality+additiveLaws_ :: (Epsilon a) => [Law a]+additiveLaws_ =+ [ ( "associative: (a + b) + c ≈ a + (b + c)"+ , Ternary (\a b c -> (a + b) + c ≈ a + (b + c)))+ , ("left id: zero + a = a", Unary (\a -> zero + a == a))+ , ("right id: a + zero = a", Unary (\a -> a + zero == a))+ , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))+ ]++-- | additive laws with a failure on association additiveLawsFail :: (Eq a, Additive a, Show a, Arbitrary a) => [Law a] additiveLawsFail = [ ( "associative: (a + b) + c = a + (b + c)"@@ -156,8 +194,20 @@ , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a)) ] -multiplicativeGroupLaws :: (Epsilon a, Eq a, MultiplicativeGroup a) => [Law a]+multiplicativeGroupLaws :: (Eq a, AdditiveUnital a, MultiplicativeGroup a) => [Law a] multiplicativeGroupLaws =+ [ ( "divide: a == zero || a / a == one"+ , Unary (\a -> a == zero || (a / a) == one))+ , ( "recip divide: recip a == one / a"+ , Unary (\a -> a == zero || recip a == one / a))+ , ( "recip left: a == zero || recip a * a == one"+ , Unary (\a -> a == zero || recip a * a == one))+ , ( "recip right: a == zero || a * recip a == one"+ , Unary (\a -> a == zero || a * recip a == one))+ ]+ +multiplicativeGroupLaws_ :: (Epsilon a, MultiplicativeGroup a) => [Law a]+multiplicativeGroupLaws_ = [ ( "divide: a == zero || a / a ≈ one" , Unary (\a -> a == zero || (a / a) ≈ one)) , ( "recip divide: recip a == one / a"@@ -182,7 +232,7 @@ ] distributionLawsFail ::- (Show a, Arbitrary a, Epsilon a, Eq a, Distribution a) => [Law a]+ (Show a, Arbitrary a, Epsilon a, Distribution a) => [Law a] distributionLawsFail = [ ( "left annihilation: a * zero == zero" , Unary (\a -> a `times` zero == zero))@@ -204,70 +254,136 @@ , ("fromIntegral a = a", Unary (\a -> fromIntegral a == a)) ] +-- rational+rationalLaws :: (Eq a, FromRatio a, ToRatio a) => [Law a]+rationalLaws =+ [ ("fromRational a = a", Unary (\a -> fromRational a == a))+ ]+ -- metric signedLaws :: (Eq a, Signed a) => [Law a] signedLaws = [("sign a * abs a == a", Unary (\a -> sign a `times` abs a == a))] -metricFloatLaws :: () => [Law Float]-metricFloatLaws =- [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))- , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))- , ( "associative"- , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))- , ( "triangle rule - sum of distances > distance"- , Ternary- (\a b c ->- (abs a > 10.0) ||- (abs b > 10.0) ||- (abs c > 10.0) ||+normedLaws :: forall a b. (Ord b, AdditiveUnital a, AdditiveUnital b, MultiplicativeUnital b, Normed a b) =>+ [Law2 a b]+normedLaws =+ [ ("positive", Binary11 (\a p -> p < (one :: b) || (normLp p a :: b) >= (zero :: b)))+ , ("preserves zero"+ , Binary11 (\_ p -> p < (one :: b) || (normLp p (zero :: a) :: b) == (zero :: b)) )+ ]++normedBoundedLaws :: forall a b. (Eq a, Bounded a, Ord b, AdditiveUnital a, AdditiveUnital b, MultiplicativeUnital b, Normed a b) =>+ [Law2 a b]+normedBoundedLaws =+ [ ("positive or non-minBound", Binary11 (\a p -> a == minBound || p < (one :: b) || (normLp p a :: b) >= (zero :: b)))+ , ("preserves zero"+ , Binary11 (\_ p -> p < (one :: b) || (normLp p (zero :: a) :: b) == (zero :: b)) )+ ]++metricIntegralLaws :: forall a b. (FromInteger b, Ord b, Signed b, Epsilon b, Metric a b) =>+ [Law2 a b]+metricIntegralLaws =+ [ ("Lp: positive",+ Ternary21 (\a b p -> p < one || distanceLp p a b >= zero))+ , ("Lp: zero if equal"+ , Binary11 (\a p -> p < one || distanceLp p a a == zero))+ , ( "Lp: associative"+ , Ternary21 (\a b p ->+ p < one ||+ p > (smallIntegralPower :: b) ||+ distanceLp p a b ≈ distanceLp p b a))+ , ( "Lp: triangle rule - sum of distances > distance"+ , Quad31+ (\a b c p ->+ (p < one) || not (veryNegative- (distance a c + distance b c - (distance a b :: Float))) &&+ (distanceLp p a c + distanceLp p b c - distanceLp p a b)) && not (veryNegative- (distance a b + distance b c - (distance a c :: Float))) &&+ (distanceLp p a b + distanceLp p b c - distanceLp p a c)) && not (veryNegative- (distance a b + distance a c - (distance b c :: Float)))))+ (distanceLp p a b + distanceLp p a c - distanceLp p b c)))) ] -metricComplexFloatLaws :: () => [Law (Complex Float)]-metricComplexFloatLaws =- [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))- , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))- , ( "associative"- , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))- , ( "triangle rule - sum of distances > distance"- , Ternary- (\a b c ->- (size a > (10.0 :: Float)) ||- (size b > (10.0 :: Float)) ||- (size c > (10.0 :: Float)) ||+-- triangle rule doesn't apply to bounded Integrals+metricIntegralBoundedLaws :: forall a b. (FromInteger b, Bounded b, Ord b, Signed b, Epsilon b, Metric a b) =>+ [Law2 a b]+metricIntegralBoundedLaws =+ [ ("Lp: positive",+ Ternary21 (\a b p -> p < one || distanceLp p a b >= zero || distanceLp p a b == minBound))+ , ("Lp: zero if equal"+ , Binary11 (\a p -> p < one || distanceLp p a a == zero))+ , ( "Lp: associative"+ , Ternary21 (\a b p ->+ p < one ||+ p > (smallIntegralPower :: b) ||+ distanceLp p a b ≈ distanceLp p b a))+ ]+++metricRationalLaws :: forall a b. (FromRatio b, Ord b, Signed b, Epsilon b, Metric a b, Normed a b) =>+ [Law2 a b]+metricRationalLaws =+ [ ("Lp: positive",+ Ternary21 (\a b p -> p < one || distanceLp p a b >= zero))+ , ("Lp: zero if equal"+ , Binary11 (\a p -> p < one || distanceLp p a a == zero))+ , ( "Lp: associative"+ , Ternary21 (\a b p ->+ p < one ||+ p > (smallRationalPower :: b) ||+ distanceLp p a b ≈ distanceLp p b a))+ , ( "Lp: triangle rule - sum of distances > distance"+ , Quad31+ (\a b c p ->+ (p < one) ||+ (normL1 a > (smallRational :: b)) ||+ (normL1 b > (smallRational :: b)) ||+ (normL1 c > (smallRational :: b)) || not (veryNegative- (distance a c + distance b c - (distance a b :: Float))) &&+ (distanceLp p a c + distanceLp p b c - distanceLp p a b)) && not (veryNegative- (distance a b + distance b c - (distance a c :: Float))) &&+ (distanceLp p a b + distanceLp p b c - distanceLp p a c)) && not (veryNegative- (distance a b + distance a c - (distance b c :: Float)))))+ (distanceLp p a b + distanceLp p a c - distanceLp p b c)))) ] --- field-boundedFieldFloatLaws :: [Law Float]-boundedFieldFloatLaws =- [ ( "infinity laws"+-- bounded fields+upperBoundedFieldLaws :: forall a. (Eq a, UpperBoundedField a) => [Law a]+upperBoundedFieldLaws =+ [ ( "upper bounded field (infinity) laws" , Unary (\a ->- ((one :: Float) / zero + infinity == infinity) &&+ ((one ::a) / zero + infinity == infinity) && (infinity + a == infinity) &&- isNaN ((infinity :: Float) - infinity) &&- isNaN ((infinity :: Float) / infinity) &&- isNaN (nan + a) && (zero :: Float) / zero /= nan))+ isNaN ((infinity :: a) / infinity) &&+ isNaN (nan + a) &&+ (zero :: a) / zero /= nan)) ] -quotientFieldLaws :: (Ord a, Field a, QuotientField a, FromInteger a) => [Law a]+lowerBoundedFieldLaws :: forall a. (Eq a, UpperBoundedField a, LowerBoundedField a) => [Law a]+lowerBoundedFieldLaws =+ [ ( "lower bounded field (negative infinity) laws"+ , Unary+ (\a ->+ (negate (one ::a) / zero == negInfinity) &&+ ((negInfinity :: a) + negInfinity == negInfinity) &&+ (negInfinity + a == negInfinity) &&+ isNaN ((infinity :: a) - infinity) &&+ isNaN ((negInfinity :: a) - negInfinity) &&+ isNaN ((negInfinity :: a) / negInfinity) &&+ isNaN (nan + a) && (zero :: a) / zero /= nan))+ ]+++++quotientFieldLaws :: (Field a, QuotientField a, FromInteger a) => [Law a] quotientFieldLaws = [ ( "a - one < floor a <= a <= ceiling a < a + one" , Unary@@ -280,87 +396,54 @@ , Unary (\a -> round a == floor (a + one / (one + one)))) ] -expFieldLaws ::- (ExpField a, Signed a, Epsilon a, Fractional a, Ord a) => [Law a]+expFieldLaws :: forall a b.+ (FromInteger b, AdditiveUnital b, ExpField a, Normed a b, Epsilon a, Ord a, Ord b) => [Law2 a b] expFieldLaws = [ ( "sqrt . (**(one+one)) ≈ id"- , Unary+ , Unary10 (\a ->- not (veryPositive a) ||- (a > 10.0) ||+ not (a > (zero :: a)) ||+ (normL1 a > (10 :: b)) || (sqrt . (** (one + one)) $ a) ≈ a && ((** (one + one)) . sqrt $ a) ≈ a)) , ( "log . exp ≈ id"- , Unary+ , Unary10 (\a ->- not (veryPositive a) ||- (a > 10.0) || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))+ not (a > (zero :: a)) ||+ (normL1 a > (10 :: b)) || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a)) , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"- , Binary+ , Binary20 (\a b ->- (not (veryPositive b) ||- not (nearZero (a - zero)) ||- (a == one) ||- (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b))))- ]--expFieldComplexLooseLaws :: Float -> [Law (Complex Float)]-expFieldComplexLooseLaws _ =- [ ( "sqrt . (**(one+one)) ≈ id test contains a stack overflow"- , Unary (const True))- , ("log . exp test contains a stack overflow", Unary (const True))- , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"- , Binary- (\a b@(rb :+ ib) ->- (not (rb > zero && ib > zero) ||+ (not (normL1 b > (zero :: b)) || not (nearZero (a - zero)) || (a == one) || (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b)))) ] -metricNaperianFloatLaws :: (Metric (r Float) Float) => [Law (r Float)]-metricNaperianFloatLaws =- [ ("positive", Binary (\a b -> distance a b >= (zero :: Float)))- , ("zero if equal", Unary (\a -> distance a a == (zero :: Float)))- , ("associative", Binary (\a b -> distance a b ≈ (distance b a :: Float)))- , ( "triangle rule - sum of distances > distance"- , Ternary- (\a b c ->- not- (veryNegative- (distance a c + distance b c - (distance a b :: Float))) &&- not- (veryNegative- (distance a b + distance b c - (distance a c :: Float))) &&- not- (veryNegative- (distance a b + distance a c - (distance b c :: Float)))))- ]--expFieldNaperianLaws ::+expFieldContainerLaws :: ( ExpField (r a) , Foldable r , ExpField a , Epsilon a , Signed a+ , FromRatio a , Epsilon (r a)- , Fractional a , Ord a ) => [Law (r a)]-expFieldNaperianLaws =+expFieldContainerLaws = [ ( "sqrt . (**2) ≈ id" , Unary (\a -> not (all veryPositive a) ||- any (> 10.0) a ||+ any (> smallRational) a || (sqrt . (** (one + one)) $ a) ≈ a && ((** (one + one)) . sqrt $ a) ≈ a)) , ( "log . exp ≈ id" , Unary (\a -> not (all veryPositive a) ||- any (> 10.0) a || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))+ any (> smallRational) a || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a)) , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b" , Binary (\a b ->@@ -373,91 +456,99 @@ -- module additiveModuleLaws ::- (Eq (r a), Epsilon a, Epsilon (r a), AdditiveModule r a) => [Law2 (r a) a]+ (Epsilon a, Epsilon (r a), AdditiveModule r a) => [Law2 (r a) a] additiveModuleLaws = [ ( "additive module associative: (a + b) .+ c ≈ a + (b .+ c)"- , Ternary2 (\a b c -> (a + b) .+ c ≈ a + (b .+ c)))+ , Ternary21 (\a b c -> (a + b) .+ c ≈ a + (b .+ c))) , ( "additive module commutative: (a + b) .+ c ≈ (a .+ c) + b"- , Ternary2 (\a b c -> (a + b) .+ c ≈ (a .+ c) + b))- , ("additive module unital: a .+ zero == a", Unary2 (\a -> a .+ zero == a))+ , Ternary21 (\a b c -> (a + b) .+ c ≈ (a .+ c) + b))+ , ("additive module unital: a .+ zero == a", Unary10 (\a -> a .+ zero == a)) , ( "module additive equivalence: a .+ b ≈ b +. a"- , Binary2 (\a b -> a .+ b ≈ b +. a))+ , Binary11 (\a b -> a .+ b ≈ b +. a)) ] additiveGroupModuleLaws ::- (Eq (r a), Epsilon a, Epsilon (r a), AdditiveGroupModule r a)+ (Epsilon a, Epsilon (r a), AdditiveGroupModule r a) => [Law2 (r a) a] additiveGroupModuleLaws = [ ( "additive group module associative: (a + b) .- c ≈ a + (b .- c)"- , Ternary2 (\a b c -> (a + b) .- c ≈ a + (b .- c)))+ , Ternary21 (\a b c -> (a + b) .- c ≈ a + (b .- c))) , ( "additive group module commutative: (a + b) .- c ≈ (a .- c) + b"- , Ternary2 (\a b c -> (a + b) .- c ≈ (a .- c) + b))+ , Ternary21 (\a b c -> (a + b) .- c ≈ (a .- c) + b)) , ( "additive group module unital: a .- zero == a"- , Unary2 (\a -> a .- zero == a))+ , Unary10 (\a -> a .- zero == a)) , ( "module additive group equivalence: a .- b ≈ negate b +. a"- , Binary2 (\a b -> a .- b ≈ negate b +. a))+ , Binary11 (\a b -> a .- b ≈ negate b +. a)) ] multiplicativeModuleLaws ::- (Eq (r a), Epsilon a, Epsilon (r a), MultiplicativeModule r a)+ (Epsilon a, Epsilon (r a), MultiplicativeModule r a) => [Law2 (r a) a] multiplicativeModuleLaws = [ ( "multiplicative module unital: a .* one == a"- , Unary2 (\a -> a .* one == a))+ , Unary10 (\a -> a .* one == a)) , ( "module right distribution: (a + b) .* c ≈ (a .* c) + (b .* c)"- , Ternary2 (\a b c -> (a + b) .* c ≈ (a .* c) + (b .* c)))+ , Ternary21 (\a b c -> (a + b) .* c ≈ (a .* c) + (b .* c))) , ( "module left distribution: c *. (a + b) ≈ (c *. a) + (c *. b)"- , Ternary2 (\a b c -> c *. (a + b) ≈ (c *. a) + (c *. b)))- , ("annihilation: a .* zero == zero", Unary2 (\a -> a .* zero == zero))+ , Ternary21 (\a b c -> c *. (a + b) ≈ (c *. a) + (c *. b)))+ , ("annihilation: a .* zero == zero", Unary10 (\a -> a .* zero == zero)) , ( "module multiplicative equivalence: a .* b ≈ b *. a"- , Binary2 (\a b -> a .* b ≈ b *. a))+ , Binary11 (\a b -> a .* b ≈ b *. a)) ] multiplicativeGroupModuleLawsFail ::- ( Eq a- , Eq (r a)- , Epsilon a+ ( Epsilon a , Epsilon (r a) , MultiplicativeGroupModule r a ) => [Law2 (r a) a] multiplicativeGroupModuleLawsFail = [ ( "multiplicative group module unital: a ./ one == a"- , Unary2 (\a -> nearZero a || a ./ one == a))+ , Unary10 (\a -> nearZero a || a ./ one == a)) , ( "module multiplicative group equivalence: a ./ b ≈ recip b *. a"- , Binary2 (\a b -> b == zero || a ./ b ≈ recip b *. a))+ , Binary11 (\a b -> b == zero || a ./ b ≈ recip b *. a)) ] banachLaws ::- ( Ord a- , Fractional a- , Signed a- , Foldable r- , Eq (r a)+ ( Foldable r , Epsilon (r a) , Banach r a , Singleton r+ , Signed a+ , FromRatio a+ , Ord a )- => [Law2 (r a) b]+ => [Law2 (r a) a] banachLaws =- [ ( "normalize a .* size a ≈ one"- , Unary2+ [ ( "L1: normalize a .* norm a ≈ one"+ , Unary10 (\a -> a == singleton zero ||- (any ((> 10.0) . abs) a || (normalize a .* size a) ≈ a)))+ (any ((> smallRational) . abs) a || (normalizeL1 a .* normL1 a) ≈ a)))+ , ( "L2: normalize a .* norm a ≈ one"+ , Unary10+ (\a ->+ a == singleton zero ||+ (any ((> smallRational) . abs) a || (normalizeL2 a .* normL2 a) ≈ a)))+{-+ , ( "Lp: normalizeLp a p .* normLp a p ≈ one"+ , Binary11+ (\a p ->+ a == singleton zero ||+ (any ((> smallRational) . normL1) a || (normalizeLp p a .* normLp p a) ≈ a)))+-} ] hilbertLaws ::- ( Eq a- , MultiplicativeModule r a+ ( MultiplicativeModule r a , Epsilon a , Epsilon (r a) , Hilbert r a) => [Law2 (r a) a] hilbertLaws =- [ ("commutative a <.> b ≈ b <.> a", Ternary2 (\a b _ -> a <.> b ≈ b <.> a))+ [ ("commutative a <.> b ≈ b <.> a", Ternary21 (\a b _ -> a <.> b ≈ b <.> a)) , ( "distributive over addition a <.> (b + c) == a <.> b + a <.> c"- , Ternary2'' (\a b c -> a <.> (b + c) ≈ a <.> b + a <.> c))+ , Ternary30 (\a b c -> a <.> (b + c) ≈ a <.> b + a <.> c)) , ( "bilinear a <.> (s *. b + c) == s * (a <.> b) + a <.> c" , Quad31 (\a b c s -> a <.> (s *. b + c) == s * (a <.> b) + a <.> c)) , ( "scalar multiplication (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)"@@ -473,17 +564,17 @@ => [Law2 (r a) a] tensorProductLaws = [ ( "left distribution over addition a><b + c><b == (a+c) >< b"- , Ternary2'' (\a b c -> a >< b + c >< b == (a + c) >< b))+ , Ternary30 (\a b c -> a >< b + c >< b == (a + c) >< b)) , ( "right distribution over addition a><b + a><c == a >< (b+c)"- , Ternary2'' (\a b c -> a >< b + a >< c == a >< (b + c)))+ , Ternary30 (\a b c -> a >< b + a >< c == a >< (b + c))) -- , ( "left module tensor correspondance a *. (b><c) == (a><b) .* c"- -- , Ternary2'' (\a b c -> a *. (b><c) == (a><b) .* c))+ -- , Ternary30 (\a b c -> a *. (b><c) == (a><b) .* c)) -- , ( "right module tensor correspondance (a><b) .* c == a *. (b><c)"- -- , Ternary2'' (\a b c -> (a><b) .* c == a *. (b><c)))+ -- , Ternary30 (\a b c -> (a><b) .* c == a *. (b><c))) ] -- basis-additiveBasisLaws :: (Eq (r a), Epsilon (r a), AdditiveBasis r a) => [Law (r a)]+additiveBasisLaws :: (Epsilon (r a), AdditiveBasis r a) => [Law (r a)] additiveBasisLaws = [ ( "associative: (a .+. b) .+. c ≈ a .+. (b .+. c)" , Ternary (\a b c -> (a .+. b) .+. c ≈ a .+. (b .+. c)))@@ -509,8 +600,7 @@ ] multiplicativeGroupBasisLaws ::- ( Eq (r a)- , Epsilon a+ ( Epsilon a , Epsilon (r a) , Singleton r , MultiplicativeGroupBasis r a@@ -522,7 +612,7 @@ ] -- | semiring-semiringLaws :: (Eq a, Semiring a) => [Law a]+semiringLaws :: (Epsilon a, Semiring a) => [Law a] semiringLaws = additiveLaws <> distributionLaws <> [ ( "associative: (a * b) * c = a * (b * c)" , Ternary (\a b c -> (a `times` b) `times` c == a `times` (b `times` c)))@@ -531,13 +621,38 @@ ] -- | ring-ringLaws :: (Eq a, Ring a) => [Law a]+ringLaws :: (Epsilon a, Ring a) => [Law a] ringLaws = semiringLaws <> additiveGroupLaws -- | starsemiring-starSemiringLaws :: (Eq a, StarSemiring a) => [Law a]+starSemiringLaws :: (Epsilon a, StarSemiring a) => [Law a] starSemiringLaws = semiringLaws <> [ ( "star law: star a == one + a `times` star a" , Unary (\a -> star a == one + a `times` star a)) ]++-- | involutive ring+involutiveRingLaws :: forall a. (Eq a, MultiplicativeUnital a,InvolutiveRing a) => [Law a]+involutiveRingLaws =+ [ ( "adjoint plus law: adj (a + b) ==> adj a + adj b"+ , Binary (\a b -> adj (a `plus` b) == adj a `plus` adj b))+ , ( "adjoint times law: adj (a * b) ==> adj b * adj a"+ , Binary (\a b -> adj (a `times` b) == adj b `times` adj a))+ , ( "adjoint multiplicative unit law: adj one ==> one"+ , Nonary (adj (one :: a) == one))+ , ( "adjoint own inverse law: adj (adj a) ==> a"+ , Unary (\a -> adj (adj a) == a))+ ]+++-- integrals are the law groups that apply to Integral-like numbers+integralsLaws :: (Eq a, AdditiveGroup a, Integral a, Signed a, ToInteger a, FromInteger a, Multiplicative a) => [Law a]+integralsLaws =+ additiveLaws <>+ additiveGroupLaws <>+ multiplicativeLaws <>+ distributionLaws <>+ integralLaws <>+ signedLaws+
src/NumHask/Prelude.hs view
@@ -10,6 +10,10 @@ , (<>) , Semigroup #endif+ -- RebindableSyntax takes fromString away so we need to put it back in+ , fromString+ , Complex(..)+ , Natural(..) -- * Algebraic Heirarchy -- $instances , module NumHask.Algebra.Additive@@ -21,6 +25,7 @@ , module NumHask.Algebra.Metric , module NumHask.Algebra.Module , module NumHask.Algebra.Multiplicative+ , module NumHask.Algebra.Rational , module NumHask.Algebra.Ring , module NumHask.Algebra.Singleton @@ -28,23 +33,26 @@ #if MIN_VERSION_base(4,11,0) import Protolude- hiding (Bounded(..), Integral(..), Rep, Semiring(..), (*), (**),+ hiding (Integral(..), Rep, Semiring(..), (*), (**), (+), (-), (/), (^), (^^), abs, acos, acosh, asin, asinh, atan, atan2, atanh, ceiling, cos, cosh, exp, floor, fromInteger,- fromIntegral, infinity, isNaN, log, logBase, negate, pi, product,- recip, round, sin, sinh, sqrt, sum, tan, tanh, toInteger, trans,- zero)+ fromIntegral, even, odd, infinity, isNaN, log, logBase, negate, pi, product,+ properFraction, recip, round, sin, sinh, sqrt, sum, tan, tanh, toInteger, trans,+ zero, fromRational, Ratio(..), Rational, reduce, gcd) #else import Protolude- hiding (Bounded(..), Integral(..), Rep, Semiring(..), (*), (**),+ hiding (Integral(..), Rep, Semiring(..), (*), (**), (+), (-), (/), (^), (^^), abs, acos, acosh, asin, asinh, atan, atan2, atanh, ceiling, cos, cosh, exp, floor, fromInteger,- fromIntegral, infinity, isNaN, log, logBase, negate, pi, product,- recip, round, sin, sinh, sqrt, sum, tan, tanh, toInteger, trans,- zero, (<>), Semgroup)+ fromIntegral, even, odd, infinity, isNaN, log, logBase, negate, pi, product,+ properFraction, recip, round, sin, sinh, sqrt, sum, tan, tanh, toInteger, trans,+ zero, fromRational, Ratio(..), Rational, reduce, gcd, (<>), Semigroup) import Data.Semigroup ((<>), Semigroup) #endif +import Data.String+import GHC.Natural(Natural(..))+ import NumHask.Algebra.Additive import NumHask.Algebra.Basis import NumHask.Algebra.Distribution@@ -54,6 +62,7 @@ import NumHask.Algebra.Metric import NumHask.Algebra.Module import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Rational import NumHask.Algebra.Ring import NumHask.Algebra.Singleton @@ -63,5 +72,5 @@ -- $instances -- Re-defines the numeric tower. ----- Instances for 'Int', 'Integer', 'Float', 'Double', 'Bool' and 'Complex' are supplied.+-- Instances for 'Int', 'Integer', 'Float', 'Double', 'Bool', 'Complex' and 'Natural'are supplied. --
stack.yaml view
@@ -1,4 +1,4 @@-resolver: nightly-2018-04-04+resolver: nightly-2018-05-06 packages: - .
test/test.hs view
@@ -1,4 +1,7 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | testing IEEE numbers is a special kind of hell, and one that I reserve for days when I can hardly think, so please forgive the horrible hackery contained within this file. --@@ -6,12 +9,22 @@ module Main where import NumHask.Prelude+import GHC.Natural (Natural(..)) import NumHask.Laws import Test.DocTest import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen++instance Arbitrary Natural where+ arbitrary = fromInteger . abs <$> arbitrary++instance Arbitrary Rational where+ arbitrary = reduce <$> (fromInteger <$> arbitrary) <*> (fromInteger <$> arbitrary `suchThat` (>zero))+ main :: IO () main = do doctest ["src/NumHask/Examples.hs"]@@ -22,9 +35,21 @@ testGroup "NumHask" [ testsInt+ , testsInt8+ , testsInt16+ , testsInt32+ , testsInt64+ , testsWord+ , testsWord8+ , testsWord16+ , testsWord32+ , testsWord64+ , testsNatural , testsFloat+ , testsDouble , testsBool , testsComplexFloat+ , testsRational ] testsInt :: TestTree@@ -38,8 +63,158 @@ , testGroup "Distribution" $ testLawOf ([] :: [Int]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Int]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Int]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Int, Int)]) <$>+ metricIntegralLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int, Int)]) <$> normedBoundedLaws ] +testsInteger :: TestTree+testsInteger =+ testGroup+ "Integer"+ [ testGroup "Integrals" $ testLawOf ([] :: [Integer]) <$> integralsLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Integer, Integer)]) <$>+ metricIntegralLaws+ , testGroup "Normed" $ testLawOf2 ([] :: [(Integer, Integer)]) <$> normedLaws+ ]++testsInt8 :: TestTree+testsInt8 =+ testGroup+ "Int8"+ [ testGroup "Integrals" $ testLawOf ([] :: [Int8]) <$> integralsLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Int8, Int8)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int8, Int8)]) <$>+ normedBoundedLaws+ ]++testsInt16 :: TestTree+testsInt16 =+ testGroup+ "Int16"+ [ testGroup "Integrals" $ testLawOf ([] :: [Int16]) <$> integralsLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Int16, Int16)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int16, Int16)]) <$>+ normedBoundedLaws+ ]++testsInt32 :: TestTree+testsInt32 =+ testGroup+ "Int32"+ [ testGroup "Integrals" $ testLawOf ([] :: [Int32]) <$> integralsLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Int32, Int32)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int32, Int32)]) <$>+ normedBoundedLaws+ ]++testsInt64 :: TestTree+testsInt64 =+ testGroup+ "Int64"+ [ testGroup "Integrals" $ testLawOf ([] :: [Int64]) <$> integralsLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Int64, Int64)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int64, Int64)]) <$>+ normedBoundedLaws+ ]++testsWord :: TestTree+testsWord =+ testGroup+ "Word"+ [ testGroup "Additive" $ testLawOf ([] :: [Word]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Word]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Word]) <$> distributionLaws+ , testGroup "Integral" $ testLawOf ([] :: [Word]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Word]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Word, Word)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word, Word)]) <$>+ normedBoundedLaws+ ]++testsWord8 :: TestTree+testsWord8 =+ testGroup+ "Word8"+ [ testGroup "Additive" $ testLawOf ([] :: [Word8]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Word8]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Word8]) <$> distributionLaws+ , testGroup "Integral" $ testLawOf ([] :: [Word8]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Word8]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Word8, Word8)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word8, Word8)]) <$>+ normedBoundedLaws+ ]++testsWord16 :: TestTree+testsWord16 =+ testGroup+ "Word16"+ [ testGroup "Additive" $ testLawOf ([] :: [Word16]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Word16]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Word16]) <$> distributionLaws+ , testGroup "Integral" $ testLawOf ([] :: [Word16]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Word16]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Word16, Word16)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word16, Word16)]) <$>+ normedBoundedLaws+ ]++testsWord32 :: TestTree+testsWord32 =+ testGroup+ "Word32"+ [ testGroup "Additive" $ testLawOf ([] :: [Word32]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Word32]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Word32]) <$> distributionLaws+ , testGroup "Integral" $ testLawOf ([] :: [Word32]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Word32]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Word32, Word32)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word32, Word32)]) <$>+ normedBoundedLaws+ ]++testsWord64 :: TestTree+testsWord64 =+ testGroup+ "Word64"+ [ testGroup "Additive" $ testLawOf ([] :: [Word64]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Word64]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Word64]) <$> distributionLaws+ , testGroup "Integral" $ testLawOf ([] :: [Word64]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Word64]) <$> signedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Word64, Word64)]) <$>+ metricIntegralBoundedLaws+ , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word64, Word64)]) <$>+ normedBoundedLaws+ ]++testsNatural :: TestTree+testsNatural =+ testGroup+ "Natural"+ [ testGroup "Additive" $ testLawOf ([] :: [Natural]) <$> additiveLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Natural]) <$> multiplicativeLaws+ , testGroup "Distribution" $ testLawOf ([] :: [Natural]) <$> distributionLaws+ , testGroup "Naturalegral" $ testLawOf ([] :: [Natural]) <$> integralLaws+ , testGroup "Signed" $ testLawOf ([] :: [Natural]) <$> signedLaws+ , testGroup "Normed" $ testLawOf2 ([] :: [(Natural, Natural)]) <$> normedLaws+ ]+ testsFloat :: TestTree testsFloat = testGroup@@ -51,18 +226,49 @@ , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [Float]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $- testLawOf ([] :: [Float]) <$> multiplicativeGroupLaws+ testLawOf ([] :: [Float]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [Float]) <$> distributionLawsFail , testGroup "Signed" $ testLawOf ([] :: [Float]) <$> signedLaws- , testGroup "Bounded Field" $- testLawOf ([] :: [Float]) <$> boundedFieldFloatLaws- , testGroup "Metric" $ testLawOf ([] :: [Float]) <$> metricFloatLaws+ , testGroup "Normed" $ testLawOf2 ([] :: [(Float, Float)]) <$> normedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Float, Float)]) <$> metricRationalLaws+ , testGroup "Upper Bounded Field" $+ testLawOf ([] :: [Float]) <$> upperBoundedFieldLaws+ , testGroup "Lower Bounded Field" $+ testLawOf ([] :: [Float]) <$> lowerBoundedFieldLaws , testGroup "Quotient Field" $ testLawOf ([] :: [Float]) <$> quotientFieldLaws- , testGroup "Exponential Field" $ testLawOf ([] :: [Float]) <$> expFieldLaws+ , testGroup "Exponential Field" $ testLawOf2 ([] :: [(Float,Float)]) <$> expFieldLaws+ , testGroup "Rational" $ testLawOf ([] :: [Float]) <$> rationalLaws ] +testsDouble :: TestTree+testsDouble =+ testGroup+ "Double"+ [ testGroup "Additive - Associative Fail" $+ testLawOf ([] :: [Double]) <$> additiveLawsFail+ , testGroup "Additive Group" $+ testLawOf ([] :: [Double]) <$> additiveGroupLaws+ , testGroup "Multiplicative - Associative Fail" $+ testLawOf ([] :: [Double]) <$> multiplicativeLawsFail+ , testGroup "MultiplicativeGroup" $+ testLawOf ([] :: [Double]) <$> multiplicativeGroupLaws_+ , testGroup "Distribution - Fail" $+ testLawOf ([] :: [Double]) <$> distributionLawsFail+ , testGroup "Signed" $ testLawOf ([] :: [Double]) <$> signedLaws+ , testGroup "Normed" $ testLawOf2 ([] :: [(Double, Double)]) <$> normedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Double, Double)]) <$> metricRationalLaws+ , testGroup "Upper Bounded Field" $+ testLawOf ([] :: [Double]) <$> upperBoundedFieldLaws+ , testGroup "Lower Bounded Field" $+ testLawOf ([] :: [Double]) <$> lowerBoundedFieldLaws+ , testGroup "Quotient Field" $+ testLawOf ([] :: [Double]) <$> quotientFieldLaws+ , testGroup "Exponential Field" $ testLawOf2 ([] :: [(Double,Double)]) <$> expFieldLaws+ , testGroup "Rational" $ testLawOf ([] :: [Double]) <$> rationalLaws+ ]+ testsBool :: TestTree testsBool = testGroup@@ -85,11 +291,46 @@ , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [Complex Float]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $- testLawOf ([] :: [Complex Float]) <$> multiplicativeGroupLaws+ testLawOf ([] :: [Complex Float]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [Complex Float]) <$> distributionLawsFail- , testGroup "Exponential Field" $- testLawOf ([] :: [Complex Float]) <$> expFieldComplexLooseLaws 10- , testGroup "Metric" $- testLawOf ([] :: [Complex Float]) <$> metricComplexFloatLaws+ -- , testGroup "Exponential Field" $+ -- testLawOf2 ([] :: [(Complex Float, Float)]) <$> expFieldLaws + , testGroup "Normed" $ testLawOf2 ([] :: [(Complex Float, Float)]) <$>+ normedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Complex Float, Float)]) <$>+ metricRationalLaws+ , testGroup "Involutive Ring" $ testLawOf ([] :: [Complex Float]) <$>+ involutiveRingLaws+ ]++testsRational :: TestTree+testsRational =+ testGroup+ "Rational"+ [ testGroup "Additive - Associative" $+ testLawOf ([] :: [Rational]) <$> additiveLaws+ , testGroup "Additive Group" $+ testLawOf ([] :: [Rational]) <$> additiveGroupLaws+ , testGroup "Multiplicative - Associative" $+ testLawOf ([] :: [Rational]) <$> multiplicativeLaws+ , testGroup "MultiplicativeGroup" $+ testLawOf ([] :: [Rational]) <$> multiplicativeGroupLaws_+ , testGroup "Distribution" $+ testLawOf ([] :: [Rational]) <$> distributionLaws+ , testGroup "Signed" $ testLawOf ([] :: [Rational]) <$> signedLaws+ , testGroup "Normed" $ testLawOf2 ([] :: [(Rational, Rational)]) <$> normedLaws+ , testGroup "Metric" $ testLawOf2 ([] :: [(Rational, Rational)]) <$> metricRationalLaws+ , testGroup "Rational" $ testLawOf ([] :: [Rational]) <$> rationalLaws++ -- fixme: rounding and infinities need work+{-+ , testGroup "Quotient Field" $+ testLawOf ([] :: [Rational]) <$> quotientFieldLaws+ , testGroup "Upper Bounded Field" $+ testLawOf ([] :: [Rational]) <$> upperBoundedFieldLaws+ , testGroup "Lower Bounded Field" $+ testLawOf ([] :: [Rational]) <$> lowerBoundedFieldLaws++-} ]