numhask (empty) → 0.0.1

raw patch · 24 files changed

+3297/−0 lines, 24 filesdep +HUnitdep +QuickCheckdep +adjunctionssetup-changed

Dependencies added: HUnit, QuickCheck, adjunctions, base, distributive, doctest, numhask, protolude, singletons, tasty, tasty-hunit, tasty-quickcheck, vector

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• numhask.cabal +159/−0
• src/NumHask/Algebra.hs +30/−0
• src/NumHask/Algebra/Additive.hs +189/−0
• src/NumHask/Algebra/Basis.hs +62/−0
• src/NumHask/Algebra/Distribution.hs +35/−0
• src/NumHask/Algebra/Exponential.hs +63/−0
• src/NumHask/Algebra/Field.hs +29/−0
• src/NumHask/Algebra/Integral.hs +73/−0
• src/NumHask/Algebra/Magma.hs +129/−0
• src/NumHask/Algebra/Metric.hs +153/−0
• src/NumHask/Algebra/Module.hs +134/−0
• src/NumHask/Algebra/Multiplicative.hs +186/−0
• src/NumHask/Algebra/Ordering.hs +217/−0
• src/NumHask/Algebra/Ring.hs +57/−0
• src/NumHask/Examples.hs +167/−0
• src/NumHask/HasShape.hs +24/−0
• src/NumHask/Matrix.hs +204/−0
• src/NumHask/Num.hs +60/−0
• src/NumHask/Prelude.hs +100/−0
• src/NumHask/Tensor.hs +199/−0
• src/NumHask/Vector.hs +136/−0
• test/test.hs +859/−0

@@ -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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,159 @@+name:+  numhask+version:+  0.0.1+synopsis:+  A numeric prelude+description:+  Classes for numbers, higher-dimension representable objects, and algebras that combine them. See NumHask.Examples for usage.+  .+  > import NumHask.Prelude+category:+  mathematics+homepage:+  https://github.com/tonyday567/numhask+license:+  BSD3+license-file:+  LICENSE+author:+  Tony Day+maintainer:+  tonyday567@gmail.com+copyright:+  Tony Day+build-type:+  Simple+cabal-version:+  >=1.14++library+  default-language:+    Haskell2010+  ghc-options:+    -Wall+    -fno-warn-orphans+  hs-source-dirs:+    src+  exposed-modules:+    NumHask.Prelude,+    NumHask.Examples,+    NumHask.Algebra,+    NumHask.Algebra.Additive,+    NumHask.Algebra.Basis,+    NumHask.Algebra.Exponential,+    NumHask.Algebra.Distribution,+    NumHask.Algebra.Ring,+    NumHask.Algebra.Field,+    NumHask.Algebra.Integral,+    NumHask.Algebra.Magma,+    NumHask.Algebra.Metric,+    NumHask.Algebra.Module,+    NumHask.Algebra.Multiplicative+    NumHask.Algebra.Ordering,+    NumHask.HasShape,+    NumHask.Vector,+    NumHask.Matrix,+    NumHask.Num,+    NumHask.Tensor+  build-depends:+    base >= 4.7 && < 4.10,+    protolude >= 0.1 && < 0.3,+    vector >= 0.11 && < 0.13,+    QuickCheck >= 2.8 && < 3,+    adjunctions >= 4.3 && < 5,+    distributive >= 0.5 && < 0.6,+    singletons >= 2.2 && < 2.3+  default-extensions:+    NoImplicitPrelude,+    UnicodeSyntax,+    BangPatterns,+    BinaryLiterals,+    DeriveFoldable,+    DeriveFunctor,+    DeriveGeneric,+    DeriveTraversable,+    DisambiguateRecordFields,+    EmptyCase,+    FlexibleContexts,+    FlexibleInstances,+    FunctionalDependencies,+    GADTSyntax,+    InstanceSigs,+    KindSignatures,+    LambdaCase,+    MonadComprehensions,+    MultiParamTypeClasses,+    MultiWayIf,+    NegativeLiterals,+    OverloadedStrings,+    ParallelListComp,+    PartialTypeSignatures,+    PatternSynonyms,+    RankNTypes,+    RecordWildCards,+    RecursiveDo,+    ScopedTypeVariables,+    TupleSections,+    TypeFamilies,+    TypeOperators,+    ExtendedDefaultRules++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    test.hs+  build-depends:+    base >= 4.7 && < 5,+    numhask,+    tasty,+    HUnit,+    tasty-hunit,+    QuickCheck,+    tasty-quickcheck,+    doctest+  default-extensions:+    NoImplicitPrelude,+    UnicodeSyntax,+    BangPatterns,+    BinaryLiterals,+    DeriveFoldable,+    DeriveFunctor,+    DeriveGeneric,+    DeriveTraversable,+    DisambiguateRecordFields,+    EmptyCase,+    FlexibleContexts,+    FlexibleInstances,+    FunctionalDependencies,+    GADTSyntax,+    InstanceSigs,+    KindSignatures,+    LambdaCase,+    MonadComprehensions,+    MultiParamTypeClasses,+    MultiWayIf,+    NegativeLiterals,+    OverloadedStrings,+    ParallelListComp,+    PartialTypeSignatures,+    PatternSynonyms,+    RankNTypes,+    RecordWildCards,+    RecursiveDo,+    ScopedTypeVariables,+    TupleSections,+    TypeFamilies,+    TypeOperators,+    ExtendedDefaultRules++source-repository head+  type:+    git+  location:+    https://github.com/tonyday567/numhask

@@ -0,0 +1,30 @@+-- | Just the numeric tower bits of NumHask++module NumHask.Algebra+  ( -- * Algebraic Heirarchy+    module NumHask.Algebra.Additive+  , module NumHask.Algebra.Basis+  , module NumHask.Algebra.Distribution+  , module NumHask.Algebra.Exponential+  , 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.Ordering+  , module NumHask.Algebra.Ring+  ) where++import NumHask.Algebra.Additive+import NumHask.Algebra.Basis+import NumHask.Algebra.Distribution+import NumHask.Algebra.Exponential+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.Ordering+import NumHask.Algebra.Ring

@@ -0,0 +1,189 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Additive Structure++module NumHask.Algebra.Additive (+    -- ** Additive Structure+    AdditiveMagma(..)+  , AdditiveUnital(..)+  , AdditiveAssociative+  , AdditiveCommutative+  , AdditiveInvertible(..)+  , AdditiveHomomorphic(..)+  , AdditiveIdempotent+  , AdditiveMonoidal+  , Additive(..)+  , AdditiveRightCancellative(..)+  , AdditiveLeftCancellative(..)+  , AdditiveGroup(..)+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, Bool(..))+import Data.Functor.Rep++-- * Additive structure+-- The Magma structures are repeated for an additive and multiplicative heirarchy, mostly so we can name the specific operators in the usual ways.+--+-- | 'plus' is used for the additive magma to distinguish from '+' which, by convention, implies commutativity+class AdditiveMagma a where plus :: a -> a -> a++instance AdditiveMagma Double where plus = (P.+)+instance AdditiveMagma Float where plus = (P.+)+instance AdditiveMagma Int where plus = (P.+)+instance AdditiveMagma Integer where plus = (P.+)+instance AdditiveMagma Bool where plus = (P.||)+instance (Representable r, AdditiveMagma a) => AdditiveMagma (r a) where+    plus = liftR2 plus++-- | AdditiveUnital+--+-- > zero `plus` a == a+-- > a `plus` zero == a+class AdditiveMagma a => AdditiveUnital a where zero :: a++instance AdditiveUnital Double where zero = 0+instance AdditiveUnital Float where zero = 0+instance AdditiveUnital Int where zero = 0+instance AdditiveUnital Integer where zero = 0+instance AdditiveUnital Bool where zero = False+instance (Representable r, AdditiveUnital a) => AdditiveUnital (r a) where+    zero = pureRep zero++-- | AdditiveAssociative+--+-- > (a `plus` b) `plus` c == a `plus` (b `plus` c)+class AdditiveMagma a => AdditiveAssociative a++instance AdditiveAssociative Double+instance AdditiveAssociative Float+instance AdditiveAssociative Int+instance AdditiveAssociative Integer+instance AdditiveAssociative Bool+instance (Representable r, AdditiveAssociative a) => AdditiveAssociative (r a)++-- | AdditiveCommutative+--+-- > a `plus` b == b `plus` a+class AdditiveMagma a => AdditiveCommutative a++instance AdditiveCommutative Double+instance AdditiveCommutative Float+instance AdditiveCommutative Int+instance AdditiveCommutative Integer+instance AdditiveCommutative Bool+instance (Representable r, AdditiveCommutative a) => AdditiveCommutative (r a)++-- | AdditiveInvertible+--+-- > ∀ a ∈ A: negate a ∈ A+--+-- law is true by construction in Haskell+class AdditiveMagma a => AdditiveInvertible a where negate :: a -> a++instance AdditiveInvertible Double where negate = P.negate+instance AdditiveInvertible Float where negate = P.negate+instance AdditiveInvertible Int where negate = P.negate+instance AdditiveInvertible Integer where negate = P.negate+instance AdditiveInvertible Bool where negate = P.not+instance (Representable r, AdditiveInvertible a) => AdditiveInvertible (r a) where+    negate a = fmapRep negate a++-- | AdditiveHomomorphic+--+-- > ∀ a ∈ A: plushom a ∈ B+--+-- law is true by construction in Haskell+class (AdditiveMagma b) => AdditiveHomomorphic a b where+    plushom :: a -> b++instance AdditiveMagma a => AdditiveHomomorphic a a where plushom a = a+instance (Representable r, AdditiveMagma a) => AdditiveHomomorphic a (r a) where+    plushom a = pureRep a++-- | AdditiveIdempotent+--+-- > a `plus` a == a+class AdditiveMagma a => AdditiveIdempotent a++instance AdditiveIdempotent Bool++-- | AdditiveMonoidal+class ( AdditiveUnital a+      , AdditiveAssociative a) =>+      AdditiveMonoidal a++instance AdditiveMonoidal Double+instance AdditiveMonoidal Float+instance AdditiveMonoidal Int+instance AdditiveMonoidal Integer+instance AdditiveMonoidal Bool+instance (Representable r, AdditiveMonoidal a) => AdditiveMonoidal (r a)++-- | Additive is commutative, unital and associative under addition+--+-- > a + b = b + a+--+-- > (a + b) + c = a + (b + c)+--+-- > zero + a = a+--+-- > a + zero = a+--+class ( AdditiveCommutative a+      , AdditiveUnital a+      , AdditiveAssociative a) =>+      Additive a where+    infixl 6 ++    (+) :: a -> a -> a+    a + b = plus a b++instance Additive Double+instance Additive Float+instance Additive Int+instance Additive Integer+instance Additive Bool+instance (Representable r, Additive a) => Additive (r a)++-- | Non-commutative left minus+class ( AdditiveUnital a+      , AdditiveAssociative a+      , AdditiveInvertible a) =>+      AdditiveLeftCancellative a where+    infixl 6 ~-+    (~-) :: a -> a -> a+    (~-) a b = negate b `plus` a++-- | Non-commutative right minus+class ( AdditiveUnital a+      , AdditiveAssociative a+      , AdditiveInvertible a) =>+      AdditiveRightCancellative a where+    infixl 6 -~+    (-~) :: a -> a -> a+    (-~) a b = a `plus` negate b++-- | AdditiveGroup+--+-- > a - a = zero+--+-- > negate a = zero - a+--+-- > negate a + a = zero+--+class ( Additive a+      , AdditiveInvertible a) =>+      AdditiveGroup a where+    infixl 6 -+    (-) :: a -> a -> a+    (-) a b = a `plus` negate b++instance AdditiveGroup Double+instance AdditiveGroup Float+instance AdditiveGroup Int+instance AdditiveGroup Integer+instance (Representable r, AdditiveGroup a) => AdditiveGroup (r a)

