packages feed

numhask-prelude (empty) → 0.0.1.0

raw patch · 8 files changed

+902/−0 lines, 8 filesdep +QuickCheckdep +basedep +doctestsetup-changed

Dependencies added: QuickCheck, base, doctest, numhask, numhask-prelude, protolude, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Tony Day (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tony Day nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ numhask-prelude.cabal view
@@ -0,0 +1,61 @@+name:           numhask-prelude+version:        0.0.1.0+synopsis:       A numeric prelude+description:    A numeric prelude, combining protolude and numhask.+category:       mathematics+homepage:       https://github.com/tonyday567/numhask#readme+bug-reports:    https://github.com/tonyday567/numhask/issues+author:         Tony Day+maintainer:     tonyday567@gmail.com+copyright:      Tony Day+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.18++extra-source-files:+    stack.yaml++source-repository head+  type: git+  location: https://github.com/tonyday567/numhask++library+  hs-source-dirs:+      src+  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+  ghc-options:+      -Wall+      -Wcompat+      -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wredundant-constraints+  build-depends:+      QuickCheck >=2.8 && <3+    , base >=4.7 && <4.12+    , numhask >=0.2 && <0.3+    , protolude >=0.1 && <0.3+    , tasty >= 1.0.1.1 && <1.1+    , tasty-quickcheck >= 0.9.2 && <1.0+  exposed-modules:+      NumHask.Prelude+      NumHask.Examples+      NumHask.Laws+  other-modules:+      Paths_numhask_prelude+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs:+      test+  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+  build-depends:+      base >=4.7 && <5+    , doctest+    , numhask-prelude+    , tasty+  other-modules:+      Paths_numhask_prelude+  default-language: Haskell2010
+ src/NumHask/Examples.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- | NumHask usage examples+module NumHask.Examples+  (+    -- ** Imports and Pragmas+    -- $imports++    -- $setup+    -- ** Basic Arithmetic+    -- $basic++    -- ** Complex numbers+    -- $complex++    -- ** Vectors+    -- $vector++    -- ** Matrices+    -- $matrices+  ) where++import NumHask.Prelude++-- $imports+-- NumHask.Prelude is a replacement for the standard prelude with the 'NoImplicitPrelude' extension explicitly required.+--+-- $setup+-- >>> :set -XNoImplicitPrelude+-- >>> import NumHask.Prelude+--+-- $basic+-- 'Int', 'Integer', 'Double' and 'Float' are from base.  NumHask takes these classes and redefines the basic arithmetic operators.+--+-- >>> 1 + 1+-- 2+-- >>> 1 - 1+-- 0+-- >>> 1 * 1+-- 1+-- >>> 1 / 1+-- 1.0+--+-- Note that the literal numbers in the divide above defaulted to Float rather than Int.+--+-- >>> 1 / (1::Int)+-- ...+-- ... No instance for (MultiplicativeGroup Int)+-- ...+--+-- >>> 1 / fromIntegral (1::Int)+-- 1.0+--+-- 'Float' and 'Double' are 'NumHask.Algebra.Fields.Field' instances.+--+-- >>> zero == 0.0+-- True+-- >>> one == 1.0+-- True+-- >>> 1.0 + 1.0+-- 2.0+-- >>> 1.0 - 1.0+-- 0.0+-- >>> 1.0 * 1.0+-- 1.0+-- >>> 1.0 / 1.0+-- 1.0+--+-- 'QuotientField'+--+-- >>> 1 `div` 2+-- 0+-- >>> 3 `mod` 2+-- 1+--+-- 'BoundedField'+--+-- >>> one/zero+-- Infinity+-- >>> -one/zero+-- -Infinity+-- >>> zero/zero+one+-- NaN+--+-- 'ExpField'+--+-- >>> logBase 2 4+-- 2.0+-- >>> 2 ** 2+-- 4.0+-- >>> sqrt 4+-- 2.0+-- >>> exp 2+-- 7.38905609893065+-- >>> log 2+-- 0.6931471805599453+--+-- $complex+--+-- >>> let a = 1 :+ 2+-- >>> a+-- 1 :+ 2+-- >>> zero - a+-- (-1) :+ (-2)+-- >>> (1 :+ (-2)) * ((-2) :+ 4)+-- 6 :+ 8+-- >>> (1 :+ (-1)) / (2 :+ 2)+-- 0.0 :+ (-0.5)
+ src/NumHask/Laws.hs view
@@ -0,0 +1,543 @@+{-# LANGUAGE FlexibleContexts #-}++module NumHask.Laws+  ( LawArity(..)+  , LawArity2(..)+  , Law+  , Law2+  , testLawOf+  , testLawOf2+  , idempotentLaws+  , additiveLaws+  , additiveLawsFail+  , additiveGroupLaws+  , multiplicativeLaws+  , multiplicativeLawsFail+  , multiplicativeMonoidalLaws+  , multiplicativeGroupLaws+  , distributionLaws+  , distributionLawsFail+  , integralLaws+  , signedLaws+  , metricFloatLaws +  , metricComplexFloatLaws+  , boundedFieldFloatLaws+  , quotientFieldLaws +  , expFieldLaws+  , expFieldComplexLooseLaws  +  , additiveBasisLaws+  , additiveGroupBasisLaws+  , multiplicativeBasisLaws+  , multiplicativeGroupBasisLaws+  , additiveModuleLaws+  , additiveGroupModuleLaws+  , multiplicativeModuleLaws+  , multiplicativeGroupModuleLawsFail+  , expFieldNaperianLaws+  , metricNaperianFloatLaws+  , tensorProductLaws+  , banachLaws+  , hilbertLaws+  , semiringLaws+  , ringLaws+  , starSemiringLaws+  ) where++import NumHask.Prelude+import Test.Tasty.QuickCheck hiding ((><))+import Test.Tasty (TestName, TestTree)++data LawArity a+  = Nonary Bool+  | Unary (a -> Bool)+  | Binary (a -> a -> Bool)+  | Ternary (a -> a -> a -> Bool)+  | Ornary (a -> a -> a -> a -> Bool)+  | Failiary (a -> Property)++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)+  | 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+testLawOf _ (name, Nonary f) = testProperty name f+testLawOf _ (name, Unary f) = testProperty name f+testLawOf _ (name, Binary f) = testProperty name f+testLawOf _ (name, Ternary f) = testProperty name f+testLawOf _ (name, Ornary f) = testProperty name f+testLawOf _ (name, Failiary f) = testProperty name f++testLawOf2 ::+     (Arbitrary a, Show a, Arbitrary b, Show b)+  => [(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, Quad22 f) = testProperty name f+testLawOf2 _ (name, Quad31 f) = testProperty name f+testLawOf2 _ (name, Failiary2 f) = testProperty name f++-- idempotent+idempotentLaws :: (Eq a, Additive a, Multiplicative a) => [Law a]+idempotentLaws =+  [ ("idempotent: a + a == a", Unary (\a -> a + a == a))+  , ("idempotent: a * a == a", Unary (\a -> a * a == a))+  ]++-- additive+additiveLaws :: (Eq a, Additive 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))+  ]++additiveLawsFail :: (Eq a, Additive a, Show a, Arbitrary a) => [Law a]+additiveLawsFail =+  [ ( "associative: (a + b) + c = a + (b + c)"+    , Failiary $ expectFailure . (\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))+  ]++additiveGroupLaws :: (Eq a, AdditiveGroup a) => [Law a]+additiveGroupLaws =+  [ ("minus: a - a = zero", Unary (\a -> (a - a) == zero))+  , ("negate minus: negate a == zero - a", Unary (\a -> negate a == zero - a))+  , ( "negate left cancel: negate a + a == zero"+    , Unary (\a -> negate a + a == zero))+  , ( "negate right cancel: negate a + a == zero"+    , Unary (\a -> a + negate a == zero))+  ]++-- multiplicative+multiplicativeLaws :: (Eq a, Multiplicative a) => [Law a]+multiplicativeLaws =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Ternary (\a b c -> (a * b) * c == a * (b * c)))+  , ("left id: one * a = a", Unary (\a -> one * a == a))+  , ("right id: a * one = a", Unary (\a -> a * one == a))+  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))+  ]++multiplicativeMonoidalLaws ::+     (Eq a, MultiplicativeUnital a) => [Law a]+multiplicativeMonoidalLaws =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Ternary (\a b c -> (a `times` b) `times` c == a `times` (b `times` c)))+  , ("left id: one `times` a = a", Unary (\a -> one `times` a == a))+  , ("right id: a `times` one = a", Unary (\a -> a `times` one == a))+  ]++multiplicativeLawsFail ::+     (Eq a, Show a, Arbitrary a, Multiplicative a) => [Law a]+multiplicativeLawsFail =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Failiary $ expectFailure . (\a b c -> (a * b) * c == a * (b * c)))+  , ("left id: one * a = a", Unary (\a -> one * a == a))+  , ("right id: a * one = a", Unary (\a -> a * one == a))+  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))+  ]++multiplicativeGroupLaws :: (Epsilon a, Eq 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))+  ]++-- distribution+distributionLaws :: (Eq a, Distribution a) => [Law a]+distributionLaws =+  [ ( "left annihilation: a * zero == zero"+    , Unary (\a -> a `times` zero == zero))+  , ( "right annihilation: zero * a == zero"+    , Unary (\a -> zero `times` a == zero))+  , ( "left distributivity: a * (b + c) == a * b + a * c"+    , Ternary (\a b c -> a `times` (b + c) == a `times` b + a `times` c))+  , ( "right distributivity: (a + b) * c == a * c + b * c"+    , Ternary (\a b c -> (a + b) `times` c == a `times` c + b `times` c))+  ]++distributionLawsFail ::+     (Show a, Arbitrary a, Epsilon a, Eq a, Distribution a) => [Law a]+distributionLawsFail =+  [ ( "left annihilation: a * zero == zero"+    , Unary (\a -> a `times` zero == zero))+  , ( "right annihilation: a * zero == zero"+    , Unary (\a -> zero `times` a == zero))+  , ( "left distributivity: a * (b + c) = a * b + a * c"+    , Failiary $+      expectFailure . (\a b c -> a `times` (b + c) == a `times` b + a `times` c))+  , ( "right distributivity: (a + b) * c = a * c + b * c"+    , Failiary $+      expectFailure . (\a b c -> (a + b) `times` c == a `times` c + b `times` c))+  ]++-- integral+integralLaws :: (Eq a, Integral a, FromInteger a, ToInteger a) => [Law a]+integralLaws =+  [ ( "integral divmod: b == zero || b * (a `div` b) + (a `mod` b) == a"+    , Binary (\a b -> b == zero || b `times` (a `div` b) + (a `mod` b) == a))+  , ("fromIntegral a = a", Unary (\a -> fromIntegral 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) ||+           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)))))+  ]++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)) ||+           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)))))+  ]++-- field+boundedFieldFloatLaws :: [Law Float]+boundedFieldFloatLaws =+  [ ( "infinity laws"+    , Unary+        (\a ->+           ((one :: Float) / zero + infinity == infinity) &&+           (infinity + a == infinity) &&+           isNaN ((infinity :: Float) - infinity) &&+           isNaN ((infinity :: Float) / infinity) &&+           isNaN (nan + a) && (zero :: Float) / zero /= nan))+  ]++quotientFieldLaws :: (Ord a, Field a, QuotientField a, FromInteger a) => [Law a]+quotientFieldLaws =+  [ ( "a - one < floor a <= a <= ceiling a < a + one"+    , Unary+        (\a ->+           ((a - one) < fromIntegral (floor a)) &&+           (fromIntegral (floor a) <= a) &&+           (a <= fromIntegral (ceiling a)) &&+           (fromIntegral (ceiling a) < a + one)))+  , ( "round a == floor (a + one/(one+one))"+    , Unary (\a -> round a == floor (a + one / (one + one))))+  ]++expFieldLaws ::+     (ExpField a, Signed a, Epsilon a, Fractional a, Ord a) => [Law a]+expFieldLaws =+  [ ( "sqrt . (**(one+one)) ≈ id"+    , Unary+        (\a ->+           not (veryPositive a) ||+           (a > 10.0) ||+           (sqrt . (** (one + one)) $ a) ≈ a &&+           ((** (one + one)) . sqrt $ a) ≈ a))+  , ( "log . exp ≈ id"+    , Unary+        (\a ->+           not (veryPositive a) ||+           (a > 10.0) || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))+  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"+    , Binary+        (\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 (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 ::+     ( ExpField (r a)+     , Foldable r+     , ExpField a+     , Epsilon a+     , Signed a+     , Epsilon (r a)+     , Fractional a+     , Ord a+     )+  => [Law (r a)]+expFieldNaperianLaws =+  [ ( "sqrt . (**2) ≈ id"+    , Unary+        (\a ->+           not (all veryPositive a) ||+           any (> 10.0) 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))+  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"+    , Binary+        (\a b ->+           (not (all veryPositive b) ||+            not (all nearZero a) ||+            all (== one) a ||+            (all (== zero) a && all nearZero (logBase a b)) ||+            (a ** logBase a b ≈ b))))+  ]++-- module+additiveModuleLaws ::+     (Eq (r 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)))+  , ( "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))+  , ( "module additive equivalence: a .+ b ≈ b +. a"+    , Binary2 (\a b -> a .+ b ≈ b +. a))+  ]++additiveGroupModuleLaws ::+     (Eq (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)))+  , ( "additive group module commutative: (a + b) .- c ≈ (a .- c) + b"+    , Ternary2 (\a b c -> (a + b) .- c ≈ (a .- c) + b))+  , ( "additive group module unital: a .- zero == a"+    , Unary2 (\a -> a .- zero == a))+  , ( "module additive group equivalence: a .- b ≈ negate b +. a"+    , Binary2 (\a b -> a .- b ≈ negate b +. a))+  ]++multiplicativeModuleLaws ::+     (Eq (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))+  , ( "module right distribution: (a + b) .* c ≈ (a .* c) + (b .* c)"+    , Ternary2 (\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))+  , ( "module multiplicative equivalence: a .* b ≈ b *. a"+    , Binary2 (\a b -> a .* b ≈ b *. a))+  ]++multiplicativeGroupModuleLawsFail ::+     ( Eq a+     , Eq (r 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))+  , ( "module multiplicative group equivalence: a ./ b ≈ recip b *. a"+    , Binary2 (\a b -> b == zero || a ./ b ≈ recip b *. a))+  ]++banachLaws ::+     ( Ord a+     , Fractional a+     , Signed a+     , Foldable r+     , Eq (r a)+     , Epsilon (r a)+     , Banach r a+     , Singleton r+     )+  => [Law2 (r a) b]+banachLaws =+  [ ( "normalize a .* size a ≈ one"+    , Unary2+        (\a ->+           a == singleton zero ||+           (any ((> 10.0) . abs) a || (normalize a .* size a) ≈ a)))+  ]++hilbertLaws ::+    ( Eq 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))+  , ( "distributive over addition a <.> (b + c) == a <.> b + a <.> c"+    , Ternary2'' (\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)"+    , Quad22 (\a b s0 s1 -> (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)))+  ]++tensorProductLaws ::+     ( Eq (r (r a))+     , Additive (r (r a))+     , TensorProduct (r a)+     , Epsilon (r a)+     )+  => [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))+  , ( "right distribution over addition a><b + a><c == a >< (b+c)"+    , Ternary2'' (\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))+  -- , ( "right module tensor correspondance (a><b) .* c == a *. (b><c)"+  --   , Ternary2'' (\a b c -> (a><b) .* c == a *. (b><c)))+  ]++-- basis+additiveBasisLaws :: (Eq (r a), 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)))+  , ("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))+  ]++additiveGroupBasisLaws :: (Eq (r a), Singleton r, AdditiveGroupBasis r a) => [Law (r a)]+additiveGroupBasisLaws =+  [ ( "minus: a .-. a = singleton zero"+    , Unary (\a -> (a .-. a) == singleton zero))+  ]++multiplicativeBasisLaws :: (Eq (r a), Singleton r, MultiplicativeBasis r a) => [Law (r a)]+multiplicativeBasisLaws =+  [ ( "associative: (a .*. b) .*. c == a .*. (b .*. c)"+    , Ternary (\a b c -> (a .*. b) .*. c == a .*. (b .*. c)))+  , ("left id: singleton one .*. a = a", Unary (\a -> singleton one .*. a == a))+  , ( "right id: a .*. singleton one = a"+    , Unary (\a -> a .*. singleton one == a))+  , ("commutative: a .*. b == b .*. a", Binary (\a b -> a .*. b == b .*. a))+  ]++multiplicativeGroupBasisLaws ::+     ( Eq (r a)+     , Epsilon a+     , Epsilon (r a)+     , Singleton r+     , MultiplicativeGroupBasis r a+     )+  => [Law (r a)]+multiplicativeGroupBasisLaws =+  [ ( "basis divide: a ./. a ≈ singleton one"+    , Unary (\a -> a == singleton zero || (a ./. a) ≈ singleton one))+  ]++-- | semiring+semiringLaws :: (Eq 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)))+    , ("left id: one * a = a", Unary (\a -> one `times` a == a))+    , ("right id: a * one = a", Unary (\a -> a `times` one == a))+    ]++-- | ring+ringLaws :: (Eq a, Ring a) => [Law a]+ringLaws = semiringLaws <> additiveGroupLaws++-- | starsemiring+starSemiringLaws :: (Eq 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))+    ]+
+ src/NumHask/Prelude.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -Wall #-}++-- | A prelude for NumHask+module NumHask.Prelude+  ( -- * Backend+    -- $backend+    module Protolude++    -- * Algebraic Heirarchy+    -- $instances+  , module NumHask.Algebra.Additive+  , module NumHask.Algebra.Basis+  , module NumHask.Algebra.Distribution+  , module NumHask.Algebra.Field+  , module NumHask.Algebra.Integral+  , module NumHask.Algebra.Magma+  , module NumHask.Algebra.Metric+  , module NumHask.Algebra.Module+  , module NumHask.Algebra.Multiplicative+  , module NumHask.Algebra.Ring+  , module NumHask.Algebra.Singleton++  ) where++import Protolude+       hiding (Bounded(..), 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)++import NumHask.Algebra.Additive+import NumHask.Algebra.Basis+import NumHask.Algebra.Distribution+import NumHask.Algebra.Field+import NumHask.Algebra.Integral+import NumHask.Algebra.Magma+import NumHask.Algebra.Metric+import NumHask.Algebra.Module+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Ring+import NumHask.Algebra.Singleton++-- $backend+-- NumHask imports Protolude as the prelude and replaces much of the 'Num' heirarchy in base.+-- Usage of 'Semigroup' and 'Monoid' has been avoided to retain basic compatability.+-- $instances+-- Re-defines the numeric tower.+--+-- Instances for 'Int', 'Integer', 'Float', 'Double', 'Bool' and 'Complex' are supplied.+--
+ stack.yaml view
@@ -0,0 +1,7 @@+resolver: nightly-2018-04-04++packages:+  - .+  - ../numhask++extra-deps: []
+ test/test.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -Wall #-}++-- | 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.+--+-- This suite sometimes fails, having been hand-crafty towards balancing reasonably approximate equality versus unbounded failure (given enough trials).+module Main where++import NumHask.Prelude+import NumHask.Laws++import Test.DocTest+import Test.Tasty+       (TestTree, defaultMain, testGroup)++main :: IO ()+main = do+  doctest ["src/NumHask/Examples.hs"]+  defaultMain tests++tests :: TestTree+tests =+  testGroup+    "NumHask"+    [ testsInt+    , testsFloat+    , testsBool+    , testsComplexFloat+    ]++testsInt :: TestTree+testsInt =+  testGroup+    "Int"+    [ testGroup "Additive" $ testLawOf ([] :: [Int]) <$> additiveLaws+    , testGroup "Additive Group" $ testLawOf ([] :: [Int]) <$> additiveGroupLaws+    , testGroup "Multiplicative" $+      testLawOf ([] :: [Int]) <$> multiplicativeLaws+    , testGroup "Distribution" $ testLawOf ([] :: [Int]) <$> distributionLaws+    , testGroup "Integral" $ testLawOf ([] :: [Int]) <$> integralLaws+    , testGroup "Signed" $ testLawOf ([] :: [Int]) <$> signedLaws+    ]++testsFloat :: TestTree+testsFloat =+  testGroup+    "Float"+    [ testGroup "Additive - Associative Fail" $+      testLawOf ([] :: [Float]) <$> additiveLawsFail+    , testGroup "Additive Group" $+      testLawOf ([] :: [Float]) <$> additiveGroupLaws+    , testGroup "Multiplicative - Associative Fail" $+      testLawOf ([] :: [Float]) <$> multiplicativeLawsFail+    , testGroup "MultiplicativeGroup" $+      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 "Quotient Field" $+      testLawOf ([] :: [Float]) <$> quotientFieldLaws+    , testGroup "Exponential Field" $ testLawOf ([] :: [Float]) <$> expFieldLaws+    ]++testsBool :: TestTree+testsBool =+  testGroup+    "Bool"+    [ testGroup "Idempotent" $ testLawOf ([] :: [Bool]) <$> idempotentLaws+    , testGroup "Additive" $ testLawOf ([] :: [Bool]) <$> additiveLaws+    , testGroup "Multiplicative" $+      testLawOf ([] :: [Bool]) <$> multiplicativeLaws+    , testGroup "Distribution" $ testLawOf ([] :: [Bool]) <$> distributionLaws+    ]++testsComplexFloat :: TestTree+testsComplexFloat =+  testGroup+    "Complex Float"+    [ testGroup "Additive - Associative Fail" $+      testLawOf ([] :: [Complex Float]) <$> additiveLawsFail+    , testGroup "Additive Group" $+      testLawOf ([] :: [Complex Float]) <$> additiveGroupLaws+    , testGroup "Multiplicative - Associative Fail" $+      testLawOf ([] :: [Complex Float]) <$> multiplicativeLawsFail+    , testGroup "MultiplicativeGroup" $+      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+    ]