packages feed

numhask 0.0.2 → 0.0.3

raw patch · 22 files changed

+544/−497 lines, 22 files

Files

numhask.cabal view
@@ -1,7 +1,7 @@ name:   numhask version:-  0.0.2+  0.0.3 synopsis:   A numeric prelude description:@@ -41,7 +41,6 @@     NumHask.Algebra,     NumHask.Algebra.Additive,     NumHask.Algebra.Basis,-    NumHask.Algebra.Exponential,     NumHask.Algebra.Distribution,     NumHask.Algebra.Ring,     NumHask.Algebra.Field,@@ -51,7 +50,7 @@     NumHask.Algebra.Module,     NumHask.Algebra.Multiplicative     NumHask.Algebra.Ordering,-    NumHask.HasShape,+    NumHask.Naperian,     NumHask.Vector,     NumHask.Matrix,     NumHask.Tensor
src/NumHask/Algebra.hs view
@@ -5,7 +5,6 @@     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@@ -19,7 +18,6 @@ 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
src/NumHask/Algebra/Additive.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Additive Structure@@ -24,7 +20,7 @@  import qualified Protolude as P import Protolude (Double, Float, Int, Integer, Bool(..))-import Data.Functor.Rep+import Data.Complex (Complex(..))  -- * 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.@@ -37,8 +33,8 @@ 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+instance (AdditiveMagma a) => AdditiveMagma (Complex a) where+    (rx :+ ix) `plus` (ry :+ iy) = (rx `plus` ry) :+ (ix `plus` iy)  -- | AdditiveUnital --@@ -51,8 +47,8 @@ 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+instance (AdditiveUnital a) => AdditiveUnital (Complex a) where+    zero = zero :+ zero  -- | AdditiveAssociative --@@ -64,7 +60,7 @@ instance AdditiveAssociative Int instance AdditiveAssociative Integer instance AdditiveAssociative Bool-instance (Representable r, AdditiveAssociative a) => AdditiveAssociative (r a)+instance (AdditiveAssociative a) => AdditiveAssociative (Complex a)  -- | AdditiveCommutative --@@ -76,7 +72,7 @@ instance AdditiveCommutative Int instance AdditiveCommutative Integer instance AdditiveCommutative Bool-instance (Representable r, AdditiveCommutative a) => AdditiveCommutative (r a)+instance (AdditiveCommutative a) => AdditiveCommutative (Complex a)  -- | AdditiveInvertible --@@ -90,8 +86,8 @@ 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+instance (AdditiveInvertible a) => AdditiveInvertible (Complex a) where+    negate (rx :+ ix) = negate rx :+ negate ix  -- | AdditiveHomomorphic --@@ -102,8 +98,6 @@     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 --@@ -122,7 +116,7 @@ instance AdditiveMonoidal Int instance AdditiveMonoidal Integer instance AdditiveMonoidal Bool-instance (Representable r, AdditiveMonoidal a) => AdditiveMonoidal (r a)+instance (AdditiveMonoidal a) => AdditiveMonoidal (Complex a)  -- | Additive is commutative, unital and associative under addition --@@ -147,7 +141,7 @@ instance Additive Int instance Additive Integer instance Additive Bool-instance (Representable r, Additive a) => Additive (r a)+instance {-# Overlapping #-} (Additive a) => Additive (Complex a)  -- | Non-commutative left minus class ( AdditiveUnital a@@ -186,4 +180,4 @@ instance AdditiveGroup Float instance AdditiveGroup Int instance AdditiveGroup Integer-instance (Representable r, AdditiveGroup a) => AdditiveGroup (r a)+instance {-# Overlapping #-} (AdditiveGroup a) => AdditiveGroup (Complex a)
src/NumHask/Algebra/Basis.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Highjacking 'Representable's to provide a basis to provide element-by-element operations
src/NumHask/Algebra/Distribution.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Distribution, avoiding name clashes with 'Data.Distributive'@@ -11,9 +7,9 @@   ) where  import Protolude (Double, Float, Int, Integer,Bool(..))-import Data.Functor.Rep import NumHask.Algebra.Additive import NumHask.Algebra.Multiplicative+import Data.Complex (Complex(..))  -- | Distribution --@@ -31,5 +27,7 @@ instance Distribution Int instance Distribution Integer instance Distribution Bool-instance (Representable r, Distribution a) => Distribution (r a)+instance {-# Overlapping #-} (AdditiveGroup a, Distribution a) =>+    Distribution (Complex a)+
− src/NumHask/Algebra/Exponential.hs 
@@ -1,63 +0,0 @@-{-# 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-
src/NumHask/Algebra/Field.hs view
@@ -1,20 +1,22 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Field module NumHask.Algebra.Field (     Field+  , ExpField(..)+  , QuotientField(..)+  , BoundedField(..)+  , infinity+  , neginfinity   ) where -import Protolude (Double, Float)-import Data.Functor.Rep+import Protolude (Double, Float, Integer, Bool, (||))+import qualified Protolude as P import NumHask.Algebra.Additive import NumHask.Algebra.Multiplicative import NumHask.Algebra.Distribution import NumHask.Algebra.Ring+import Data.Complex (Complex(..))  -- | Field class ( AdditiveGroup a@@ -25,5 +27,84 @@  instance Field Double instance Field Float-instance (Representable r, Field a) => Field (r a)+instance {-# Overlapping #-} (Field a) => Field (Complex a)++-- | ExpField+class (Field a) => ExpField a where+    exp :: a -> a+    log :: a -> a++    logBase :: a -> a -> a+    logBase a b = log b / log a++    (**) :: a -> a -> a+    (**) a b = exp (log a * b)++    sqrt :: a -> a+    sqrt a = a**(one/(one+one))++instance ExpField Double where+    exp = P.exp+    log = P.log+    (**) = (P.**)++instance ExpField Float where+    exp = P.exp+    log = P.log+    (**) = (P.**)++instance {-# Overlapping #-} (ExpField a) => ExpField (Complex a) where+    exp (rx :+ ix) = exp rx * cos ix :+ exp rx * sin ix+      where+        cos = P.undefined+        sin = P.undefined++    log (rx :+ ix) = log (sqrt (rx * rx + ix * ix)) :+ atan2 ix rx+      where+        atan2 = P.undefined++-- | quotient fields explode constraints if they are polymorphed to emit general integrals+class (Field 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.^^)++-- | 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 {-# Overlapping #-} (BoundedField a) => BoundedField (Complex a) where+    isNaN (rx :+ ix) = isNaN rx || isNaN ix
src/NumHask/Algebra/Integral.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Integral domains@@ -14,8 +10,7 @@   ) where  import qualified Protolude as P-import Protolude (Double, Float, Int, Integer, Functor(..), (.), fst, snd)-import Data.Functor.Rep+import Protolude (Double, Float, Int, Integer, (.), fst, snd) import NumHask.Algebra.Ring  -- | Integral@@ -37,15 +32,8 @@ 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+class ToInteger a where     toInteger :: a -> Integer  -- | fromInteger
src/NumHask/Algebra/Magma.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Magma
src/NumHask/Algebra/Metric.hs view
@@ -1,60 +1,23 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Metric structure module NumHask.Algebra.Metric (     -- * Metric-    BoundedField(..)-  , infinity-  , neginfinity-  , Metric(..)+    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 Protolude (Double, Float, Int, Integer, ($), Bool(..), Ord(..), Eq(..), (&&)) 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+import Data.Complex (Complex(..)) --- | abs and signnum are also warts on the standard 'Num' class, and are separated here to provide a cleaner structure.+-- | abs and signnum are warts on the standard 'Num' class, and are separated here to provide a cleaner structure. class ( AdditiveUnital a       , AdditiveGroup a       , Multiplicative a@@ -74,9 +37,6 @@ 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@@ -86,9 +46,8 @@ 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+instance {-# Overlapping #-} (Multiplicative a, ExpField a, Normed a a) => Normed (Complex a) a where+    size (rx :+ ix) = sqrt (rx * rx + ix * ix)  -- | This should probably be split off into some sort of alternative Equality logic, but to what end? class (AdditiveGroup a) => Epsilon a where@@ -117,9 +76,9 @@     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+instance {-# Overlapping #-} (Epsilon a) => Epsilon (Complex a) where+    nearZero (rx :+ ix) = nearZero rx && nearZero ix+    aboutEqual a b = nearZero $ a - b  -- | distance between numbers class Metric a b where@@ -129,25 +88,6 @@ 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+instance {-# Overlapping #-} (Multiplicative a, ExpField a, Normed a a) => Metric (Complex 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.^^)
src/NumHask/Algebra/Module.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExplicitNamespaces #-} {-# OPTIONS_GHC -Wall #-}  -- | Algebra@@ -22,7 +22,7 @@ import Protolude (Double, Float, Int, Integer, Functor(..), ($), Foldable(..)) import Data.Functor.Rep import NumHask.Algebra.Additive-import NumHask.Algebra.Exponential+import NumHask.Algebra.Field import NumHask.Algebra.Metric import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring@@ -94,14 +94,14 @@     normalize :: m a -> m a     normalize a = a ./ size a -instance (ExpField a, Foldable r, Representable r) => Banach r a+instance (Normed (r a) a, ExpField a, Representable r) => Banach r a  -- | Hilbert-class (AdditiveGroup (m a)) => Hilbert m a where+class (Additive (m a)) => Hilbert m a where     infix 8 <.>     (<.>) :: m a -> m a -> a -instance (Foldable r, Representable r, CRing a) =>+instance (Additive (r a), Foldable r, Representable r, CRing a) =>     Hilbert r a where     (<.>) a b = foldl' (+) zero $ liftR2 (*) a b @@ -126,7 +126,7 @@     timesleft :: a -> (a><a) -> a     timesright :: (a><a) -> a -> a -instance (Foldable r, Representable r, CRing a ) =>+instance (AdditiveGroup (r a), Foldable r, Representable r, CRing a ) =>     TensorProduct (r a)   where     (><) m n = tabulate (\i -> index m i *. n)
src/NumHask/Algebra/Multiplicative.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Unsafe #-} {-# OPTIONS_GHC -Wall #-}  -- | Multiplicate structure@@ -24,7 +21,8 @@  import qualified Protolude as P import Protolude (Double, Float, Int, Integer, Bool(..))-import Data.Functor.Rep+import Data.Complex (Complex(..))+import NumHask.Algebra.Additive  -- * Multiplicative structure -- | 'times' is used for the multiplicative magma to distinguish from '*' which, by convention, implies commutativity@@ -35,8 +33,10 @@ 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+instance (MultiplicativeMagma a, AdditiveGroup a) =>+    MultiplicativeMagma (Complex a) where+    (rx :+ ix) `times` (ry :+ iy) =+        (rx `times` ry - ix `times` iy) :+ (ix `times` ry + iy `times` rx)  -- | MultiplicativeUnital --@@ -49,22 +49,9 @@ 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)+instance (AdditiveUnital a, AdditiveGroup a, MultiplicativeUnital a) =>+    MultiplicativeUnital (Complex a) where+    one = one :+ zero  -- | MultiplicativeAssociative --@@ -76,9 +63,22 @@ instance MultiplicativeAssociative Int instance MultiplicativeAssociative Integer instance MultiplicativeAssociative Bool-instance (Representable r, MultiplicativeAssociative a) =>-    MultiplicativeAssociative (r a)+instance (AdditiveGroup a, MultiplicativeAssociative a) =>+    MultiplicativeAssociative (Complex a) +-- | 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 (AdditiveGroup a, MultiplicativeCommutative a) =>+    MultiplicativeCommutative (Complex a)+ -- | MultiplicativeInvertible -- -- > ∀ a ∈ A: recip a ∈ A@@ -88,9 +88,11 @@  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+instance (AdditiveGroup a, MultiplicativeInvertible a) =>+    MultiplicativeInvertible (Complex a) where+    recip (rx :+ ix) = (rx `times` d) :+ (negate ix `times` d)+      where+        d = recip ((rx `times` rx) `plus` (ix `times` ix))  -- | MultiplicativeHomomorphic --@@ -101,10 +103,6 @@       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 @@ -118,9 +116,8 @@ instance MultiplicativeMonoidal Int instance MultiplicativeMonoidal Integer instance MultiplicativeMonoidal Bool-instance (Representable r, MultiplicativeMonoidal a) =>-    MultiplicativeMonoidal (r a)-+instance (AdditiveGroup a, MultiplicativeMonoidal a) =>+    MultiplicativeMonoidal (Complex a)  -- | Multiplicative is commutative, associative and unital under multiplication --@@ -145,7 +142,8 @@ instance Multiplicative Int instance Multiplicative Integer instance Multiplicative Bool-instance (Representable r, Multiplicative a) => Multiplicative (r a)+instance {-# Overlapping #-} (AdditiveGroup a, Multiplicative a) =>+    Multiplicative (Complex a) where  -- | Non-commutative left divide class ( MultiplicativeUnital a@@ -182,5 +180,5 @@  instance MultiplicativeGroup Double instance MultiplicativeGroup Float-instance (Representable r, MultiplicativeGroup a) => MultiplicativeGroup (r a)-+instance {-# Overlapping #-} (AdditiveGroup a, MultiplicativeGroup a) =>+    MultiplicativeGroup (Complex a) where
src/NumHask/Algebra/Ordering.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}
src/NumHask/Algebra/Ring.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  -- | Rings@@ -14,10 +10,10 @@   ) where  import Protolude (Double, Float, Int, Integer,Bool(..))-import Data.Functor.Rep import NumHask.Algebra.Additive import NumHask.Algebra.Multiplicative import NumHask.Algebra.Distribution+import Data.Complex (Complex(..))  -- | a semiring class ( Additive a@@ -31,7 +27,7 @@ instance Semiring Int instance Semiring Integer instance Semiring Bool-instance (Representable r, Semiring a) => Semiring (r a)+instance (AdditiveGroup a, Semiring a) => Semiring (Complex a)  -- | Ring class ( AdditiveGroup a@@ -44,7 +40,7 @@ instance Ring Float instance Ring Int instance Ring Integer-instance (Representable r, Ring a) => Ring (r a)+instance (Ring a) => Ring (Complex a)  -- | CRing is a Commutative Ring.  It arises often due to * being defined as only multiplicative commutative. class ( Multiplicative a, Ring a) => CRing a@@ -53,5 +49,4 @@ instance CRing Float instance CRing Int instance CRing Integer-instance (Representable r, CRing a) => CRing (r a)-+instance (CRing a) => CRing (Complex a)
src/NumHask/Examples.hs view
@@ -19,7 +19,7 @@      ) where -import NumHask.Prelude+-- import NumHask.Prelude  -- $imports -- NumHask.Prelude is a complete replacement for the standard prelude.
− src/NumHask/HasShape.hs 
@@ -1,24 +0,0 @@-{-# 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-
src/NumHask/Matrix.hs view
@@ -1,12 +1,6 @@-{-# 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 --@@ -41,12 +35,8 @@ 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.Algebra+import NumHask.Naperian import NumHask.Vector import Test.QuickCheck import qualified Data.Vector as V@@ -59,32 +49,57 @@ newtype Matrix m n a = Matrix { flattenMatrix :: V.Vector a }     deriving (Functor, Eq, Foldable) +instance forall m n. (KnownNat m, KnownNat n) =>+    HasShape (Matrix (m::Nat) (n::Nat)) where+    type Shape (Matrix m n) = (Int,Int)+    shape _= ( P.fromInteger $ natVal (Proxy :: Proxy m)+             , P.fromInteger $ natVal (Proxy :: Proxy n))+    ndim = P.length . shape++instance (KnownNat m, KnownNat n) => Naperian (Matrix (m::Nat) (n::Nat))++instance (Show a, KnownNat m, KnownNat n) => Show (Matrix (m::Nat) (n::Nat) a) where+    show = show . someMatrix++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)+ -- | 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)+instance HasShape SomeMatrix where+    type Shape SomeMatrix = (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 @@ -136,32 +151,6 @@               ((\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
+ src/NumHask/Naperian.hs view
@@ -0,0 +1,84 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | multi-dimensional representable numbers+module NumHask.Naperian+    ( Naperian+    , HasShape(..)+    ) where++import Protolude (Int, foldr, Foldable(..), ($), (<$>), fmap, fst, snd, or, and)+import Data.Functor.Rep+import NumHask.Algebra++-- | ToDo: integrate ni Naperian instance+class HasShape f where+    type Shape f+    shape :: f a -> Shape f+    ndim :: f a -> Int++class (HasShape f, Representable f) => Naperian f++instance {-# Overlappable #-} (Naperian f, AdditiveMagma a) => AdditiveMagma (f a) where+    plus = liftR2 plus+instance {-# Overlappable #-} (Naperian f, AdditiveUnital a) => AdditiveUnital (f a) where+    zero = pureRep zero+instance {-# Overlappable #-} (Naperian f, AdditiveAssociative a) => AdditiveAssociative (f a)+instance {-# Overlappable #-} (Naperian f, AdditiveCommutative a) => AdditiveCommutative (f a)+instance {-# Overlappable #-} (Naperian f, AdditiveInvertible a) => AdditiveInvertible (f a) where+    negate = fmapRep negate+instance {-# Overlappable #-} (Naperian f, AdditiveMagma a) => AdditiveHomomorphic a (f a) where+    plushom a = pureRep a+instance {-# Overlappable #-} (Naperian f, AdditiveMonoidal a) => AdditiveMonoidal (f a)+instance {-# Overlappable #-} (Naperian f, Additive a) => Additive (f a)+instance {-# Overlappable #-} (Naperian f, AdditiveGroup a) => AdditiveGroup (f a)++instance {-# Overlappable #-} (Naperian f, MultiplicativeMagma a) => MultiplicativeMagma (f a) where+    times = liftR2 times+instance {-# Overlappable #-} (Naperian f, MultiplicativeUnital a) => MultiplicativeUnital (f a) where+    one = pureRep one+instance {-# Overlappable #-} (Naperian f, MultiplicativeAssociative a) => MultiplicativeAssociative (f a)+instance {-# Overlappable #-} (Naperian f, MultiplicativeCommutative a) => MultiplicativeCommutative (f a)+instance {-# Overlappable #-} (Naperian f, MultiplicativeInvertible a) => MultiplicativeInvertible (f a) where+    recip = fmapRep recip+instance {-# Overlappable #-} (Naperian f, MultiplicativeMagma a) => MultiplicativeHomomorphic a (f a) where+    timeshom a = pureRep a+instance {-# Overlappable #-} (Naperian f, MultiplicativeMonoidal a) => MultiplicativeMonoidal (f a)+instance {-# Overlappable #-} (Naperian f, Multiplicative a) => Multiplicative (f a)+instance {-# Overlappable #-} (Naperian f, MultiplicativeGroup a) => MultiplicativeGroup (f a)++instance {-# Overlappable #-} (Naperian f, MultiplicativeMagma a, Additive a) => Distribution (f a)++instance {-# Overlappable #-} (Naperian f, Semiring a) => Semiring (f a)+instance {-# Overlappable #-} (Naperian f, Ring a) => Ring (f a)+instance {-# Overlappable #-} (Naperian f, CRing a) => CRing (f a)+instance {-# Overlappable #-} (Naperian f, Field a) => Field (f a)++instance {-# Overlappable #-} (Naperian f, ExpField a) => ExpField (f a) where+    exp = fmapRep exp+    log = fmapRep log++instance {-# Overlappable #-} (Naperian f, BoundedField a, Foldable f) => BoundedField (f a) where+    isNaN f = or (fmapRep isNaN f)++instance {-# Overlappable #-} (Naperian f, Signed a) => Signed (f a) where+    sign = fmapRep sign+    abs = fmapRep abs++instance {-# Overlappable #-} (Foldable f, Naperian f, ExpField a) =>+    Normed (f a) a where+    size r = sqrt $ foldr (+) zero $ (**(one+one)) <$> r++instance {-# Overlappable #-} (Foldable f, Naperian f, Epsilon a) => Epsilon (f a) where+    nearZero f = and (fmapRep nearZero f)+    aboutEqual a b = and (liftR2 aboutEqual a b)++instance {-# Overlappable #-} (Foldable f, Naperian f, ExpField a) => Metric (f a) a where+    distance a b = size (a - b)++instance {-# Overlappable #-} (Naperian f, Integral a) => Integral (f a) where+    divMod a b = (d,m)+        where+          x = liftR2 divMod a b+          d = fmap fst x+          m = fmap snd x
src/NumHask/Prelude.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ExtendedDefaultRules #-} {-# OPTIONS_GHC -Wall #-}  -- | A prelude for NumHask@@ -13,7 +14,6 @@   , 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@@ -27,7 +27,7 @@   , module NumHask.Matrix   , module NumHask.Tensor   , module NumHask.Vector-  , module NumHask.HasShape+  , module NumHask.Naperian   ) where  import Protolude hiding@@ -63,7 +63,6 @@ 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@@ -76,7 +75,7 @@ import NumHask.Matrix import NumHask.Tensor import NumHask.Vector-import NumHask.HasShape+import NumHask.Naperian  import Data.Distributive import Data.Functor.Rep
src/NumHask/Tensor.hs view
@@ -1,14 +1,6 @@-{-# 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: --@@ -43,7 +35,7 @@ import NumHask.Algebra.Multiplicative import Test.QuickCheck import qualified Data.Vector as V-import NumHask.HasShape+import NumHask.Naperian  -- | 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.@@ -51,31 +43,59 @@ 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+instance (SingI r) => HasShape (Tensor (r::[Nat])) where+    type Shape (Tensor r) = [Int]+    shape _ = case (sing :: Sing r) of+                SNil -> []+                (SCons x xs) -> fromIntegral <$> (fromSing x: fromSing xs)     ndim = P.length . shape -instance HasShape (SomeTensor a) where-    type Shape (SomeTensor a) = [Int]-    shape (SomeTensor sh _) = sh-    ndim = P.length . shape+instance (SingI r) => Naperian (Tensor (r::[Nat])) --- | 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) -> fromIntegral <$> (fromSing x: fromSing xs)+ind :: [Int] -> [Int] -> Int+ind ns xs = sum $ zipWith (*) xs (drop 1 $ scanr (*) 1 (reverse ns)) --- not sure how to combine this with HasShape-newtype ShapeT = ShapeT {unshapeT :: [Int]} deriving (Show, Eq)+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. (SingI r) => Distributive (Tensor (r::[Nat])) where+    distribute f = Tensor $ V.generate n+        $ \i -> fmap (\(Tensor v) -> V.unsafeIndex v i) f+      where+        n = case (sing :: Sing r) of+          SNil -> one+          (SCons x xs) -> product $ fromInteger <$> (fromSing x: fromSing xs)++instance forall (r :: [Nat]). (SingI r) => Representable (Tensor r) where+    type Rep (Tensor r) = [Int]+    tabulate f = Tensor $ V.generate (product ns) (f . unind ns)+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs) -> fromIntegral <$> (fromSing x: fromSing xs)+    index (Tensor xs) rs = xs V.! ind ns rs+      where+        ns = case (sing :: Sing r) of+          SNil -> []+          (SCons x xs') -> fromIntegral <$> (fromSing x: fromSing xs')+ -- | 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 HasShape SomeTensor where+    type Shape SomeTensor = [Int]+    shape (SomeTensor sh _) = sh+    ndim = P.length . shape+ instance (Show a) => Show (SomeTensor a) where     show r@(SomeTensor l _) = go (P.length l) r       where@@ -117,40 +137,6 @@       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. (SingI r) => Distributive (Tensor (r::[Nat])) where-    distribute f = Tensor $ V.generate n-        $ \i -> fmap (\(Tensor v) -> V.unsafeIndex v i) f-      where-        n = case (sing :: Sing r) of-          SNil -> one-          (SCons x xs) -> product $ fromInteger <$> (fromSing x: fromSing xs)--instance forall (r :: [Nat]). (SingI r) => Representable (Tensor r) where-    type Rep (Tensor r) = [Int]-    tabulate f = Tensor $ V.generate (product ns) (f . unind ns)-      where-        ns = case (sing :: Sing r) of-          SNil -> []-          (SCons x xs) -> fromIntegral <$> (fromSing x: fromSing xs)-    index (Tensor xs) rs = xs V.! ind ns rs-      where-        ns = case (sing :: Sing r) of-          SNil -> []-          (SCons x xs') -> 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@@ -165,6 +151,9 @@ fromListSomeTensor :: forall a. (AdditiveUnital a) => [Int] -> [a] -> SomeTensor a fromListSomeTensor ns l =     SomeTensor ns (V.fromList $ P.take (product ns) $ l P.++ P.repeat zero)++-- not sure how to combine this with HasShape+newtype ShapeT = ShapeT {unshapeT :: [Int]} deriving (Show, Eq)  instance Arbitrary ShapeT where     arbitrary = frequency
src/NumHask/Vector.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE OverloadedLists #-} {-# OPTIONS_GHC -Wall #-}  -- | Two different classes are supplied:@@ -14,7 +10,6 @@   ( Vector(..)   , SomeVector(..)   , ShapeV(..)-  , shapeV     -- ** Conversion   , someVector   , unsafeToVector@@ -31,8 +26,8 @@ import GHC.Exts import GHC.Show (show) import GHC.TypeLits-import NumHask.Algebra.Additive-import NumHask.HasShape+import NumHask.Algebra+import NumHask.Naperian import Test.QuickCheck import qualified Data.Vector as V @@ -42,36 +37,54 @@ newtype Vector (n::Nat) a = Vector { toVec :: V.Vector a }     deriving (Functor, Eq, Foldable, Ord) +instance forall n. (KnownNat n) =>+    HasShape (Vector (n::Nat)) where+    type Shape (Vector n) = Int+    shape _ = P.fromInteger $ natVal (Proxy :: Proxy n)+    ndim _ = 1++instance (KnownNat n) => Naperian (Vector (n::Nat))++instance (Show a, KnownNat n) => Show (Vector (n::Nat) a) where+    show = show . someVector++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+ -- | 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+instance HasShape SomeVector where+    type Shape SomeVector = 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)+someVector v = SomeVector (shape v) (toVec v)  -- | convert from a 'SomeVector' to a 'Vector' with no shape check unsafeToVector :: SomeVector a -> Vector (r::Nat) a@@ -114,23 +127,3 @@         [ (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
test/test.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wall #-} @@ -10,7 +9,6 @@ import Test.Tasty (TestName, TestTree, testGroup, defaultMain, localOption) import Test.Tasty.QuickCheck import Test.DocTest--- import Test.QuickCheck  main :: IO () main = do@@ -64,6 +62,7 @@     , testsMFloat     , testsNInt     , testsNShow+    , testsComplexFloat     ]  testsInt :: TestTree@@ -102,7 +101,6 @@     , testGroup "Metric" $ testLawOf ([]::[Float]) <$> metricFloatLaws     , testGroup "Quotient Field" $ testLawOf ([]::[Float]) <$>       quotientFieldLaws-    , testGroup "Exponential Ring" $ testLawOf ([]::[Float]) <$> expRingLaws     , testGroup "Exponential Field" $ testLawOf ([]::[Float]) <$> expFieldLaws     ] @@ -118,6 +116,25 @@       <$> distributionLaws     ] +testsComplexFloat :: TestTree+testsComplexFloat = testGroup "Complex Float"+    [ testGroup "Additive - Associative Fail" $ testLawOf ([]::[Complex Float]) <$>+      additiveLawsFail+    , testGroup "Additive Group" $ testLawOf ([]::[Complex Float]) <$>+      additiveGroupLaws+    , testGroup "Multiplicative - Associative Fail" $+      testLawOf ([]::[Complex Float]) <$>+      multiplicativeLawsFail+    , testGroup "MultiplicativeGroup" $ testLawOf ([]::[Complex Float]) <$>+      multiplicativeGroupLaws+    , testGroup "Distribution - Fail" $ testLawOf ([]::[Complex Float]) <$>+      distributionLawsFail+    -- , testGroup "Bounded Field" $ testLawOf ([]::[Complex Float]) <$>+    --   boundedFieldLaws+    -- , testGroup "Exponential Field" $ testLawOf ([]::[Complex Float]) <$> expFieldLaws+    , testGroup "Metric" $ testLawOf ([]::[Complex Float]) <$> metricComplexFloatLaws+    ]+ testsVInt :: TestTree testsVInt = testGroup "Vector 6 Int"     [ testGroup "Additive" $ testLawOf ([]::[Vector 6 Int]) <$>@@ -213,9 +230,10 @@       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 "Metric" $ testLawOf ([]::[Vector 6 Float]) <$>+      metricNaperianFloatLaws+    , testGroup "Exponential Field" $ testLawOf ([]::[Vector 6 Float]) <$>+      expFieldNaperianLaws     , testGroup "Additive Module" $ localOption (QuickCheckTests 1000) .       testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>       additiveModuleLawsFail@@ -225,11 +243,12 @@     , testGroup "Multiplicative Module" $ localOption (QuickCheckTests 1000) .       testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>       multiplicativeModuleLawsFail-    , testGroup "Multiplicative Group Module" $+    , testGroup "Multiplicative Group Module" $ localOption (QuickCheckTests 1000) .       testLawOf2 ([]::[(Vector 6 Float, Float)]) <$>-      multiplicativeGroupModuleLaws-    , testGroup "Additive Basis" $ testLawOf ([]::[Vector 6 Float]) <$>-      additiveBasisLaws+      multiplicativeGroupModuleLawsFail+    , testGroup "Additive Basis" $ localOption (QuickCheckTests 1000) .+      testLawOf ([]::[Vector 6 Float]) <$>+      additiveBasisLawsFail     , testGroup "Additive Group Basis" $ testLawOf ([]::[Vector 6 Float]) <$>       additiveGroupBasisLaws     , testGroup "Multiplicative Basis" $ localOption (QuickCheckTests 1000) .@@ -258,22 +277,33 @@       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 "Metric" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      metricNaperianFloatLaws+    , testGroup "Exponential Field" $ testLawOf ([]::[Matrix 4 3 Float]) <$>+      expFieldNaperianLaws+    , testGroup "Additive Module" $+      localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      additiveModuleLawsFail+    , testGroup "Additive Group Module" $+      localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      additiveGroupModuleLawsFail     , 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]) <$>+    , testGroup "Multiplicative Group Module" $+      localOption (QuickCheckTests 1000) .+      testLawOf2 ([]::[(Matrix 4 3 Float, Float)]) <$>+      multiplicativeGroupModuleLawsFail+    , testGroup "Additive Basis" $+      localOption (QuickCheckTests 1000) .+      testLawOf ([]::[Matrix 4 3 Float]) <$>+      additiveBasisLawsFail+    , testGroup "Additive Group Basis" $+      localOption (QuickCheckTests 1000) .+      testLawOf ([]::[Matrix 4 3 Float]) <$>       additiveGroupBasisLaws     , testGroup "Multiplicative Basis" $ localOption (QuickCheckTests 1000) .       testLawOf ([]::[Matrix 4 3 Float]) <$>@@ -293,7 +323,7 @@     , ( "idempotent: a * a == a"       , Unary (\a -> a * a == a))     ]-+  additiveLaws ::     ( Eq a     , Additive a@@ -389,7 +419,7 @@     ) => [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 divide: recip a == one / a", Unary (\a -> a == zero || recip a == one / a))     , ( "recip left: a == zero || recip a * a ≈ one"       , Unary (\a -> a == zero || recip a * a ≈ one))     , ( "recip right: a == zero || a * recip a ≈ one"@@ -459,7 +489,7 @@     ]  boundedFieldLaws ::-    ( Ord a+    ( Eq a     , BoundedField a     ) => [Law a] boundedFieldLaws =@@ -479,11 +509,12 @@ kindaPositive :: (Epsilon a, Ord a) => a -> Bool kindaPositive a = nearZero a || a > zero -metricRepFloatLaws ::-    ( Representable r+metricNaperianFloatLaws ::+    ( Naperian r+    , Metric (r Float) Float     , Foldable r     ) => [Law (r Float)]-metricRepFloatLaws =+metricNaperianFloatLaws =     [ ( "positive"       , Binary (\a b -> distance a b >= (zero::Float)))     , ( "zero if equal"@@ -521,6 +552,28 @@                    kindaPositive (distance a b + distance a c - (distance b c :: Float))))     ] +metricComplexFloatLaws ::+    ( +    ) => [Law (Complex Float)]+metricComplexFloatLaws =+    [ ( "positive"+      , Binary (\a b -> (distance a b :: Float) >= zero))+    ,+      ("zero if equal"+      , Unary (\a -> (distance a a :: Float) == zero))+    , ( "associative"+      , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))+    , ( "triangle rule - sum of distances > distance"+      , Ternary (\a b c ->+                   (size a > (10.0 :: Float)) ||+                   (size b > (10.0 :: Float)) ||+                   (size c > (10.0 :: Float)) ||+                   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@@ -539,38 +592,6 @@               ))     ] -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@@ -586,17 +607,27 @@       , Unary (\a -> not (prettyPositive a) || (a > 10.0) ||                     (log . exp $ a) ≈ a &&                     (exp . log $ a) ≈ a))+    , ("for +ive b, a != 0,1: a ** logBase a b ≈ b"+      , Binary (\a b ->+                  ( not (prettyPositive b) ||+                    not (nearZero (a - zero)) ||+                    (a == one) ||+                    (a == zero && nearZero (logBase a b)) ||+                    (a ** logBase a b ≈ b))))     ] -expFieldRepLaws ::-    ( Representable r+expFieldNaperianLaws ::+    ( Naperian r+    , Additive (r a)+    , ExpField (r a)     , Foldable r     , ExpField a     , Epsilon a+    , Epsilon (r a)     , Fractional a     , Ord a     ) => [Law (r a)]-expFieldRepLaws =+expFieldNaperianLaws =     [ ("sqrt . (**2) ≈ id"       , Unary (\a -> not (all prettyPositive a) || any (>10.0) a ||                     (sqrt . (**(one+one)) $ a) ≈ a &&@@ -605,11 +636,21 @@       , Unary (\a -> not (all prettyPositive a) || any (>10.0) a ||                     (log . exp $ a) ≈ a &&                     (exp . log $ a) ≈ a))+    , ("for +ive b, a != 0,1: a ** logBase a b ≈ b"+      , Binary (\a b ->+                  ( not (all prettyPositive b) ||+                    not (all nearZero a) ||+                    all (==one) a ||+                    (all (==zero) a && all nearZero (logBase a b)) ||+                    (a ** logBase a b ≈ b))))     ]  additiveModuleLaws ::     ( Eq (r a)+    , Naperian r+    , Additive (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r     , AdditiveModule r a     ) => [Law2 (r a) a]@@ -629,9 +670,11 @@     ( Eq (r a)     , Show a     , Arbitrary a+    , Naperian r     , Show (r a)     , Arbitrary (r a)     , Epsilon a+    , Additive (r a)     , AdditiveModule r a     ) => [Law2 (r a) a] additiveModuleLawsFail =@@ -649,7 +692,11 @@ additiveGroupModuleLaws ::     ( Eq (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r+    , Additive (r a)+    , AdditiveGroup (r a)     , AdditiveGroupModule r a     ) => [Law2 (r a) a] additiveGroupModuleLaws =@@ -673,7 +720,11 @@     , Show (r a)     , Arbitrary (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r+    , Additive (r a)+    , AdditiveGroup (r a)     , AdditiveGroupModule r a     ) => [Law2 (r a) a] additiveGroupModuleLawsFail =@@ -693,7 +744,11 @@ multiplicativeModuleLaws ::     ( Eq (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r+    , Additive (r a)+    , Multiplicative (r a)     , AdditiveModule r a     , MultiplicativeModule r a     ) => [Law2 (r a) a]@@ -716,11 +771,15 @@ multiplicativeModuleLawsFail ::     ( Eq (r a)     , Epsilon a+    , Epsilon (r a)     , Show a     , Arbitrary a     , Show (r a)     , Arbitrary (r a)     , Foldable r+    , Naperian r+    , Additive (r a)+    , Multiplicative (r a)     , AdditiveModule r a     , MultiplicativeModule r a     ) => [Law2 (r a) a]@@ -744,7 +803,12 @@     ( Eq (r a)     , Eq a     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r+    , AdditiveUnital (r a)+    , Multiplicative (r a)+    , MultiplicativeGroup (r a)     , MultiplicativeGroupModule r a     ) => [Law2 (r a) a] multiplicativeGroupModuleLaws =@@ -769,7 +833,12 @@     , Show (r a)     , Arbitrary (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r+    , AdditiveUnital (r a)+    , Multiplicative (r a)+    , MultiplicativeGroup (r a)     , MultiplicativeGroupModule r a     ) => [Law2 (r a) a] multiplicativeGroupModuleLawsFail =@@ -777,12 +846,14 @@       ("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 commutative: (a * b) ./ c == (a ./ c) * b"+        , Failiary2 $ expectFailure .+          (\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))+    , ("multiplicative group module basis unital: a /. one == pureRep a"+        , Failiary2 $ expectFailure .+          (\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))     ]@@ -791,6 +862,9 @@     ( Eq (r a)     , Foldable r     , Epsilon a+    , Epsilon (r a)+    , Naperian r+    , AdditiveUnital (r a)     , AdditiveBasis r a     ) => [Law (r a)] additiveBasisLaws =@@ -801,6 +875,26 @@     , ("commutative: a .+. b == b .+. a", Binary (\a b -> a .+. b == b .+. a))     ] +additiveBasisLawsFail ::+    ( Eq (r a)+    , Arbitrary (r a)+    , Show (r a)+    , Foldable r+    , Epsilon a+    , Naperian r+    , Epsilon (r a)+    , AdditiveUnital (r a)+    , AdditiveBasis r a+    ) => [Law (r a)]+additiveBasisLawsFail =+    [ ( "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))+    ]+ additiveGroupBasisLaws ::     ( Eq (r a)     , AdditiveGroupBasis r a@@ -811,6 +905,8 @@  multiplicativeBasisLaws ::     ( Eq (r a)+    , Naperian r+    , Multiplicative (r a)     , MultiplicativeBasis r a     ) => [Law (r a)] multiplicativeBasisLaws =@@ -825,6 +921,8 @@     ( Eq (r a)     , Show (r a)     , Arbitrary (r a)+    , Naperian r+    , Multiplicative (r a)     , MultiplicativeBasis r a     ) => [Law (r a)] multiplicativeBasisLawsFail =@@ -838,7 +936,9 @@ multiplicativeGroupBasisLaws ::     ( Eq (r a)     , Epsilon a+    , Epsilon (r a)     , Foldable r+    , Naperian r     , MultiplicativeGroupBasis r a     ) => [Law (r a)] multiplicativeGroupBasisLaws =