@@ -0,0 +1,62 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Highjacking 'Representable's to provide a basis to provide element-by-element operations++module NumHask.Algebra.Basis (+    AdditiveBasis(..)+  , AdditiveGroupBasis(..)+  , MultiplicativeBasis(..)+  , MultiplicativeGroupBasis(..)+  ) where++import Data.Functor.Rep+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Additive++-- | AdditiveBasis+-- element by element addition+class ( Representable m+      , Additive a ) =>+      AdditiveBasis m a where+    infixl 7 .+.+    (.+.) :: m a -> m a -> m a+    (.+.) = liftR2 (+)++instance (Representable r, Additive a) => AdditiveBasis r a++-- | AdditiveGroupBasis+-- element by element subtraction+class ( Representable m+      , AdditiveGroup a ) =>+      AdditiveGroupBasis m a where+    infixl 6 .-.+    (.-.) :: m a -> m a -> m a+    (.-.) = liftR2 (-)++instance (Representable r, AdditiveGroup a) => AdditiveGroupBasis r a++-- | MultiplicativeBasis+-- element by element multiplication+class ( Representable m+      , Multiplicative a ) =>+      MultiplicativeBasis m a where+    infixl 7 .*.+    (.*.) :: m a -> m a -> m a+    (.*.) = liftR2 (*)++instance (Representable r, Multiplicative a) => MultiplicativeBasis r a++-- | MultiplicativeGroupBasis+-- element by element division+class ( Representable m+      , MultiplicativeGroup a ) =>+      MultiplicativeGroupBasis m a where+    infixl 7 ./.+    (./.) :: m a -> m a -> m a+    (./.) = liftR2 (/)++instance (Representable r, MultiplicativeGroup a) => MultiplicativeGroupBasis r a

@@ -0,0 +1,35 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Distribution, avoiding name clashes with 'Data.Distributive'+module NumHask.Algebra.Distribution (+    -- * Distribution+    Distribution+  ) where++import Protolude (Double, Float, Int, Integer,Bool(..))+import Data.Functor.Rep+import NumHask.Algebra.Additive+import NumHask.Algebra.Multiplicative++-- | Distribution+--+-- > a * (b + c) == a * b + a * c+--+-- > (a + b) * c == a * c + b * c+--+class (+    Additive a+  , MultiplicativeMagma a+  ) => Distribution a++instance Distribution Double+instance Distribution Float+instance Distribution Int+instance Distribution Integer+instance Distribution Bool+instance (Representable r, Distribution a) => Distribution (r a)+

@@ -0,0 +1,63 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Exponentail 'Ring' and 'Field'+module NumHask.Algebra.Exponential (+    -- * Exponential+    ExpRing(..)+  , (^)+  , ExpField(..)+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Functor(..))+import Data.Functor.Rep+import NumHask.Algebra.Field+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Additive+import NumHask.Algebra.Ring++-- | ExpRing+class Ring a => ExpRing a where+    logBase :: a -> a -> a+    (**) :: a -> a -> a++-- | (^)+(^) :: ExpRing a => a -> a -> a+(^) = (**)++instance ExpRing Double where+    logBase = P.logBase+    (**) = (P.**)+instance ExpRing Float where+    logBase = P.logBase+    (**) = (P.**)+instance (Representable r, ExpRing a) => ExpRing (r a) where+    logBase = liftR2 logBase+    (**)  = liftR2 (**)++-- | ExpField+class ( Field a+      , ExpRing a ) =>+      ExpField a where+    sqrt :: a -> a+    sqrt a = a**(one/(one+one))++    exp :: a -> a+    log :: a -> a++instance ExpField Double where+    exp = P.exp+    log = P.log++instance ExpField Float where+    exp = P.exp+    log = P.log++instance (Representable r, ExpField a) => ExpField (r a) where+    exp = fmap exp+    log = fmap log+

@@ -0,0 +1,29 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Field+module NumHask.Algebra.Field (+    Field+  ) where++import Protolude (Double, Float)+import Data.Functor.Rep+import NumHask.Algebra.Additive+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Distribution+import NumHask.Algebra.Ring++-- | Field+class ( AdditiveGroup a+      , MultiplicativeGroup a+      , Distribution a+      , Ring a) =>+      Field a++instance Field Double+instance Field Float+instance (Representable r, Field a) => Field (r a)+

@@ -0,0 +1,73 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Integral domains+module NumHask.Algebra.Integral (+    -- * Integral+    Integral(..)+  , ToInteger(..)+  , FromInteger(..)+  , fromIntegral+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, Functor(..), ($), (.), Foldable(..), fst, snd, foldr, const, Ord(..))+import Data.Functor.Rep+import NumHask.Algebra.Additive+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Ring++-- | Integral+--+-- > b == zero || b * (a `div` b) + (a `mod` b) == a+--+class (Ring a) => Integral a where++    infixl 7 `div`, `mod`++    -- | truncates towards negative infinity+    div :: a -> a -> a+    div a1 a2 = fst (divMod a1 a2)+    mod :: a -> a -> a+    mod a1 a2 = snd (divMod a1 a2)++    divMod :: a -> a -> (a,a)++instance Integral Int where divMod = P.divMod+instance Integral Integer where divMod = P.divMod++instance (Representable r, Integral a) => Integral (r a) where+    divMod a b = (d,m)+        where+          x = liftR2 divMod a b+          d = fmap fst x+          m = fmap snd x++-- | toInteger and fromInteger as per the base 'Num' instance is problematic for numbers with a 'Basis'+class (Integral a) => ToInteger a where+    toInteger :: a -> Integer++-- | fromInteger+class (Ring a) => FromInteger a where+    fromInteger :: Integer -> a+    fromInteger = slowFromInteger++slowFromInteger :: (Ring r) => Integer -> r+slowFromInteger i = if i > zero+                    then foldr (+) zero $ fmap (const one) [one..i]+                    else negate $ foldr (+) zero $ fmap (const one) [one..negate i]++-- | This splitting away of fromInteger from the 'Ring' instance tends to increase constraint boier-plate+fromIntegral :: (ToInteger a, FromInteger b) => a -> b+fromIntegral = fromInteger . toInteger++instance FromInteger Double where fromInteger = P.fromInteger+instance FromInteger Float where fromInteger = P.fromInteger+instance FromInteger Int where fromInteger = P.fromInteger+instance FromInteger Integer where fromInteger = P.fromInteger++instance ToInteger Int where toInteger = P.toInteger+instance ToInteger Integer where toInteger = P.toInteger

@@ -0,0 +1,129 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Magma+module NumHask.Algebra.Magma (+    Magma(..)+  , Unital(..)+  , Associative+  , Commutative+  , Invertible(..)+  , Idempotent+  , Homomorphic(..)+  , Isomorphic(..)+  , Monoidal+  , CMonoidal+  , Loop+  , Group+  , groupSwap+  , Abelian+  ) where++-- * Magma structure+-- | A <https://en.wikipedia.org/wiki/Magma_(algebra) Magma> is a tuple (T,⊕) consisting of+--+-- - a type a, and+--+-- - a function (⊕) :: T -> T -> T+--+-- The mathematical laws for a magma are:+--+-- - ⊕ is defined for all possible pairs of type T, and+--+-- - ⊕ is closed in the set of all possible values of type T+--+-- or, more tersly,+--+-- > ∀ a, b ∈ T: a ⊕ b ∈ T+--+-- These laws are true by construction in haskell: the type signature of 'magma' and the above mathematical laws are synonyms.+--+--+class Magma a where (⊕) :: a -> a -> a++-- | A Unital Magma+--+-- > unit ⊕ a = a+-- > a ⊕ unit = a+--+class Magma a => Unital a where unit :: a++-- | An Associative Magma+-- +-- > (a ⊕ b) ⊕ c = a ⊕ (b ⊕ c)+class Magma a => Associative a++-- | A Commutative Magma+--+-- > a ⊕ b = b ⊕ a+class Magma a => Commutative a++-- | An Invertible Magma+--+-- > ∀ a ∈ T: inv a ∈ T+--+-- law is true by construction in Haskell+--+class Magma a => Invertible a where inv :: a -> a++-- | An Idempotent Magma+--+-- > a ⊕ a = a+class Magma a => Idempotent a++-- | A Homomorph between two Magmas+--+-- > ∀ a ∈ A: hom a ∈ B+--+-- law is true by construction in Haskell+--+class ( Magma a+      , Magma b) =>+      Homomorphic a b where hom :: a -> b++instance Magma a => Homomorphic a a where hom a = a++-- | major conceptual clashidge with many other libraries+class (Magma a, Magma b) => Isomorphic a b where+    isomorph :: (a -> b, b -> a)++-- | A Monoidal Magma is associative and unital.+class ( Associative a+      , Unital a) =>+      Monoidal a++-- | A CMonoidal Magma is commutative, associative and unital.+class ( Commutative a+      , Associative a+      , Unital a) =>+      CMonoidal a++-- | A Loop is unital and invertible+class ( Unital a+      , Invertible a) =>+      Loop a++-- | A Group is associative, unital and invertible+class ( Associative a+      , Unital a+      , Invertible a) =>+      Group a++-- | see http://chris-taylor.github.io/blog/2013/02/25/xor-trick/+groupSwap :: (Group a) => (a,a) -> (a,a)+groupSwap (a,b) =+    let a' = a ⊕ b+        b' = a ⊕ inv b+        a'' = inv b' ⊕ a'+    in (a'',b')++-- | An Abelian Group is associative, unital, invertible and commutative+class ( Associative a+      , Unital a+      , Invertible a+      , Commutative a) =>+      Abelian a+

@@ -0,0 +1,153 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Metric structure+module NumHask.Algebra.Metric (+    -- * Metric+    BoundedField(..)+  , infinity+  , neginfinity+  , Metric(..)+  , Normed(..)+  , Signed(..)+  , Epsilon(..)+  , (≈)+  , QuotientField(..)+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, ($), (<$>), Foldable(..), foldr, Bool(..), Ord(..), Eq(..), any)+import Data.Functor.Rep+import NumHask.Algebra.Ring+import NumHask.Algebra.Field+import NumHask.Algebra.Additive+import NumHask.Algebra.Exponential+import NumHask.Algebra.Multiplicative++-- | providing the concepts of infinity and NaN, thus moving away from error throwing+class (Field a) => BoundedField a where+    maxBound :: a+    maxBound = one/zero++    minBound :: a+    minBound = negate (one/zero)++    nan :: a+    nan = zero/zero++    isNaN :: a -> Bool++-- | prints as `Infinity`+infinity :: BoundedField a => a+infinity = maxBound++-- | prints as `-Infinity`+neginfinity :: BoundedField a => a+neginfinity = minBound++instance BoundedField Float where isNaN = P.isNaN+instance BoundedField Double where isNaN = P.isNaN+instance (Foldable r, Representable r, BoundedField a) =>+    BoundedField (r a) where+    isNaN a = any isNaN a++-- | abs and signnum are also warts on the standard 'Num' class, and are separated here to provide a cleaner structure.+class ( AdditiveUnital a+      , AdditiveGroup a+      , Multiplicative a+      ) => Signed a where+    sign :: a -> a+    abs :: a -> a++instance Signed Double where+    sign a = if a >= zero then one else negate one+    abs = P.abs+instance Signed Float where+    sign a = if a >= zero then one else negate one+    abs = P.abs+instance Signed Int where+    sign a = if a >= zero then one else negate one+    abs = P.abs+instance Signed Integer where+    sign a = if a >= zero then one else negate one+    abs = P.abs+instance (Representable r, Signed a) => Signed (r a) where+    sign = fmapRep sign+    abs = fmapRep abs++-- | Normed is a current wart on the NumHask api, causing all sorts of runaway constraint boiler-plate.+class Normed a b where+    size :: a -> b++instance Normed Double Double where size = P.abs+instance Normed Float Float where size = P.abs+instance Normed Int Int where size = P.abs+instance Normed Integer Integer where size = P.abs+instance (Foldable r, Representable r, ExpField a, ExpRing a) =>+    Normed (r a) a where+    size r = sqrt $ foldr (+) zero $ (**(one+one)) <$> r++-- | This should probably be split off into some sort of alternative Equality logic, but to what end?+class (AdditiveGroup a) => Epsilon a where+    nearZero :: a -> Bool+    aboutEqual :: a -> a -> Bool++infixl 4 ≈++-- | utf ???+(≈) :: (Epsilon a) => a -> a -> Bool+(≈) = aboutEqual++instance Epsilon Double where+    nearZero a = abs a <= (1e-12 :: Double)+    aboutEqual a b = nearZero $ a - b++instance Epsilon Float where+    nearZero a = abs a <= (1e-6 :: Float)+    aboutEqual a b = nearZero $ a - b++instance Epsilon Int where+    nearZero a = a == zero+    aboutEqual a b = nearZero $ a - b++instance Epsilon Integer where+    nearZero a = a == zero+    aboutEqual a b = nearZero $ a - b++instance (Foldable r, Representable r, Epsilon a) => Epsilon (r a) where+    nearZero a = any nearZero $ toList a+    aboutEqual a b = any P.identity $ liftR2 aboutEqual a b++-- | distance between numbers+class Metric a b where+    distance :: a -> a -> b++instance Metric Double Double where distance a b = abs (a - b)+instance Metric Float Float where distance a b = abs (a - b)+instance Metric Int Int where distance a b = abs (a - b)+instance Metric Integer Integer where distance a b = abs (a - b)++instance (P.Foldable r, Representable r, ExpField a) => Metric (r a) a where+    distance a b = size (a - b)++-- | quotient fields also explode constraints if they are polymorphed to emit general integrals+class (Ring a) => QuotientField a where+    round :: a -> Integer+    ceiling :: a -> Integer+    floor :: a -> Integer+    (^^) :: a -> Integer -> a++instance QuotientField Float where+    round = P.round+    ceiling = P.ceiling+    floor = P.floor+    (^^) = (P.^^)++instance QuotientField Double where+    round = P.round+    ceiling = P.ceiling+    floor = P.floor+    (^^) = (P.^^)

@@ -0,0 +1,134 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Algebra++module NumHask.Algebra.Module (+    -- * Module+    AdditiveModule(..)+  , AdditiveGroupModule(..)+  , MultiplicativeModule(..)+  , MultiplicativeGroupModule(..)+    -- * Tensoring+  , Banach(..)+  , Hilbert(..)+  , type (><)+  , TensorProduct(..)+  ) where++import Protolude (Double, Float, Int, Integer, Functor(..), ($), Foldable(..))+import Data.Functor.Rep+import NumHask.Algebra.Additive+import NumHask.Algebra.Exponential+import NumHask.Algebra.Metric+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Ring++-- * Additive Module Structure++-- | AdditiveModule+class ( Representable m+      , Additive a) =>+      AdditiveModule m a where+    infixl 6 .++    (.+) :: m a -> a -> m a+    m .+ a = fmap (a+) m++    infixl 6 +.+    (+.) :: a -> m a -> m a+    a +. m = fmap (a+) m++instance (Representable r, Additive a) => AdditiveModule r a++-- | AdditiveGroupModule+class ( Representable m+      , AdditiveGroup a) =>+      AdditiveGroupModule m a where+    infixl 6 .-+    (.-) :: m a -> a -> m a+    m .- a = fmap (\x -> x - a) m++    infixl 6 -.+    (-.) :: a -> m a -> m a+    a -. m = fmap (\x -> a - x) m++instance (Representable r, AdditiveGroup a) => AdditiveGroupModule r a++-- * Multiplicative Module Structure+-- | MultiplicativeModule+class ( Representable m+      , Multiplicative a) =>+      MultiplicativeModule m a where+    infixl 7 .*+    (.*) :: m a -> a -> m a+    m .* a = fmap (a*) m++    infixl 7 *.+    (*.) :: a -> m a -> m a+    a *. m = fmap (a*) m++instance (Representable r, Multiplicative a) => MultiplicativeModule r a++-- | MultiplicativeGroupModule+class ( Representable m+      , MultiplicativeGroup a) =>+      MultiplicativeGroupModule m a where+    infixl 7 ./+    (./) :: m a -> a -> m a+    m ./ a = fmap (/ a) m++    infixl 7 /.+    (/.) :: a -> m a -> m a+    a /. m = fmap (\x -> a / x) m++instance (Representable r, MultiplicativeGroup a) => MultiplicativeGroupModule r a++-- | Banach+class ( Representable m+      , ExpField a+      , Normed (m a) a) =>+      Banach m a where+    normalize :: m a -> m a+    normalize a = a ./ size a++instance (ExpField a, Foldable r, Representable r) => Banach r a++-- | Hilbert+class (AdditiveGroup (m a)) => Hilbert m a where+    infix 8 <.>+    (<.>) :: m a -> m a -> a++instance (Foldable r, Representable r, CRing a) =>+    Hilbert r a where+    (<.>) a b = foldl' (+) zero $ liftR2 (*) a b++-- | tensorial tomfoolery+type family (><) (a::k1) (b::k2) :: *++type instance Int >< Int = Int+type instance Integer >< Integer = Integer+type instance Double >< Double = Double+type instance Float >< Float = Float++type family TensorRep k1 k2 where+    TensorRep (r a) (r a) = r (r a)+    TensorRep (r a) a = r a++type instance r a >< b = TensorRep (r a) b++-- | TensorAlgebra+class TensorProduct a where+    infix 8 ><+    (><) :: a -> a -> (a><a)+    timesleft :: a -> (a><a) -> a+    timesright :: (a><a) -> a -> a++instance (Foldable r, Representable r, CRing a ) =>+    TensorProduct (r a)+  where+    (><) m n = tabulate (\i -> index m i *. n)+    timesleft v m = tabulate (\i -> v <.> index m i)+    timesright m v = tabulate (\i -> v <.> index m i)

@@ -0,0 +1,186 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Multiplicate structure+-- Many treatments of a numeric tower treat multiplication differently to addition.  NumHask treats these two as exactly symmetrical, and thus departs from the usual mathematical terminology.++module NumHask.Algebra.Multiplicative (+   -- ** Multiplicative Structure+    MultiplicativeMagma(..)+  , MultiplicativeUnital(..)+  , MultiplicativeAssociative+  , MultiplicativeCommutative+  , MultiplicativeInvertible(..)+  , MultiplicativeHomomorphic(..)+  , MultiplicativeMonoidal+  , Multiplicative(..)+  , MultiplicativeRightCancellative(..)+  , MultiplicativeLeftCancellative(..)+  , MultiplicativeGroup(..)+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, Bool(..))+import Data.Functor.Rep++-- * Multiplicative structure+-- | 'times' is used for the multiplicative magma to distinguish from '*' which, by convention, implies commutativity+class MultiplicativeMagma a where times :: a -> a -> a++instance MultiplicativeMagma Double where times = (P.*)+instance MultiplicativeMagma Float where times = (P.*)+instance MultiplicativeMagma Int where times = (P.*)+instance MultiplicativeMagma Integer where times = (P.*)+instance MultiplicativeMagma Bool where times = (P.&&)+instance (Representable r, MultiplicativeMagma a) => MultiplicativeMagma (r a) where+    times = liftR2 times++-- | MultiplicativeUnital+--+-- > one `times` a == a+-- > a `times` one == a+class MultiplicativeMagma a => MultiplicativeUnital a where one :: a++instance MultiplicativeUnital Double where one = 1+instance MultiplicativeUnital Float where one = 1+instance MultiplicativeUnital Int where one = 1+instance MultiplicativeUnital Integer where one = 1+instance MultiplicativeUnital Bool where one = True+instance (Representable r, MultiplicativeUnital a) =>+    MultiplicativeUnital (r a) where+    one = pureRep one++-- | MultiplicativeCommutative+--+-- > a `times` b == b `times` a+class MultiplicativeMagma a => MultiplicativeCommutative a++instance MultiplicativeCommutative Double+instance MultiplicativeCommutative Float+instance MultiplicativeCommutative Int+instance MultiplicativeCommutative Integer+instance MultiplicativeCommutative Bool+instance (Representable r, MultiplicativeCommutative a) =>+    MultiplicativeCommutative (r a)++-- | MultiplicativeAssociative+--+-- > (a `times` b) `times` c == a `times` (b `times` c)+class MultiplicativeMagma a => MultiplicativeAssociative a++instance MultiplicativeAssociative Double+instance MultiplicativeAssociative Float+instance MultiplicativeAssociative Int+instance MultiplicativeAssociative Integer+instance MultiplicativeAssociative Bool+instance (Representable r, MultiplicativeAssociative a) =>+    MultiplicativeAssociative (r a)++-- | MultiplicativeInvertible+--+-- > ∀ a ∈ A: recip a ∈ A+--+-- law is true by construction in Haskell+class MultiplicativeMagma a => MultiplicativeInvertible a where recip :: a -> a++instance MultiplicativeInvertible Double where recip = P.recip+instance MultiplicativeInvertible Float where recip = P.recip+instance (Representable r, MultiplicativeInvertible a) =>+    MultiplicativeInvertible (r a) where+    recip = fmapRep recip++-- | MultiplicativeHomomorphic+--+-- > ∀ a ∈ A: timeshom a ∈ B+--+-- law is true by construction in Haskell+class ( MultiplicativeMagma b) =>+      MultiplicativeHomomorphic a b where+    timeshom :: a -> b++instance (Representable r, MultiplicativeMagma a) =>+    MultiplicativeHomomorphic a (r a) where+    timeshom a = pureRep a++instance MultiplicativeMagma a => MultiplicativeHomomorphic a a where+    timeshom a = a++-- | MultiplicativeMonoidal+class ( MultiplicativeUnital a+      , MultiplicativeAssociative a) =>+      MultiplicativeMonoidal a++instance MultiplicativeMonoidal Double+instance MultiplicativeMonoidal Float+instance MultiplicativeMonoidal Int+instance MultiplicativeMonoidal Integer+instance MultiplicativeMonoidal Bool+instance (Representable r, MultiplicativeMonoidal a) =>+    MultiplicativeMonoidal (r a)+++-- | Multiplicative is commutative, associative and unital under multiplication+--+-- > a * b = b * a+--+-- > (a * b) * c = a * (b * c)+--+-- > one * a = a+--+-- > a * one = a+--+class ( MultiplicativeCommutative a+      , MultiplicativeUnital a+      , MultiplicativeAssociative a) =>+      Multiplicative a where+    infixl 7 *+    (*) :: a -> a -> a+    a * b = times a b++instance Multiplicative Double+instance Multiplicative Float+instance Multiplicative Int+instance Multiplicative Integer+instance Multiplicative Bool+instance (Representable r, Multiplicative a) => Multiplicative (r a)++-- | Non-commutative left divide+class ( MultiplicativeUnital a+      , MultiplicativeAssociative a+      , MultiplicativeInvertible a) =>+      MultiplicativeLeftCancellative a where+    infixl 7 ~/+    (~/) :: a -> a -> a+    a ~/ b = recip b `times` a++-- | Non-commutative right divide+class ( MultiplicativeUnital a+      , MultiplicativeAssociative a+      , MultiplicativeInvertible a) =>+      MultiplicativeRightCancellative a where+    infixl 7 /~+    (/~) :: a -> a -> a+    a /~ b = a `times` recip b++-- | MultiplicativeGroup+--+-- > a / a = one+--+-- > recip a = one / a+--+-- > recip a * a = one+--+class ( Multiplicative a+      , MultiplicativeInvertible a) =>+      MultiplicativeGroup a where+    infixl 7 /+    (/) :: a -> a -> a+    (/) a b = a `times` recip b++instance MultiplicativeGroup Double+instance MultiplicativeGroup Float+instance (Representable r, MultiplicativeGroup a) => MultiplicativeGroup (r a)+

@@ -0,0 +1,217 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | A bit of extra Ordering taken from gaia.+module NumHask.Algebra.Ordering (+    -- * lattice+    POrd(..)+  , POrdering(..)+  , Topped(..)+  , Bottomed(..)+  , Bounded+  , Negated(..)+  , Semilattice+  , Lattice(..)+  , ord2pord+  ) where++import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, Bool(..), Ord(..), Eq(..), fst)+import Data.Coerce+import NumHask.Algebra.Magma++-- | Equal to, Less than, Greater than, Not comparable to+data POrdering = PEQ | PLT | PGT | PNC++-- | P's just to avoid name clashes+class POrd s where pcompare :: s -> s -> POrdering++-- | POrd+instance (Ord a) => POrd a where+    pcompare n m+        | n > m = PGT+        | n == m = PEQ+        | P.otherwise = PLT++-- | conversion+ord2pord :: P.Ordering -> POrdering+ord2pord P.EQ = PEQ+ord2pord P.LT = PLT+ord2pord P.GT = PGT++-- | Topped+class POrd s => Topped s where top :: s++-- | Bottomed+class POrd s => Bottomed s where bottom :: s++-- | Semilattice+class ( Associative a+      , Commutative a+      , Idempotent a) =>+      Semilattice a++-- | Replaces the Bounded in base.  Is this a good idea?+class ( Topped a+      , Bottomed a) =>+      Bounded a++instance Topped Int where top = P.maxBound+instance Bottomed Int where bottom = P.minBound+instance Bounded Int++instance Topped Bool where top = True+instance Bottomed Bool where bottom = False+instance Bounded Bool++-- | a nice Lattice, but the types explode the instance requirements+class (+    Coercible a (Sup a)+  , Coercible a (Inf a)+  , Semilattice (Sup a)+  , Semilattice (Inf a)+  , POrd a+  ) => Lattice a where+    type Inf a+    type Sup a+    (/\) :: a -> a -> a+    (/\) = coerce ((⊕) :: Sup a -> Sup a -> Sup a)+    (\/) :: a -> a -> a+    (\/) = coerce ((⊕) :: Inf a -> Inf a -> Inf a)++-- | which creates a nice alternative for negate+class (Lattice a, Isomorphic (Inf a) (Sup a) ) => Negated a where+    negated :: a -> a+    negated a = coerce (fst isomorph (coerce a :: Inf a) :: Sup a) :: a++-- Int+newtype InfInt = InfInt Int+newtype SupInt = SupInt Int++instance Magma InfInt where+    InfInt a ⊕ InfInt b = InfInt (if a <= b then a else b)++instance Magma SupInt where+    SupInt a ⊕ SupInt b = SupInt (if a >= b then a else b)++instance Associative InfInt+instance Associative SupInt++instance Commutative SupInt+instance Commutative InfInt++instance Idempotent SupInt+instance Idempotent InfInt++instance Homomorphic SupInt InfInt where hom (SupInt a) = InfInt (-a)+instance Homomorphic InfInt SupInt where hom (InfInt a) = SupInt (-a)++instance Isomorphic SupInt InfInt where isomorph = (hom, hom)+instance Isomorphic InfInt SupInt where isomorph = (hom, hom)++instance Semilattice SupInt+instance Semilattice InfInt++instance Lattice Int where+    type Inf Int = InfInt+    type Sup Int = SupInt++-- Integer+newtype InfInteger = InfInteger Integer+newtype SupInteger = SupInteger Integer++instance Magma InfInteger where+    InfInteger a ⊕ InfInteger b = InfInteger (if a <= b then a else b)++instance Magma SupInteger where+    SupInteger a ⊕ SupInteger b = SupInteger (if a >= b then a else b)++instance Associative InfInteger+instance Associative SupInteger++instance Commutative SupInteger+instance Commutative InfInteger++instance Idempotent SupInteger+instance Idempotent InfInteger++instance Homomorphic SupInteger InfInteger where hom (SupInteger a) = InfInteger (-a)+instance Homomorphic InfInteger SupInteger where hom (InfInteger a) = SupInteger (-a)++instance Isomorphic SupInteger InfInteger where isomorph = (hom, hom)+instance Isomorphic InfInteger SupInteger where isomorph = (hom, hom)++instance Semilattice SupInteger+instance Semilattice InfInteger++instance Lattice Integer where+    type Inf Integer = InfInteger+    type Sup Integer = SupInteger++-- Float+newtype InfFloat = InfFloat Float+newtype SupFloat = SupFloat Float++instance Magma InfFloat where+    InfFloat a ⊕ InfFloat b = InfFloat (if a <= b then a else b)++instance Magma SupFloat where+    SupFloat a ⊕ SupFloat b = SupFloat (if a >= b then a else b)++instance Associative InfFloat+instance Associative SupFloat++instance Commutative SupFloat+instance Commutative InfFloat++instance Idempotent SupFloat+instance Idempotent InfFloat++instance Homomorphic SupFloat InfFloat where hom (SupFloat a) = InfFloat (-a)+instance Homomorphic InfFloat SupFloat where hom (InfFloat a) = SupFloat (-a)++instance Isomorphic SupFloat InfFloat where isomorph = (hom, hom)+instance Isomorphic InfFloat SupFloat where isomorph = (hom, hom)++instance Semilattice SupFloat+instance Semilattice InfFloat++instance Lattice Float where+    type Inf Float = InfFloat+    type Sup Float = SupFloat++-- Double+newtype InfDouble = InfDouble Double+newtype SupDouble = SupDouble Double++instance Magma InfDouble where+    InfDouble a ⊕ InfDouble b = InfDouble (if a <= b then a else b)++instance Magma SupDouble where+    SupDouble a ⊕ SupDouble b = SupDouble (if a >= b then a else b)++instance Associative InfDouble+instance Associative SupDouble++instance Commutative SupDouble+instance Commutative InfDouble++instance Idempotent SupDouble+instance Idempotent InfDouble++instance Homomorphic SupDouble InfDouble where hom (SupDouble a) = InfDouble (-a)+instance Homomorphic InfDouble SupDouble where hom (InfDouble a) = SupDouble (-a)++instance Isomorphic SupDouble InfDouble where isomorph = (hom, hom)+instance Isomorphic InfDouble SupDouble where isomorph = (hom, hom)++instance Semilattice SupDouble+instance Semilattice InfDouble++instance Lattice Double where+    type Inf Double = InfDouble+    type Sup Double = SupDouble+

@@ -0,0 +1,57 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Rings+-- An interesting feature of the NumHask structure is the importance of the commutative Ring ('CRing'), which is a class often needed higher up the class tree.+module NumHask.Algebra.Ring (+    -- * Ring+    Semiring+  , Ring+  , CRing+  ) where++import Protolude (Double, Float, Int, Integer,Bool(..))+import Data.Functor.Rep+import NumHask.Algebra.Additive+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Distribution++-- | a semiring+class ( Additive a+      , MultiplicativeAssociative a+      , MultiplicativeUnital a+      , Distribution a) =>+      Semiring a++instance Semiring Double+instance Semiring Float+instance Semiring Int+instance Semiring Integer+instance Semiring Bool+instance (Representable r, Semiring a) => Semiring (r a)++-- | Ring+class ( AdditiveGroup a+      , MultiplicativeAssociative a+      , MultiplicativeUnital a+      , Distribution a) =>+      Ring a++instance Ring Double+instance Ring Float+instance Ring Int+instance Ring Integer+instance (Representable r, Ring a) => Ring (r a)++-- | CRing is a Commutative Ring.  It arises often due to * being defined as only multiplicative commutative.+class ( Multiplicative a, Ring a) => CRing a++instance CRing Double+instance CRing Float+instance CRing Int+instance CRing Integer+instance (Representable r, CRing a) => CRing (r a)+

@@ -0,0 +1,167 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}++-- | NumHask usage examples++module NumHask.Examples (+    -- * Examples++    -- ** Imports and Pragmas+    -- $imports+    -- $setup++    -- ** Basic Arithmetic+    -- $basic++    -- ** Vectors+    -- $vector++    ) where++import NumHask.Prelude()++-- $imports+-- NumHask.Prelude is a complete replacement for the standard prelude.+--+-- 'NoImplicitPrelude' is explicitly required as a pragma, and 'ExtendedDefaultRules' is needed to avoid having to explicitly type literal numbers.+--+-- $setup+-- >>> :set -XNoImplicitPrelude+-- >>> :set -XExtendedDefaultRules+-- >>> 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)+-- ... arising from a use of ‘/’+-- ...+--+-- >>> 1 / fromIntegral (1::Int)+-- 1.0+-- +-- >>> 1 `div` 2+-- 0+--+-- >>> 3 `mod` 2+-- 1+--+-- '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+--+-- 'BoundedField' lets divide by zero work for 'Float's and 'Double's.+--+-- >>> one/zero+-- Infinity+--+-- >>> -one/zero+-- -Infinity+--+-- >>> zero/zero+one+-- NaN+-- +-- >>> logBase 2 4+-- 2.0+-- +-- >>> 2 ** 2+-- 4.0+-- +-- >>> sqrt 4+-- 2.0+-- +-- >>> exp 2+-- 7.38905609893065+--+-- >>> log 2+-- 0.6931471805599453+--+-- $vector+-- A 'Vector' is a number by virtue of it being a 'Representable' 'Functor' where the representation is an 'Int'.+--+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> [] :: Vector 3 Int+-- [0,0,0]+--+-- >>> let a = [1..] :: Vector 3 Int+-- >>> a+-- [1,2,3]+--+-- >>> let b = [3,2] :: Vector 3 Int+-- >>> b+-- [3,2,0]+--+-- >>> let c = [1.0,2.0] :: Vector 3 Float+-- >>> let d = [3.0,2.0] :: Vector 3 Float+--+-- >>> a+zero==a+-- True+-- >>> zero+a==a+-- True+-- >>> a+b+-- [4,4,3]+--+-- >>> a-a == zero+-- True+--+-- >>> a * b+-- [3,4,0]+--+-- >>> let a' = unsafeToVector . someVector $ a :: Vector 2 Int+-- >>> let b' = unsafeToVector . someVector $ b :: Vector 2 Int+-- >>> a' `divMod` b'+-- ([0,1],[1,0])+--+-- >>> c / d+-- [0.33333334,1.0,NaN]+--+-- >>> :set -XFlexibleContexts+-- >>> size c :: Float+-- 2.236068+--+-- >>> distance c d :: Float+-- 2.0+--+-- >>> c <.> d :: Float+-- 7.0+--+-- The type of an outer product of two vectors is a Vector m (Vector n), and is a perfectly formed Matrix representation.+-- >>> a >< b+-- [[3,2,0],[6,4,0],[9,6,0]]+--+-- >>> (a >< b) >< (b >< a)+-- [[[9,12,0],[6,8,0],[0,0,0]],[[18,24,0],[12,16,0],[0,0,0]],[[27,36,0],[18,24,0],[0,0,0]]]+

@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- | multi-dimensional numbers with a shape++module NumHask.HasShape where++import Protolude (Int)++-- | Could possibly be integrated with 'Representable' instance creation+class HasShape f where+    type Shape f+    shape :: (HasShape f) => f -> Shape f+    ndim :: (HasShape f) => f -> Int+

@@ -0,0 +1,204 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Two-dimensional arrays. Two classes are supplied+--+-- - 'Matrix' where shape information is held at type level, and+-- - 'SomeMatrix' where shape is held at the value level.+--+-- In both cases, the underlying data is contained as a flat vector for efficiency purposes.++module NumHask.Matrix+  ( Matrix(..)+  , SomeMatrix(..)+  , ShapeM(..)+    -- * Conversion+  , someMatrix+  , unsafeToMatrix+  , toMatrix+  , unsafeFromVV+  , toCol+  , toRow+  , fromCol+  , fromRow+  , col+  , row+    -- * Operations+  , mmult+  ) where++import qualified Protolude as P+import Protolude+    (($), Functor(..), Show, Eq(..), (.), (<$>), Foldable(..), Int, Maybe(..))+import Data.Distributive as D+import Data.Functor.Rep+import Data.Proxy (Proxy(..))+import GHC.TypeLits+import NumHask.Algebra.Additive+import NumHask.Algebra.Integral+import NumHask.Algebra.Module+import NumHask.Algebra.Multiplicative+import NumHask.Algebra.Ring+import NumHask.HasShape+import NumHask.Vector+import Test.QuickCheck+import qualified Data.Vector as V+import GHC.Show+import GHC.Exts++-- | a two-dimensional array where shape is specified at the type level+-- The main purpose of this, beyond safe typing, is to supply the Representable instance with an initial object.+-- A single Boxed 'Data.Vector.Vector' is used underneath for efficient slicing, but this may change or become polymorphic in the future.+newtype Matrix m n a = Matrix { flattenMatrix :: V.Vector a }+    deriving (Functor, Eq, Foldable)++-- | a two-dimensional array where shape is specified at the value level as a '(Int,Int)'+-- Use this to avoid type-level hasochism by demoting a 'Matrix' with 'someMatrix'+data SomeMatrix a = SomeMatrix (Int,Int) (V.Vector a)+    deriving (Functor, Eq, Foldable)++instance HasShape (SomeMatrix a) where+    type Shape (SomeMatrix a) = (Int,Int)+    shape (SomeMatrix sh _) = sh+    ndim = P.length . shape++instance forall a m n. (KnownNat m, KnownNat n) =>+    HasShape (Matrix (m::Nat) (n::Nat) a) where+    type Shape (Matrix m n a) = (Int,Int)+    shape = shapeM+    ndim = P.length . shape++-- | the shape value demoted from type-level+shapeM :: forall a m n. (KnownNat m, KnownNat n) => Matrix (m::Nat) (n::Nat) a -> (Int, Int)+shapeM _ = ( P.fromInteger $ natVal (Proxy :: Proxy m)+           , P.fromInteger $ natVal (Proxy :: Proxy n))++instance (Show a) => Show (SomeMatrix a) where+    show (SomeMatrix _ v) = show (P.toList v)++instance (Show a, KnownNat m, KnownNat n) => Show (Matrix (m::Nat) (n::Nat) a) where+    show = show . someMatrix++-- ** conversion++-- | convert from a 'Matrix' to a 'SomeMatrix'+someMatrix :: (KnownNat m, KnownNat n) => Matrix (m::Nat) (n::Nat) a -> SomeMatrix a+someMatrix v = SomeMatrix (shape v) (flattenMatrix v)++-- | convert from a 'SomeMatrix' to a 'Matrix' with no shape check+unsafeToMatrix :: SomeMatrix a -> Matrix (m::Nat) (n::Nat) a+unsafeToMatrix (SomeMatrix _ v) = Matrix v++-- | convert from a 'SomeMatrix' to a 'Matrix', checking shape+toMatrix :: forall a m n. (KnownNat m, KnownNat n) => SomeMatrix a ->+    Maybe (Matrix (m::Nat) (n::Nat) a)+toMatrix (SomeMatrix s v) = if s==(m,n) then Just $ Matrix v else Nothing+  where+    m = P.fromInteger $ natVal (Proxy :: Proxy m)+    n = P.fromInteger $ natVal (Proxy :: Proxy n)++-- | from flat list+instance (KnownNat m, KnownNat n, AdditiveUnital a) => IsList (Matrix m n a) where+    type Item (Matrix m n a) = a+    fromList l = Matrix $ V.fromList $ P.take (m*n) $ l P.++ P.repeat zero+      where+        m = P.fromInteger $ natVal (Proxy :: Proxy m)+        n = P.fromInteger $ natVal (Proxy :: Proxy n)+    toList (Matrix v) = V.toList v++-- | from nested list+instance IsList (SomeMatrix a) where+    type Item (SomeMatrix a) = [a]+    fromList l =+        SomeMatrix (P.length l,P.length $ P.head l) (V.fromList $ P.mconcat l)+    toList (SomeMatrix (m,n) v) =+        (\i -> V.toList $ V.unsafeSlice (i*n) n v) <$> [0..(m - 1)]++-- | just used to get sensible arbitrary instances of SomeMatrix+newtype ShapeM = ShapeM { unshapeM :: (Int,Int) }++instance Arbitrary ShapeM where+    arbitrary =+        (\m n -> ShapeM (unshapeV m, unshapeV n)) <$> arbitrary P.<*> arbitrary++instance (Arbitrary a) => Arbitrary (SomeMatrix a) where+    arbitrary = frequency+        [ (1, P.pure (SomeMatrix (zero,zero) V.empty))+        , (9,fromList <$>+             (P.take <$>+              ((\m n -> unshapeV m * unshapeV n) <$> arbitrary P.<*> arbitrary) P.<*>+              vector 20))+        ]++instance (KnownNat m, KnownNat n, Arbitrary a, AdditiveUnital a) => Arbitrary (Matrix m n a) where+    arbitrary = frequency+        [ (1, P.pure zero)+        , (9,fromList <$> vector (m*n))+        ]+      where+        n = P.fromInteger $ natVal (Proxy :: Proxy n)+        m = P.fromInteger $ natVal (Proxy :: Proxy m)++instance (KnownNat m, KnownNat n) => Distributive (Matrix m n) where+    distribute f = Matrix $ V.generate (n*m)+        $ \i -> fmap (\(Matrix v) -> V.unsafeIndex v i) f+      where+        m = P.fromInteger $ natVal (Proxy :: Proxy m)+        n = P.fromInteger $ natVal (Proxy :: Proxy n)++instance (KnownNat m, KnownNat n) => Representable (Matrix m n) where+    type Rep (Matrix m n) = (P.Int, P.Int)+    tabulate f = Matrix $ V.generate (m*n) (\x -> f (divMod x (m*n)))+      where+        m = P.fromInteger $ natVal (Proxy :: Proxy m)+        n = P.fromInteger $ natVal (Proxy :: Proxy n)+    index (Matrix xs) (i0,i1) = xs V.! (i0*m + i1)+      where+        m = P.fromInteger $ natVal (Proxy :: Proxy m)++-- | conversion from a double Vector representation+unsafeFromVV :: forall a m n. ( ) => Vector m (Vector n a) -> Matrix m n a+unsafeFromVV vv = Matrix $ P.foldr ((V.++) . toVec) V.empty vv++-- | convert a 'Vector' to a column 'Matrix'+toCol :: forall a n. ( ) => Vector n a -> Matrix 1 n a+toCol v = Matrix $ toVec v++-- | convert a 'Vector' to a row 'Matrix'+toRow :: forall a m. ( ) => Vector m a -> Matrix m 1 a+toRow v = Matrix $ toVec v++-- | convert a row 'Matrix' to a 'Vector'+fromCol :: forall a n. ( ) => Matrix 1 n a -> Vector n a+fromCol m = Vector $ flattenMatrix m++-- | convert a column 'Matrix' to a 'Vector'+fromRow :: forall a m. ( ) => Matrix m 1 a -> Vector m a+fromRow m = Vector $ flattenMatrix m++-- | extract a row from a 'Matrix' as a 'Vector'+row :: forall a m n. (KnownNat m, KnownNat n) => P.Int -> Matrix m n a -> Vector n a+row i (Matrix a) = Vector $ V.unsafeSlice (i*m) n a+  where+    m = P.fromInteger $ natVal (Proxy :: Proxy m)+    n = P.fromInteger $ natVal (Proxy :: Proxy n)++-- | extract a column from a 'Matrix' as a 'Vector'+col :: forall a m n. (KnownNat m, KnownNat n) => P.Int -> Matrix m n a -> Vector m a+col i (Matrix a) = Vector $ V.generate m (\x -> a V.! (i+x*n))+  where+    m = P.fromInteger $ natVal (Proxy :: Proxy m)+    n = P.fromInteger $ natVal (Proxy :: Proxy n)++-- ** Operations+-- | matrix multiplication for a 'Matrix'+mmult :: forall m n k a. (CRing a, KnownNat m, KnownNat n, KnownNat k) =>+    Matrix m k a -> Matrix k n a -> Matrix m n a+mmult x y = tabulate (\(i,j) -> row i x <.> col j y)

@@ -0,0 +1,60 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}++-- | Orphan instances for conversion between Num and NumHask classes.++module NumHask.Num (+  ) where++import Protolude+import qualified NumHask.Algebra as N+import Data.Functor.Rep++-- | NumHask instances for Num instanced classes+-- not compatible with most other NumHask modules+instance (Num a) => N.AdditiveMagma a where plus = (+)+instance (Num a) => N.AdditiveUnital a where zero = 0+instance (Num a) => N.AdditiveAssociative a+instance (Num a) => N.AdditiveCommutative a+instance (Num a) => N.AdditiveInvertible a where negate = negate+instance (Num a) => N.Additive a+instance (Num a) => N.AdditiveGroup a+instance (Num a) => N.MultiplicativeMagma a where times = (*)+instance (Num a) => N.MultiplicativeUnital a where one = 1+instance (Num a) => N.MultiplicativeCommutative a+instance (Num a) => N.MultiplicativeAssociative a+instance (Fractional a) => N.MultiplicativeInvertible a where recip = recip+instance (Num a) => N.Multiplicative a+instance (Fractional a) => N.MultiplicativeGroup a+instance (Num a) => N.Distribution a+instance (Num a) => N.Semiring a+instance (Num a) => N.Ring a+instance (Num a) => N.CRing a+instance (Fractional a) => N.Field a+instance (Num a) => N.Normed a a where size = abs++-- | Num instance for something built with NumHask+instance ( N.Additive a+         , N.Signed a+         , N.FromInteger a) =>+         Num a where+    (+) = (N.+)+    (-) = (N.-)+    (*) = (N.-)+    negate = N.negate+    signum = N.sign+    abs = N.abs+    fromInteger = N.fromInteger++-- | Num instance for a Representable+instance ( Representable r+         , Num a ) =>+         Num (r a) where+    (+) = liftR2 (+)+    (-) = liftR2 (-)+    (*) = liftR2 (*)+    negate = fmapRep negate+    signum = fmapRep signum+    abs = fmapRep abs+    fromInteger = pureRep . fromInteger+

@@ -0,0 +1,100 @@+{-# OPTIONS_GHC -Wall #-}++-- | A prelude for NumHask++module NumHask.Prelude (+    -- * Backend+    -- $backend+    module Protolude+  , module Data.Distributive+  , module Data.Functor.Rep+    -- * Algebraic Heirarchy+    -- $instances+  , module NumHask.Algebra.Additive+  , module NumHask.Algebra.Basis+  , module NumHask.Algebra.Distribution+  , module NumHask.Algebra.Exponential+  , 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.Ordering+  , module NumHask.Algebra.Ring+    -- * Representations+    -- $representables+  , module NumHask.Matrix+  , module NumHask.Tensor+  , module NumHask.Vector+  , module NumHask.HasShape+  ) where++import Protolude hiding+    ( (+)+    , (-)+    , (*)+    , (/)+    , zero+    , negate+    , recip+    , Integral(..)+    , round+    , ceiling+    , floor+    , (^^)+    , Semiring(..)+    , log+    , logBase+    , exp+    , sqrt+    , (**)+    , abs+    , (^)+    , infinity+    , Bounded(..)+    , isNaN+    , fromIntegral+    , toInteger+    , fromInteger+    , Rep+    )++import NumHask.Algebra.Additive+import NumHask.Algebra.Basis+import NumHask.Algebra.Distribution+import NumHask.Algebra.Exponential+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.Ordering+import NumHask.Algebra.Ring++import NumHask.Matrix+import NumHask.Tensor+import NumHask.Vector+import NumHask.HasShape++import Data.Distributive+import Data.Functor.Rep++-- $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 'Representable' Functors are supplied+--++-- $representables+-- Different classes are supplied for holding shape information at the type level and value level.+--+-- Value-level classes are not (yet) wired in to the Algebra+--+-- Type-level shaped numbers are wired in via the 'Representable' 'Functor' instances.+--

@@ -0,0 +1,199 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- | N-dimensional arrays. Two classes are supplied:+--+-- - 'Tensor' where shape information is held at type level, and+-- - 'SomeTensor' where shape is held at the value level.+--+-- In both cases, the underlying data is contained as a flat vector for efficiency purposes.++module NumHask.Tensor+  ( Tensor(..)+  , SomeTensor(..)+  -- * Conversion+  , someTensor+  , unsafeToTensor+  , toTensor+  , flatten1+  ) where++import qualified Protolude as P+import Protolude+    (($), (<$>), Functor(..), Show, Eq(..), (.), Maybe(..), Int, reverse, foldr, fst, zipWith, scanr, drop, sum, product, Foldable(..))++import Data.Distributive as D+import Data.Functor.Rep+import Data.Singletons+import Data.Singletons.Prelude+import GHC.Exts+import GHC.Show+import GHC.TypeLits+import NumHask.Algebra.Additive+import NumHask.Algebra.Integral+import NumHask.Algebra.Multiplicative+import Test.QuickCheck+import qualified Data.Vector as V+import NumHask.HasShape++-- | an n-dimensional array where shape is specified at the type level+-- The main purpose of this, beyond safe typing, is to supply the Representable instance with an initial object.+-- A single Boxed 'Data.Vector.Vector' is used underneath for efficient slicing, but this may change or become polymorphic in the future.+newtype Tensor r a = Tensor { flattenTensor :: V.Vector a }+    deriving (Functor, Eq, Foldable)++instance (SingI r) => HasShape (Tensor (r::[Nat]) a) where+    type Shape (Tensor r a) = [Int]+    shape = shapeT+    ndim = P.length . shape++instance HasShape (SomeTensor a) where+    type Shape (SomeTensor a) = [Int]+    shape (SomeTensor sh _) = sh+    ndim = P.length . shape++-- | extract shape from type-level+shapeT :: forall a r. (SingI r) => Tensor (r :: [Nat]) a -> [Int]+shapeT _ =+    case (sing :: Sing r) of+      SNil -> []+      (SCons x xs) -> fmap P.fromIntegral (fromSing x: fromSing xs)++-- not sure how to combine this with HasShape+newtype ShapeT = ShapeT {unshapeT :: [Int]} deriving (Show, Eq)++-- | an n-dimensional array where shape is specified at the value level as an '[Int]'+-- Use this to avoid type-level hasochism by demoting a 'Tensor' with 'someTensor'+data SomeTensor a = SomeTensor [Int] (V.Vector a)+    deriving (Functor, Eq, Foldable)++instance (Show a) => Show (SomeTensor a) where+    show r@(SomeTensor l _) = go (P.length l) r+      where+        go n r'@(SomeTensor l' v') = case P.length l' of+          0 -> show $ V.head v'+          1 -> "[" P.++ P.intercalate ", " (show <$> P.toList v') P.++ "]"+          x -> +              "[" P.+++              P.intercalate+              (",\n" P.++ P.replicate (n-x+1) ' ')+              (go n <$> flatten1 r') P.+++              "]"++instance (Show a, SingI r) => Show (Tensor (r::[Nat]) a) where+    show = show . someTensor++-- * Conversion+-- | convert a 'Tensor' to a 'SomeTensor', losing the type level shape+someTensor :: (SingI r) => Tensor (r::[Nat]) a -> SomeTensor a+someTensor n = SomeTensor (shape n) (flattenTensor n)++-- | convert a 'SomeTensor' to a 'Tensor' with no checks on shape.+unsafeToTensor :: SomeTensor a -> Tensor (r::[Nat]) a+unsafeToTensor (SomeTensor _ v) = Tensor v++-- | convert a 'SomeTensor' to a 'Tensor', check for shape equality.+toTensor :: forall a r. (SingI r) => SomeTensor a -> Maybe (Tensor (r::[Nat]) a)+toTensor (SomeTensor sh v) = if sh==sh' then Just (Tensor v) else Nothing+  where+    sh' = case (sing :: Sing r) of+            SNil -> []+            (SCons x xs) -> fmap P.fromIntegral (fromSing x: fromSing xs)++-- | convert the top layer of a SomeTensor to a [SomeTensor]+flatten1 :: SomeTensor a -> [SomeTensor a]+flatten1 (SomeTensor rep v) = (\s -> SomeTensor (drop 1 rep) (V.unsafeSlice (s*l) l v)) <$> ss+    where+      n = P.fromMaybe 0 $ P.head rep+      ss = P.take n [0..]+      l = product $ drop 1 rep++ind :: [Int] -> [Int] -> Int+ind ns xs = sum $ zipWith (*) xs (drop 1 $ scanr (*) 1 (reverse ns))++unfoldI :: forall t. Integral t => [t] -> t -> ([t], t)+unfoldI ns x =+    foldr+    (\a (acc,rem) -> let (d,m) = divMod rem a in (m:acc,d))+    ([],x)+    (P.reverse ns)++unind :: [Int] -> Int -> [Int]+unind ns x= fst $ unfoldI ns x++instance forall (r :: [Nat]). (SingI r) => Distributive (Tensor r) where+    distribute f = Tensor $ V.generate n+        $ \i -> fmap (\(Tensor v) -> V.unsafeIndex v i) f+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs) -> fmap P.fromInteger (fromSing x: fromSing xs)+        n = P.foldr (*) one ns++instance forall (r :: [Nat]). (SingI r) => Representable (Tensor r) where+    type Rep (Tensor r) = [Int]+    tabulate f = Tensor $ V.generate n (f . unind ns)+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs) -> fmap P.fromIntegral (fromSing x: fromSing xs)+        n = P.foldr (*) one ns+    index (Tensor xs) rs = xs V.! ind ns rs+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs') -> fmap P.fromIntegral (fromSing x: fromSing xs')++-- | from flat list+instance (SingI r, AdditiveUnital a) => IsList (Tensor (r::[Nat]) a) where+    type Item (Tensor r a) = a+    fromList l = Tensor $ V.fromList $ P.take n $ l P.++ P.repeat zero+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs') -> fmap P.fromIntegral (fromSing x: fromSing xs')+        n = product ns+    toList (Tensor v) = V.toList v++-- | not sure if an arbitraryly-nested list can be converted to a 'SomeTensor'+fromListSomeTensor :: forall a. (AdditiveUnital a) => [Int] -> [a] -> SomeTensor a+fromListSomeTensor ns l = SomeTensor ns (V.fromList $ P.take n $ l P.++ P.repeat zero)+  where+    n = P.foldr (*) one ns++instance Arbitrary ShapeT where+    arbitrary = frequency+        [ (1, P.pure (ShapeT []))+        -- , (1, Shape . (:[]) <$> arbitrary)+        , (1, ShapeT . (:[]) <$> n)+        , (1, ShapeT <$> ((\x y -> [x,y]) <$> n P.<*> n))+        , (1, ShapeT <$> ((\x y z -> [x,y,z]) <$> n P.<*> n P.<*> n))+        ]+      where+        n = frequency [(1,P.pure 1),(1,P.pure 2),(1,P.pure 3)]++instance forall a (r :: [Nat]). (SingI r, Arbitrary a, AdditiveUnital a) => Arbitrary (Tensor r a) where+    arbitrary = frequency+        [ (1, P.pure zero)+        , (9, fromList <$> vector n)+        ]+      where+        ns = case (sing :: Sing r) of+               SNil -> []+               (SCons x xs) -> fmap P.fromInteger (fromSing x: fromSing xs)+        n = P.foldr (*) one ns++instance forall a. (Arbitrary a, AdditiveUnital a) => Arbitrary (SomeTensor a) where+    arbitrary = frequency+        [ (1, P.pure (SomeTensor [] V.empty))+        , (9, fromListSomeTensor <$> (unshapeT <$> arbitrary) P.<*> vector 48)+        ]

@@ -0,0 +1,136 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedLists #-}+{-# OPTIONS_GHC -Wall #-}++-- | Two different classes are supplied:+--+-- - 'Vector' where shape information is held at the type level, and+-- - 'SomeVector' where shape is held at the value level.++module NumHask.Vector+  ( Vector(..)+  , SomeVector(..)+  , ShapeV(..)+  , shapeV+    -- ** Conversion+  , someVector+  , unsafeToVector+  , toVector+  ) where++import qualified Protolude as P+import Protolude+    (($), (<$>), Functor(..), Show, Eq(..), take, Foldable(..), Ord(..), Int, Maybe(..), (.))++import Data.Distributive as D+import Data.Functor.Rep+import Data.Proxy (Proxy(..))+import GHC.Exts+import GHC.Show (show)+import GHC.TypeLits+import NumHask.Algebra.Additive+import NumHask.HasShape+import Test.QuickCheck+import qualified Data.Vector as V++-- | a one-dimensional array where shape is specified at the type level+-- The main purpose of this, beyond safe typing, is to supply the Representable instance with an initial object.+-- A Boxed 'Data.Vector.Vector' is used underneath for efficient slicing, but this may change or become polymorphic in the future.+newtype Vector (n::Nat) a = Vector { toVec :: V.Vector a }+    deriving (Functor, Eq, Foldable, Ord)++-- | a one-dimensional array where shape is specified at the value level+-- Use this to avoid type-level hasochism by demoting a 'Vector' with 'someVector'+data SomeVector a = SomeVector Int (V.Vector a)+    deriving (Functor, Eq, Foldable, Ord)++instance HasShape (SomeVector a) where+    type Shape (SomeVector a) = Int+    shape (SomeVector sh _) = sh+    ndim _ = 1++instance forall a r. (KnownNat r) =>+    HasShape (Vector (r::Nat) a) where+    type Shape (Vector r a) = Int+    shape = shapeV+    ndim _ = 1++instance (Show a) => Show (SomeVector a) where+    show (SomeVector _ v) = show (P.toList v)++instance (Show a, KnownNat n) => Show (Vector (n::Nat) a) where+    show = show . someVector++-- ** conversion+-- | the shape value demoted from type-level+shapeV :: forall a r. (KnownNat r) => Vector (r :: Nat) a -> Int+shapeV _ = P.fromInteger $ natVal (Proxy :: Proxy r)++-- | convert from a 'Vector' to a 'SomeVector'+someVector :: (KnownNat r) => Vector (r::Nat) a -> SomeVector a+someVector v = SomeVector (shapeV v) (toVec v)++-- | convert from a 'SomeVector' to a 'Vector' with no shape check+unsafeToVector :: SomeVector a -> Vector (r::Nat) a+unsafeToVector (SomeVector _ v) = Vector v++-- | convert from a 'SomeVector' to a 'Vector', checking shape+toVector :: forall a r. (KnownNat r) => SomeVector a -> Maybe (Vector (r::Nat) a)+toVector (SomeVector s v) = if s==n then Just $ Vector v else Nothing+  where+    n = P.fromInteger $ natVal (Proxy :: Proxy r)++-- | pads with 'zero' if needed+instance (KnownNat n, AdditiveUnital a) => IsList (Vector n a) where+    type Item (Vector n a) = a+    fromList l = Vector $ V.fromList $ P.take n $ l P.++ P.repeat zero+      where+        n = P.fromInteger $ natVal (Proxy :: Proxy n)+    toList (Vector v) = V.toList v++instance IsList (SomeVector a) where+    type Item (SomeVector a) = a+    fromList l = SomeVector (P.length l) (V.fromList l)+    toList (SomeVector _ v) = V.toList v++-- | used to get sensible arbitrary instances of SomeVector+newtype ShapeV = ShapeV { unshapeV :: Int }++instance Arbitrary ShapeV where+    arbitrary = frequency+        [ (1, P.pure $ ShapeV 0)+        , (1, P.pure $ ShapeV 1)+        , (1, P.pure $ ShapeV 2)+        , (1, P.pure $ ShapeV 3)+        , (1, P.pure $ ShapeV 6)+        , (1, P.pure $ ShapeV 20)+        ]++instance (Arbitrary a) => Arbitrary (SomeVector a) where+    arbitrary = frequency+        [ (1, P.pure (SomeVector 0 V.empty))+        , (9, fromList <$> (take <$> (unshapeV <$> arbitrary) P.<*> vector 20))+        ]++instance (KnownNat n, Arbitrary a, AdditiveUnital a) => Arbitrary (Vector n a) where+    arbitrary = frequency+        [ (1, P.pure zero)+        , (9, fromList <$> vector n)+        ]+      where+        n = P.fromInteger $ natVal (Proxy :: Proxy n)++instance KnownNat n => D.Distributive (Vector n) where+    distribute f = Vector $ V.generate n $ \i -> fmap (\(Vector v) -> V.unsafeIndex v i) f+      where+        n = P.fromInteger $ natVal (Proxy :: Proxy n)++instance KnownNat n => Representable (Vector n) where+    type Rep (Vector n) = P.Int+    tabulate = Vector P.. V.generate n0+      where+        n0 = P.fromInteger $ natVal (Proxy :: Proxy n)+    index (Vector xs) i = xs V.! i

@@ -0,0 +1,859 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# OPTIONS_GHC -Wall #-}++module Main where++import NumHask.Prelude++import Test.Tasty (TestName, TestTree, testGroup, defaultMain, localOption)+import Test.Tasty.QuickCheck+import Test.DocTest+-- import Test.QuickCheck++main :: IO ()+main = do+    doctest ["src/NumHask/Examples.hs"]+    defaultMain tests++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) |+    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, Failiary2 f) = testProperty name f++tests :: TestTree+tests =+    testGroup "NumHask"+    [ testsInt+    , testsFloat+    , testsBool+    , testsVInt+    , testsVFloat+    , testsMInt+    , testsMFloat+    , testsNInt+    , testsNShow+    ]++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]) <$>+      boundedFieldLaws+    , testGroup "Metric" $ testLawOf ([]::[Float]) <$> metricFloatLaws+    , testGroup "Quotient Field" $ testLawOf ([]::[Float]) <$>+      quotientFieldLaws+    , testGroup "Exponential Ring" $ testLawOf ([]::[Float]) <$> expRingLaws+    , 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+    ]++testsVInt :: TestTree+testsVInt = testGroup "Vector 6 Int"+    [ testGroup "Additive" $ testLawOf ([]::[Vector 6 Int]) <$>+      additiveLaws+    , testGroup "Additive Group" $ testLawOf ([]::[Vector 6 Int]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative" $ testLawOf ([]::[Vector 6 Int]) <$>+      multiplicativeLaws+    , testGroup "Distribution" $ testLawOf ([]::[Vector 6 Int])+      <$> distributionLaws+    , testGroup "Additive Module" $ testLawOf2 ([]::[(Vector 6 Int, Int)]) <$>+      additiveModuleLaws+    , testGroup "Additive Group Module" $ testLawOf2 ([]::[(Vector 6 Int, Int)]) <$>+      additiveGroupModuleLaws+    , testGroup "Multiplicative Module" $ testLawOf2 ([]::[(Vector 6 Int, Int)]) <$>+      multiplicativeModuleLaws+    , testGroup "Additive Basis" $ testLawOf ([]::[Vector 6 Int]) <$>+      additiveBasisLaws+    , testGroup "Additive Group Basis" $ testLawOf ([]::[Vector 6 Int]) <$>+      additiveGroupBasisLaws+    , testGroup "Multiplicative Basis" $ testLawOf ([]::[Vector 6 Int]) <$>+      multiplicativeBasisLaws+    ]++testsMInt :: TestTree+testsMInt = testGroup "Matrix 4 3 Int"+    [ testGroup "Additive" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      additiveLaws+    , testGroup "Additive Group" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      multiplicativeLaws+    , testGroup "Distribution" $ testLawOf ([]::[Matrix 4 3 Int])+      <$> distributionLaws+    , testGroup "Additive Module" $ testLawOf2 ([]::[(Matrix 4 3 Int, Int)]) <$>+      additiveModuleLaws+    , testGroup "Additive Group Module" $ testLawOf2 ([]::[(Matrix 4 3 Int, Int)]) <$>+      additiveGroupModuleLaws+    , testGroup "Multiplicative Module" $ testLawOf2 ([]::[(Matrix 4 3 Int, Int)]) <$>+      multiplicativeModuleLaws+    , testGroup "Additive Basis" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      additiveBasisLaws+    , testGroup "Additive Group Basis" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      additiveGroupBasisLaws+    , testGroup "Multiplicative Basis" $ testLawOf ([]::[Matrix 4 3 Int]) <$>+      multiplicativeBasisLaws+    ]++testsNInt :: TestTree+testsNInt = testGroup "Tensor [2,3,2] Int"+    [ testGroup "Additive" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      additiveLaws+    , testGroup "Additive Group" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      multiplicativeLaws+    , testGroup "Distribution" $ testLawOf ([]::[Tensor [2,3,2] Int])+      <$> distributionLaws+    , testGroup "Additive Module" $ testLawOf2 ([]::[(Tensor [2,3,2] Int, Int)]) <$>+      additiveModuleLaws+    , testGroup "Additive Group Module" $ testLawOf2 ([]::[(Tensor [2,3,2] Int, Int)]) <$>+      additiveGroupModuleLaws+    , testGroup "Multiplicative Module" $ testLawOf2 ([]::[(Tensor [2,3,2] Int, Int)]) <$>+      multiplicativeModuleLaws+    , testGroup "Additive Basis" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      additiveBasisLaws+    , testGroup "Additive Group Basis" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      additiveGroupBasisLaws+    , testGroup "Multiplicative Basis" $ testLawOf ([]::[Tensor [2,3,2] Int]) <$>+      multiplicativeBasisLaws+    ]++testsNShow :: TestTree+testsNShow = testGroup "NRep Int"+    [ testProperty "ok arbitrary" (const True :: SomeTensor Int -> Bool)+    ]++testsVFloat :: TestTree+testsVFloat = testGroup "Vector 6 Float"+    [ testGroup "Additive - Associative" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Vector 6 Float]) <$>+      additiveLawsFail+    , testGroup "Additive Group" $+      testLawOf ([]::[Vector 6 Float]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative - Associative" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Vector 6 Float]) <$>+      multiplicativeLawsFail+    , testGroup "MultiplicativeGroup" $ testLawOf ([]::[Vector 6 Float]) <$>+      multiplicativeGroupLaws+    , testGroup "Distribution" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Vector 6 Float]) <$>+      distributionLawsFail+    , testGroup "Signed" $ testLawOf ([]::[Vector 6 Float]) <$>+      signedLaws+    , testGroup "Metric" $ testLawOf ([]::[Vector 6 Float]) <$> metricRepFloatLaws+    , testGroup "Exponential Ring" $ testLawOf ([]::[Vector 6 Float]) <$> expRingRepLaws+    , testGroup "Exponential Field" $ testLawOf ([]::[Vector 6 Float]) <$> expFieldRepLaws+    , testGroup "Additive Module" $ localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>+      additiveModuleLawsFail+    , testGroup "Additive Group Module" $ localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>+      additiveGroupModuleLawsFail+    , testGroup "Multiplicative Module" $ localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>+      multiplicativeModuleLawsFail+    , testGroup "Multiplicative Group Module" $+      testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>+      multiplicativeGroupModuleLaws+    , testGroup "Additive Basis" $ testLawOf ([]::[Vector 6 Float]) <$>+      additiveBasisLaws+    , testGroup "Additive Group Basis" $ testLawOf ([]::[Vector 6 Float]) <$>+      additiveGroupBasisLaws+    , testGroup "Multiplicative Basis" $ localOption (QuickCheckTests 1000) .+      testLawOf ([]::[Vector 6 Float]) <$>+      multiplicativeBasisLawsFail+    , testGroup "Multiplicative Group Basis" $ testLawOf ([]::[Vector 6 Float]) <$>+      multiplicativeGroupBasisLaws+    , testGroup "Banach" $ testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>+      banachLaws+    ]++testsMFloat :: TestTree+testsMFloat = testGroup "Matrix 4 3 Float"+    [ testGroup "Additive - Associative - Failure" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Matrix 4 3 Float]) <$>+      additiveLawsFail+    , testGroup "Additive Group" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative - Associative Failure" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Matrix 4 3 Float]) <$>+      multiplicativeLawsFail+    , testGroup "MultiplicativeGroup" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      multiplicativeGroupLaws+    , testGroup "Distribution - Fail" $+      localOption (QuickCheckTests 1000) . testLawOf ([]::[Matrix 4 3 Float]) <$>+      distributionLawsFail+    , testGroup "Signed" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      signedLaws+    , testGroup "Metric" $ testLawOf ([]::[Matrix 4 3 Float]) <$> metricRepFloatLaws+    , testGroup "Exponential Ring" $ testLawOf ([]::[Matrix 4 3 Float]) <$> expRingRepLaws+    , testGroup "Exponential Field" $ testLawOf ([]::[Matrix 4 3 Float]) <$> expFieldRepLaws+    , testGroup "Additive Module" $ testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      additiveModuleLaws+    , testGroup "Additive Group Module" $ testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      additiveGroupModuleLaws+    , testGroup "Multiplicative Module" $+      localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      multiplicativeModuleLawsFail+    , testGroup "Multiplicative Group Module" $ testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      multiplicativeGroupModuleLaws+    , testGroup "Additive Basis" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      additiveBasisLaws+    , testGroup "Additive Group Basis" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      additiveGroupBasisLaws+    , testGroup "Multiplicative Basis" $ localOption (QuickCheckTests 1000) .+      testLawOf ([]::[Matrix 4 3 Float]) <$>+      multiplicativeBasisLawsFail+    , testGroup "Multiplicative Group Basis" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      multiplicativeGroupBasisLaws+    ]++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))+    ]++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))+    ]++additiveLawsApprox ::+    ( Eq a+    , Additive a+    , Epsilon a+    ) => [Law a]+additiveLawsApprox =+    [ ( "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 cancel: negate a + a == zero", Unary (\a -> negate a + a == zero))+    ]++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))+    ]++multiplicativeLawsApprox ::+    ( Eq a+    , Epsilon a+    , Multiplicative a+    ) => [Law a]+multiplicativeLawsApprox =+    [ ("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))+    ]++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 -> 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))+    ]++distributionLaws ::+    ( Eq a+    , Distribution a+    ) => [Law a]+distributionLaws =+    [ ("annihilation: a * zero == zero", Unary (\a -> a `times` zero == 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))+    ]++distributionLawsApprox ::+    ( Epsilon a+    , Eq a+    , Distribution a+    ) => [Law a]+distributionLawsApprox =+    [ ("annihilation: a * zero == zero", Unary (\a -> a `times` zero == 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 =+    [ ("annihilation: a * zero == zero", Unary (\a -> a `times` zero == 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))+    ]++signedLaws ::+    ( Eq a+    , Signed a+    ) => [Law a]+signedLaws =+    [ ("sign a * abs a == a", Unary (\a -> sign a `times` abs a == a))+    ]++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))+    ]++boundedFieldLaws ::+    ( Ord a+    , BoundedField a+    ) => [Law a]+boundedFieldLaws =+    [ ("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))+    ]++prettyPositive :: (Epsilon a, Ord a) => a -> Bool+prettyPositive a = not (nearZero a) && a > zero++kindaPositive :: (Epsilon a, Ord a) => a -> Bool+kindaPositive a = nearZero a || a > zero++metricRepFloatLaws ::+    ( Representable r+    , Foldable r+    ) => [Law (r Float)]+metricRepFloatLaws =+    [ ( "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 ->+            kindaPositive+            (distance a c + distance b c - (distance a b :: Float)) &&+            kindaPositive+            (distance a b + distance b c - (distance a c :: Float)) &&+            kindaPositive+            (distance a b + distance a c - (distance b c :: Float))))+    ]++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) ||+                   kindaPositive (distance a c + distance b c - (distance a b :: Float)) &&+                   kindaPositive (distance a b + distance b c - (distance a c :: Float)) &&+                   kindaPositive (distance a b + distance a c - (distance b c :: Float))))+    ]++quotientFieldLaws ::+    ( Ord a+    , Field a+    , QuotientField a+    , FromInteger a+    ) => [Law a]+quotientFieldLaws =+    [ ("x-1 < floor <= x <= ceiling < x+1"+      , Unary (\a ->+                  ((a - one) < fromIntegral (floor a)) &&+                  (fromIntegral (floor a) <= a) &&+                  (a <= fromIntegral (ceiling a)) &&+                  (fromIntegral (ceiling a) < a + one)))+    , ("round == floor (x + 1/2)"+      , Unary (\a -> round a == floor (a + one/(one+one))+              ))+    ]++expRingLaws ::+    ( ExpRing a+    , Epsilon a+    , Ord a+    ) => [Law a]+expRingLaws =+    [ ("for +ive b, a != 0,1: a ** logBase a b ≈ b"+      , Binary (\a b ->+                  ( not (prettyPositive b) ||+                    not (nearZero (a - zero)) ||+                    (a == one) ||+                    (a == zero && nearZero (logBase a b)) ||+                    (a ** logBase a b ≈ b))))+    ]++expRingRepLaws ::+    ( Representable r+    , Foldable r+    , ExpRing a+    , Epsilon a+    , Ord a+    ) => [Law (r a)]+expRingRepLaws =+    [ ("for +ive b, a != 0,1: a ** logBase a b ≈ b"+      , Binary (\a b ->+                  ( not (all prettyPositive b) ||+                    not (all nearZero a) ||+                    all (==one) a ||+                    (all (==zero) a && all nearZero (logBase a b)) ||+                    (a ** logBase a b ≈ b))))+    ]++expFieldLaws ::+    ( ExpField a+    , Epsilon a+    , Fractional a+    , Ord a+    ) => [Law a]+expFieldLaws =+    [ ("sqrt . (**2) ≈ id"+      , Unary (\a -> not (prettyPositive a) || (a > 10.0) ||+                    (sqrt . (**(one+one)) $ a) ≈ a &&+                    ((**(one+one)) . sqrt $ a) ≈ a))+    , ("log . exp ≈ id"+      , Unary (\a -> not (prettyPositive a) || (a > 10.0) ||+                    (log . exp $ a) ≈ a &&+                    (exp . log $ a) ≈ a))+    ]++expFieldRepLaws ::+    ( Representable r+    , Foldable r+    , ExpField a+    , Epsilon a+    , Fractional a+    , Ord a+    ) => [Law (r a)]+expFieldRepLaws =+    [ ("sqrt . (**2) ≈ id"+      , Unary (\a -> not (all prettyPositive a) || any (>10.0) a ||+                    (sqrt . (**(one+one)) $ a) ≈ a &&+                    ((**(one+one)) . sqrt $ a) ≈ a))+    , ("log . exp ≈ id"+      , Unary (\a -> not (all prettyPositive a) || any (>10.0) a ||+                    (log . exp $ a) ≈ a &&+                    (exp . log $ a) ≈ a))+    ]++additiveModuleLaws ::+    ( Eq (r a)+    , Epsilon a+    , Foldable r+    , 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))+    ]++additiveModuleLawsFail ::+    ( Eq (r a)+    , Show a+    , Arbitrary a+    , Show (r a)+    , Arbitrary (r a)+    , Epsilon a+    , AdditiveModule r a+    ) => [Law2 (r a) a]+additiveModuleLawsFail =+    [ +      ("additive module associative: (a + b) .+ c == a + (b .+ c)"+        , Failiary2 $ expectFailure . (\a b c -> (a + b) .+ c == a + (b .+ c)))+    , ("additive module commutative: (a + b) .+ c == (a .+ c) + b"+        , Failiary2 $ expectFailure . (\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+    , Foldable r+    , 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))+    , ("additive group module basis unital: a .- zero ≈ pureRep a"+        , Binary2 (\a b -> b -. (a-a) ≈ pureRep b))+    , ("module additive group equivalence: a .- b ≈ negate b +. a"+        , Binary2 (\a b -> a .- b ≈ negate b +. a))+    ]++additiveGroupModuleLawsFail ::+    ( Eq (r a)+    , Show a+    , Arbitrary a+    , Show (r a)+    , Arbitrary (r a)+    , Epsilon a+    , Foldable r+    , AdditiveGroupModule r a+    ) => [Law2 (r a) a]+additiveGroupModuleLawsFail =+    [ +      ("additive group module associative: (a + b) .- c == a + (b .- c)"+        , Failiary2 $ expectFailure . (\a b c -> (a + b) .- c == a + (b .- c)))+    , ("additive group module commutative: (a + b) .- c == (a .- c) + b"+        , Failiary2 $ expectFailure . (\a b c -> (a + b) .- c == (a .- c) + b))+    , ("additive group module unital: a .- zero == a"+        , Unary2 (\a -> a .- zero == a))+    , ("additive group module basis unital: a .- zero == pureRep a"+        , Binary2 (\a b -> b -. (a-a) == pureRep b))+    , ("module additive group equivalence: a .- b ≈  negate b +. a"+        , Binary2 (\a b -> a .- b ≈ negate b +. a))+    ]++multiplicativeModuleLaws ::+    ( Eq (r a)+    , Epsilon a+    , Foldable r+    , AdditiveModule r a+    , MultiplicativeModule r a+    ) => [Law2 (r a) a]+multiplicativeModuleLaws =+    [ ("multiplicative module associative: (a * b) .* c ≈ a * (b .* c)"+        , Ternary2 (\a b c -> (a * b) .* c ≈ a * (b .* c)))+    , ("multiplicative module commutative: (a * b) .* c ≈ (a .* c) * b"+        , Ternary2 (\a b c -> (a * b) .* c ≈ a * (b .* c)))+    , ("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))+    ]++multiplicativeModuleLawsFail ::+    ( Eq (r a)+    , Epsilon a+    , Show a+    , Arbitrary a+    , Show (r a)+    , Arbitrary (r a)+    , Foldable r+    , AdditiveModule r a+    , MultiplicativeModule r a+    ) => [Law2 (r a) a]+multiplicativeModuleLawsFail =+    [ ("multiplicative module associative: (a * b) .* c == a * (b .* c)"+        , Failiary2 $ expectFailure . (\a b c -> (a * b) .* c == a * (b .* c)))+    , ("multiplicative module commutative: (a * b) .* c == (a .* c) * b"+        , Failiary2 $ expectFailure . (\a b c -> (a * b) .* c == a * (b .* c)))+    , ("multiplicative module unital: a .* one == a"+        , Unary2 (\a -> a .* one == a))+    , ("module right distribution: (a + b) .* c == (a .* c) + (b .* c)"+        , Failiary2 $ expectFailure . (\a b c -> (a + b) .* c == (a .* c) + (b .* c)))+    , ("module left distribution: c *. (a + b) == (c *. a) + (c *. b)"+        , Failiary2 $ expectFailure . (\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))+    ]++multiplicativeGroupModuleLaws ::+    ( Eq (r a)+    , Eq a+    , Epsilon a+    , Foldable r+    , MultiplicativeGroupModule r a+    ) => [Law2 (r a) a]+multiplicativeGroupModuleLaws =+    [ +      ("multiplicative group module associative: (a * b) ./ c ≈ a * (b ./ c)"+        , Ternary2 (\a b c -> c==zero || (a * b) ./ c ≈ a * (b ./ c)))+    , ("multiplicative group module commutative: (a * b) ./ c ≈ (a ./ c) * b"+        , Ternary2 (\a b c -> c==zero || (a * b) ./ c ≈ (a ./ c) * b))+    , ("multiplicative group module unital: a ./ one == a"+        , Unary2 (\a -> nearZero a || a ./ one == a))+    , ("multiplicative group module basis unital: a /. one ≈ pureRep a"+        , Binary2 (\a b -> a==zero || b /. (a/a) ≈ pureRep b))+    , ("module multiplicative group equivalence: a ./ b ≈ recip b *. a"+        , Binary2 (\a b -> b==zero || a ./ b ≈ recip b *. a))+    ]++multiplicativeGroupModuleLawsFail ::+    ( Eq a+    , Show a+    , Arbitrary a+    , Eq (r a)+    , Show (r a)+    , Arbitrary (r a)+    , Epsilon a+    , Foldable r+    , MultiplicativeGroupModule r a+    ) => [Law2 (r a) a]+multiplicativeGroupModuleLawsFail =+    [ +      ("multiplicative group module associative: (a * b) ./ c == a * (b ./ c)"+        , Failiary2 $ expectFailure .+          (\a b c -> c==zero || (a * b) ./ c == a * (b ./ c)))+    , ("multiplicative group module commutative: (a * b) ./ c ≈ (a ./ c) * b"+        , Ternary2 (\a b c -> c==zero || (a * b) ./ c ≈ (a ./ c) * b))+    , ("multiplicative group module unital: a ./ one == a"+        , Unary2 (\a -> nearZero a || a ./ one == a))+    , ("multiplicative group module basis unital: a /. one ≈ pureRep a"+        , Binary2 (\a b -> a==zero || b /. (a/a) ≈ pureRep b))+    , ("module multiplicative group equivalence: a ./ b ≈ recip b *. a"+        , Binary2 (\a b -> b==zero || a ./ b ≈ recip b *. a))+    ]++additiveBasisLaws ::+    ( Eq (r a)+    , Foldable r+    , Epsilon 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)+    , AdditiveGroupBasis r a+    ) => [Law (r a)]+additiveGroupBasisLaws =+    [ ("minus: a .-. a = pureRep zero", Unary (\a -> (a .-. a) == pureRep zero))+    ]++multiplicativeBasisLaws ::+    ( Eq (r a)+    , 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: 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))+    ]++multiplicativeBasisLawsFail ::+    ( Eq (r a)+    , Show (r a)+    , Arbitrary (r a)+    , MultiplicativeBasis r a+    ) => [Law (r a)]+multiplicativeBasisLawsFail =+    [ ("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))+    ]++multiplicativeGroupBasisLaws ::+    ( Eq (r a)+    , Epsilon a+    , Foldable r+    , MultiplicativeGroupBasis r a+    ) => [Law (r a)]+multiplicativeGroupBasisLaws =+    [ ("minus: a ./. a ≈ pureRep one", Unary (\a -> a==pureRep zero || (a ./. a) ≈ pureRep one))+    ]++banachLaws ::+    ( Eq (r a)+    , Epsilon b+    , MultiplicativeGroup b+    , Banach r a+    , Normed (r a) b+    ) => [Law2 (r a) b]+banachLaws =+    [ -- Banach+      ( "size (normalize a) ≈ one"+      , Binary2 (\a b -> a==pureRep zero || size (normalize a) ≈ (b/b)))+    ]