packages feed

numhask 0.1.2 → 0.1.3

raw patch · 14 files changed

+647/−1537 lines, 14 filesdep −adjunctionsdep −distributivedep −matrix

Dependencies removed: adjunctions, distributive, matrix, singletons, vector

Files

numhask.cabal view
@@ -1,90 +1,76 @@-name: numhask-version: 0.1.2-synopsis:-  A numeric prelude-description:-  A numeric prelude, providing a clean structure for numbers and operations that combine them.-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+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack++name:           numhask+version:        0.1.3+synopsis:       A numeric prelude+description:    A numeric prelude, providing a clean structure for numbers and operations that combine them.+category:       mathematics+homepage:       https://github.com/tonyday567/numhask#readme+bug-reports:    https://github.com/tonyday567/numhask/issues+license:        BSD3+license-file:   LICENSE+author:         Tony Day+maintainer:     tonyday567@gmail.com+copyright:      Tony Day+build-type:     Simple+cabal-version:  >= 1.10+ extra-source-files:   readme.md   stack.yaml++source-repository head+  type: git+  location: https://github.com/tonyday567/numhask+ library-  default-language:-    Haskell2010-  ghc-options:-    -Wall+  default-language: Haskell2010+  ghc-options: -Wall   hs-source-dirs:     src   exposed-modules:-    NumHask.Prelude,-    NumHask.Examples,-    NumHask.Algebra,                -    NumHask.Algebra.Additive,-    NumHask.Algebra.Basis,-    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.Shape,                -    NumHask.Vector,-    NumHask.Matrix+    NumHask.Prelude+    NumHask.Examples+    NumHask.Algebra+    NumHask.Algebra.Additive+    NumHask.Algebra.Basis+    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.Singleton+    NumHask.Laws+  other-modules:+    Paths_numhask   build-depends:-    base >= 4.7 && < 4.11,-    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 && < 3,-    matrix >=0.3.5.0 && <0.4-  default-extensions:-    NoImplicitPrelude,-    OverloadedStrings,-    UnicodeSyntax+    QuickCheck >=2.8 && <3,+    protolude >=0.1 && <0.3,+    tasty,+    tasty-quickcheck,+    base >=4.7 && <4.11+  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax  test-suite test-  default-language:-    Haskell2010-  type:-    exitcode-stdio-1.0+  default-language: Haskell2010+  type: exitcode-stdio-1.0   hs-source-dirs:     test-  main-is:-    test.hs+  main-is: test.hs   build-depends:-    base >= 4.7 && < 5,-    numhask,+    QuickCheck >=2.8 && <3,+    protolude >=0.1 && <0.3,     tasty,     tasty-quickcheck,-    doctest-  default-extensions:-    NoImplicitPrelude,-    OverloadedStrings,-    UnicodeSyntax--source-repository head-  type:-    git-  location:-    https://github.com/tonyday567/numhask+    base >=4.7 && <5,+    QuickCheck >=2.8 && <3,+    doctest,+    numhask,+    tasty,+    tasty-quickcheck+  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax
readme.md view
@@ -5,14 +5,22 @@  A numeric prelude, providing a clean structure for numbers and operations that combine them. +Field heirarchy+---+ [![Field Hierarchy](https://tonyday567.github.io/other/field.svg)](https://tonyday567.github.io/other/field.svg) +Numbers with structure+---++[![Hilbert Hierarchy](https://tonyday567.github.io/other/hilbert.svg)](https://tonyday567.github.io/other/hilbert.svg)++ This particular shed has been painted:  - by providing separately named magma-derived classes for addition and multiplication, and then being symetrical in the treatment of the two heirarchies.  A short magma structure is provided with the intention of supplying appropriate classes fro operators that are no addition nor multiplication, but this structure is not hooked up to the main classes. - to be as compatible as practical with the existing haskell ecosystem.  Ints, Integers, Floats, Doubles and Complex are taken from base and given numhask instances, so they are also Num instances.  Monoid and Semigroup are not used in numhask to maintain compatability. - as a replacement for anything in base that has a Num, Fractional or Real constraint.-- with type-checked Vector and Matrix instances using Representable to build the shape and structure. - includes QuickCheck tests of the numeric laws implicit in the classes.  This also includes tracking where laws are approximate or fail for non-exact numbers. - the usual operators (+) and (*) operators are reserved for commutative relationships, with plus and times being used for non-commutative ones. @@ -21,19 +29,6 @@ In summary, the library doesn't do anything fancy. But if having to define `(*)` when you just want a `(+)` offends your sensibilities, it may bring some sanity.  -Representable numbers------[![Hilbert Hierarchy](https://tonyday567.github.io/other/hilbert.svg)](https://tonyday567.github.io/other/hilbert.svg)--`Vector` and `Matrix` objects are provided that:--- are shape type-checked-- are based on Representable instances-- have inner and tensor product operators--These are experimental and await testing in the wild.- Usage --- @@ -44,5 +39,5 @@  'Numhask.Prelude' is designed as a drop-in replacement for Prelude and 'NoImplicitPrelude' is obligatory. Behind the scenes, the module wraps [protolude](https://www.stackage.org/package/protolude). -See [Examples](src/NumHask/Examples.hs) for basic examples, and [numhask-space](https://www.stackage.org/package/numhask-space) for slightly heavier number crunching.+See [Examples](src/NumHask/Examples.hs) for basic examples, [numhask-array](https://www.stackage.org/package/numhask-array) for numbers with structure, and [numhask-range](https://www.stackage.org/package/numhask-range) for slightly heavier number crunching.
src/NumHask/Algebra/Basis.hs view
@@ -10,7 +10,6 @@   , MultiplicativeGroupBasis(..)   ) where -import Data.Functor.Rep import NumHask.Algebra.Additive import NumHask.Algebra.Multiplicative @@ -20,47 +19,34 @@ -- > zero .+. a = a -- > a .+. zero = a -- > a .+. b == b .+. a-class (Representable m, Additive a) =>+class (Additive a) =>       AdditiveBasis m a where   infixl 7 .+.   (.+.) :: m a -> m a -> m a-  (.+.) = liftR2 (+) -instance (Representable r, Additive a) => AdditiveBasis r a- -- | element by element subtraction -- -- > a .-. a = singleton zero-class (Representable m, AdditiveGroup a) =>+class (AdditiveGroup a) =>       AdditiveGroupBasis m a where   infixl 6 .-.   (.-.) :: m a -> m a -> m a-  (.-.) = liftR2 (-) -instance (Representable r, AdditiveGroup a) => AdditiveGroupBasis r a- -- | element by element multiplication -- -- > (a .*. b) .*. c == a .*. (b .*. c) -- > singleton one .*. a = a -- > a .*. singelton one = a -- > a .*. b == b .*. a-class (Representable m, Multiplicative a) =>+class (Multiplicative a) =>       MultiplicativeBasis m a where   infixl 7 .*.   (.*.) :: m a -> m a -> m a-  (.*.) = liftR2 (*) -instance (Representable r, Multiplicative a) => MultiplicativeBasis r a- -- | element by element division -- -- > a ./. a == singleton one-class (Representable m, MultiplicativeGroup a) =>+class (MultiplicativeGroup a) =>       MultiplicativeGroupBasis m a where   infixl 7 ./.   (./.) :: m a -> m a -> m a-  (./.) = liftR2 (/)--instance (Representable r, MultiplicativeGroup a) =>-         MultiplicativeGroupBasis r a
src/NumHask/Algebra/Module.hs view
@@ -15,19 +15,17 @@   , MultiplicativeGroupModule(..)   , Banach(..)   , Hilbert(..)-  , inner   , type (><)   , TensorProduct(..)   ) where -import Data.Functor.Rep import NumHask.Algebra.Additive import NumHask.Algebra.Field import NumHask.Algebra.Metric import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring import Protolude-       (Double, Float, Foldable(..), Functor(..), Int, Integer, ($))+       (Double, Float, Int, Integer)  -- | Additive Module Laws --@@ -35,34 +33,28 @@ -- > (a + b) .+ c == (a .+ c) + b -- > a .+ zero == a -- > a .+ b == b +. a-class (Representable r, Additive a) =>+class (Additive a) =>       AdditiveModule r a where   infixl 6 .+   (.+) :: r a -> a -> r a-  r .+ a = fmap (a +) r+   infixl 6 +.   (+.) :: a -> r a -> r a-  a +. r = fmap (a +) r -instance (Representable r, Additive a) => AdditiveModule r a- -- | Subtraction Module Laws -- -- > (a + b) .- c == a + (b .- c) -- > (a + b) .- c == (a .- c) + b -- > a .- zero == a -- > a .- b == negate b +. a-class (Representable r, AdditiveGroup a) =>+class (AdditiveGroup a, AdditiveModule r a) =>       AdditiveGroupModule r a where   infixl 6 .-   (.-) :: r a -> a -> r a-  r .- a = fmap (\x -> x - a) r+   infixl 6 -.   (-.) :: a -> r a -> r a-  a -. r = fmap (\x -> a - x) r -instance (Representable r, AdditiveGroup a) => AdditiveGroupModule r a- -- | Multiplicative Module Laws -- -- > a .* one == a@@ -70,59 +62,43 @@ -- > c *. (a + b) == (c *. a) + (c *. b) -- > a .* zero == zero -- > a .* b == b *. a-class (Representable r, Multiplicative a) =>+class (Multiplicative a) =>       MultiplicativeModule r a where   infixl 7 .*   (.*) :: r a -> a -> r a-  r .* a = fmap (a *) r   infixl 7 *.   (*.) :: a -> r a -> r a-  a *. r = fmap (a *) r -instance (Representable r, Multiplicative a) => MultiplicativeModule r a- -- | Division Module Laws -- -- > nearZero a || a ./ one == a -- > b == zero || a ./ b == recip b *. a-class (Representable r, MultiplicativeGroup a) =>+class (MultiplicativeGroup a, MultiplicativeModule r a) =>       MultiplicativeGroupModule r a where   infixl 7 ./   (./) :: r a -> a -> r a-  r ./ a = fmap (/ a) r   infixl 7 /.   (/.) :: a -> r a -> r a-  a /. r = fmap (\x -> a / x) r -instance (Representable r, MultiplicativeGroup a) =>-         MultiplicativeGroupModule r a- -- | Banach (with Norm) laws form rules around size and direction of a number, with a potential crossing into another codomain. -- -- > a == singleton zero || normalize a *. size a == a-class (Representable r, ExpField a, Normed (r a) a) =>+class (ExpField a, Normed (r a) a, MultiplicativeGroupModule r a) =>       Banach r a where   normalize :: r a -> r a   normalize a = a ./ size a -instance (Normed (r a) a, ExpField a, Representable r) => Banach r a- -- | the inner product of a representable over a semiring -- -- > a <.> b == b <.> a -- > a <.> (b +c) == a <.> b + a <.> c -- > a <.> (s *. b + c) == s * (a <.> b) + a <.> c -- (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)-class (Semiring a, Foldable r, Representable r) =>+class (Semiring a) =>       Hilbert r a where   infix 8 <.>   (<.>) :: r a -> r a -> a-  (<.>) a b = sum $ liftR2 times a b --- | synonym for (<.>)-inner :: (Hilbert r a) => r a -> r a -> a-inner = (<.>)- -- | tensorial type type family (><) (a :: k1) (b :: k2) :: * @@ -157,8 +133,3 @@   outer = (><)   timesleft :: a -> (a >< a) -> a   timesright :: (a >< a) -> a -> a--instance (Hilbert r a, Multiplicative 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)
src/NumHask/Algebra/Ring.hs view
@@ -47,10 +47,8 @@ -- > (a + b) `times` c == a `times` c + b `times` c -- > a `times` zero == zero -- > zero `times` a == zero-class ( AdditiveGroup a-      , MultiplicativeAssociative a-      , MultiplicativeUnital a-      , Distribution a+class ( Semiring a+      , AdditiveGroup a       ) =>       Ring a
+ src/NumHask/Algebra/Singleton.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -Wall #-}++-- | Homomorphic operation from element to structured number+module NumHask.Algebra.Singleton+  ( Singleton(..)+  ) where++-- | This class could also be called replicate.  Looking forward, however, it may be useful to consider a Representable such as+--+-- > VectorThing a = Vector a | Single a | Zero+--+-- and then+--+-- > singleton a = Single a+-- > singleton zero = Zero+--+-- short-circuiting an expensive computation.  As the class action then doesn't actually involve replication, it would be mis-named.+--+class Singleton f where+  singleton :: a -> f a+
src/NumHask/Examples.hs view
@@ -24,10 +24,7 @@     -- $matrices   ) where -import Data.Functor.Rep-import NumHask.Matrix import NumHask.Prelude-import NumHask.Vector  -- $imports -- NumHask.Prelude is a replacement for the standard prelude with the 'NoImplicitPrelude' extension explicitly required.@@ -113,79 +110,3 @@ -- 6 :+ 8 -- >>> (1 :+ (-1)) / (2 :+ 2) -- 0.0 :+ (-0.5)--- $vector--- A 'Vector' is a 'Representable' 'Functor' where the representation is an 'Int'.------ >>> import NumHask.Vector--- >>> :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]--- >>> 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])--- >>> let c = [1.0,2.0] :: Vector 3 Float--- >>> let d = [3.0,2.0] :: Vector 3 Float--- >>> c / d--- [0.33333334,1.0,NaN]--- >>> 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]]]--- $matrices--- A 'Matrix' is a 'Representable' 'Functor' where the representation is an (Int,Int).------ >>> import NumHask.Matrix--- >>> :set -XDataKinds--- >>> :set -XOverloadedLists--- >>> [] :: Matrix 2 1 Int--- [[0]---  [0]]--- >>> let a = [1..] :: Matrix 2 3 Int--- >>> let b = trans a--- >>> a--- [[1,2,3]---  [4,5,6]]--- >>> b--- [[1,4]---  [2,5]---  [3,6]]--- >>> mmult a b--- [[14,32]---  [32,77]]--- >>> getDiag one == (one :: Vector 6 Int)--- True--- >>> diagonal one == (one :: Matrix 4 4 Int)--- True--- >>> let a = [1..] :: Matrix 3 3 Int--- >>> a <.> a--- 285--- >>> toVV a <.> toVV a--- [66,93,126]
+ src/NumHask/Laws.hs view
@@ -0,0 +1,533 @@+{-# LANGUAGE FlexibleContexts #-}++module NumHask.Laws+  ( LawArity(..)+  , LawArity2(..)+  , Law+  , Law2+  , testLawOf+  , testLawOf2+  , idempotentLaws+  , additiveLaws+  , additiveLawsFail+  , additiveGroupLaws+  , multiplicativeLaws+  , multiplicativeLawsFail+  , multiplicativeMonoidalLaws+  , multiplicativeGroupLaws+  , distributionLaws+  , distributionLawsFail+  , integralLaws+  , signedLaws+  , metricFloatLaws +  , metricComplexFloatLaws+  , boundedFieldFloatLaws+  , quotientFieldLaws +  , expFieldLaws+  , expFieldComplexLooseLaws  +  , additiveBasisLaws+  , additiveGroupBasisLaws+  , multiplicativeBasisLaws+  , multiplicativeGroupBasisLaws+  , additiveModuleLaws+  , additiveGroupModuleLaws+  , multiplicativeModuleLaws+  , multiplicativeGroupModuleLawsFail+  , expFieldNaperianLaws+  , metricNaperianFloatLaws+  , tensorProductLaws+  , banachLaws+  , hilbertLaws+  ) where++import NumHask.Prelude+import Test.Tasty.QuickCheck hiding ((><))+import Test.Tasty (TestName, TestTree)++data LawArity a+  = Nonary Bool+  | Unary (a -> Bool)+  | Binary (a -> a -> Bool)+  | Ternary (a -> a -> a -> Bool)+  | Ornary (a -> a -> a -> a -> Bool)+  | Failiary (a -> Property)++data LawArity2 a b+  = Unary2 (a -> Bool)+  | Binary2 (a -> b -> Bool)+  | Ternary2 (a -> a -> b -> Bool)+  | Ternary2' (a -> b -> b -> Bool)+  | Ternary2'' (a -> a -> a -> Bool)+  | Quad31 (a -> a -> a -> b -> Bool)+  | Quad22 (a -> a -> b -> b -> Bool)+  | Failiary2 (a -> Property)++type Law a = (TestName, LawArity a)++type Law2 a b = (TestName, LawArity2 a b)++testLawOf :: (Arbitrary a, Show a) => [a] -> Law a -> TestTree+testLawOf _ (name, Nonary f) = testProperty name f+testLawOf _ (name, Unary f) = testProperty name f+testLawOf _ (name, Binary f) = testProperty name f+testLawOf _ (name, Ternary f) = testProperty name f+testLawOf _ (name, Ornary f) = testProperty name f+testLawOf _ (name, Failiary f) = testProperty name f++testLawOf2 ::+     (Arbitrary a, Show a, Arbitrary b, Show b)+  => [(a, b)]+  -> Law2 a b+  -> TestTree+testLawOf2 _ (name, Unary2 f) = testProperty name f+testLawOf2 _ (name, Binary2 f) = testProperty name f+testLawOf2 _ (name, Ternary2 f) = testProperty name f+testLawOf2 _ (name, Ternary2' f) = testProperty name f+testLawOf2 _ (name, Ternary2'' f) = testProperty name f+testLawOf2 _ (name, Quad22 f) = testProperty name f+testLawOf2 _ (name, Quad31 f) = testProperty name f+testLawOf2 _ (name, Failiary2 f) = testProperty name f++-- idempotent+idempotentLaws :: (Eq a, Additive a, Multiplicative a) => [Law a]+idempotentLaws =+  [ ("idempotent: a + a == a", Unary (\a -> a + a == a))+  , ("idempotent: a * a == a", Unary (\a -> a * a == a))+  ]++-- additive+additiveLaws :: (Eq a, Additive a) => [Law a]+additiveLaws =+  [ ( "associative: (a + b) + c = a + (b + c)"+    , Ternary (\a b c -> (a + b) + c == a + (b + c)))+  , ("left id: zero + a = a", Unary (\a -> zero + a == a))+  , ("right id: a + zero = a", Unary (\a -> a + zero == a))+  , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))+  ]++additiveLawsFail :: (Eq a, Additive a, Show a, Arbitrary a) => [Law a]+additiveLawsFail =+  [ ( "associative: (a + b) + c = a + (b + c)"+    , Failiary $ expectFailure . (\a b c -> (a + b) + c == a + (b + c)))+  , ("left id: zero + a = a", Unary (\a -> zero + a == a))+  , ("right id: a + zero = a", Unary (\a -> a + zero == a))+  , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))+  ]++additiveGroupLaws :: (Eq a, AdditiveGroup a) => [Law a]+additiveGroupLaws =+  [ ("minus: a - a = zero", Unary (\a -> (a - a) == zero))+  , ("negate minus: negate a == zero - a", Unary (\a -> negate a == zero - a))+  , ( "negate left cancel: negate a + a == zero"+    , Unary (\a -> negate a + a == zero))+  , ( "negate right cancel: negate a + a == zero"+    , Unary (\a -> a + negate a == zero))+  ]++-- multiplicative+multiplicativeLaws :: (Eq a, Multiplicative a) => [Law a]+multiplicativeLaws =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Ternary (\a b c -> (a * b) * c == a * (b * c)))+  , ("left id: one * a = a", Unary (\a -> one * a == a))+  , ("right id: a * one = a", Unary (\a -> a * one == a))+  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))+  ]++multiplicativeMonoidalLaws ::+     (Eq a, MultiplicativeUnital a, MultiplicativeAssociative a) => [Law a]+multiplicativeMonoidalLaws =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Ternary (\a b c -> (a `times` b) `times` c == a `times` (b `times` c)))+  , ("left id: one `times` a = a", Unary (\a -> one `times` a == a))+  , ("right id: a `times` one = a", Unary (\a -> a `times` one == a))+  ]++multiplicativeLawsFail ::+     (Eq a, Show a, Arbitrary a, Multiplicative a) => [Law a]+multiplicativeLawsFail =+  [ ( "associative: (a * b) * c = a * (b * c)"+    , Failiary $ expectFailure . (\a b c -> (a * b) * c == a * (b * c)))+  , ("left id: one * a = a", Unary (\a -> one * a == a))+  , ("right id: a * one = a", Unary (\a -> a * one == a))+  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))+  ]++multiplicativeGroupLaws :: (Epsilon a, Eq a, MultiplicativeGroup a) => [Law a]+multiplicativeGroupLaws =+  [ ( "divide: a == zero || a / a ≈ one"+    , Unary (\a -> a == zero || (a / a) ≈ one))+  , ( "recip divide: recip a == one / a"+    , Unary (\a -> a == zero || recip a == one / a))+  , ( "recip left: a == zero || recip a * a ≈ one"+    , Unary (\a -> a == zero || recip a * a ≈ one))+  , ( "recip right: a == zero || a * recip a ≈ one"+    , Unary (\a -> a == zero || a * recip a ≈ one))+  ]++-- distribution+distributionLaws :: (Eq a, Distribution a) => [Law a]+distributionLaws =+  [ ( "left annihilation: a * zero == zero"+    , Unary (\a -> a `times` zero == zero))+  , ( "right annihilation: zero * a == zero"+    , Unary (\a -> zero `times` a == zero))+  , ( "left distributivity: a * (b + c) == a * b + a * c"+    , Ternary (\a b c -> a `times` (b + c) == a `times` b + a `times` c))+  , ( "right distributivity: (a + b) * c == a * c + b * c"+    , Ternary (\a b c -> (a + b) `times` c == a `times` c + b `times` c))+  ]++distributionLawsFail ::+     (Show a, Arbitrary a, Epsilon a, Eq a, Distribution a) => [Law a]+distributionLawsFail =+  [ ( "left annihilation: a * zero == zero"+    , Unary (\a -> a `times` zero == zero))+  , ( "right annihilation: a * zero == zero"+    , Unary (\a -> zero `times` a == zero))+  , ( "left distributivity: a * (b + c) = a * b + a * c"+    , Failiary $+      expectFailure . (\a b c -> a `times` (b + c) == a `times` b + a `times` c))+  , ( "right distributivity: (a + b) * c = a * c + b * c"+    , Failiary $+      expectFailure . (\a b c -> (a + b) `times` c == a `times` c + b `times` c))+  ]++-- integral+integralLaws :: (Eq a, Integral a, FromInteger a, ToInteger a) => [Law a]+integralLaws =+  [ ( "integral divmod: b == zero || b * (a `div` b) + (a `mod` b) == a"+    , Binary (\a b -> b == zero || b `times` (a `div` b) + (a `mod` b) == a))+  , ("fromIntegral a = a", Unary (\a -> fromIntegral a == a))+  ]++-- metric+signedLaws :: (Eq a, Signed a) => [Law a]+signedLaws = [("sign a * abs a == a", Unary (\a -> sign a `times` abs a == a))]++metricFloatLaws :: () => [Law Float]+metricFloatLaws =+  [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))+  , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))+  , ( "associative"+    , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))+  , ( "triangle rule - sum of distances > distance"+    , Ternary+        (\a b c ->+           (abs a > 10.0) ||+           (abs b > 10.0) ||+           (abs c > 10.0) ||+           not+             (veryNegative+                (distance a c + distance b c - (distance a b :: Float))) &&+           not+             (veryNegative+                (distance a b + distance b c - (distance a c :: Float))) &&+           not+             (veryNegative+                (distance a b + distance a c - (distance b c :: Float)))))+  ]++metricComplexFloatLaws :: () => [Law (Complex Float)]+metricComplexFloatLaws =+  [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))+  , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))+  , ( "associative"+    , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))+  , ( "triangle rule - sum of distances > distance"+    , Ternary+        (\a b c ->+           (size a > (10.0 :: Float)) ||+           (size b > (10.0 :: Float)) ||+           (size c > (10.0 :: Float)) ||+           not+             (veryNegative+                (distance a c + distance b c - (distance a b :: Float))) &&+           not+             (veryNegative+                (distance a b + distance b c - (distance a c :: Float))) &&+           not+             (veryNegative+                (distance a b + distance a c - (distance b c :: Float)))))+  ]++-- field+boundedFieldFloatLaws :: [Law Float]+boundedFieldFloatLaws =+  [ ( "infinity laws"+    , Unary+        (\a ->+           ((one :: Float) / zero + infinity == infinity) &&+           (infinity + a == infinity) &&+           isNaN ((infinity :: Float) - infinity) &&+           isNaN ((infinity :: Float) / infinity) &&+           isNaN (nan + a) && (zero :: Float) / zero /= nan))+  ]++quotientFieldLaws :: (Ord a, Field a, QuotientField a, FromInteger a) => [Law a]+quotientFieldLaws =+  [ ( "a - one < floor a <= a <= ceiling a < a + one"+    , Unary+        (\a ->+           ((a - one) < fromIntegral (floor a)) &&+           (fromIntegral (floor a) <= a) &&+           (a <= fromIntegral (ceiling a)) &&+           (fromIntegral (ceiling a) < a + one)))+  , ( "round a == floor (a + one/(one+one))"+    , Unary (\a -> round a == floor (a + one / (one + one))))+  ]++expFieldLaws ::+     (ExpField a, Signed a, Epsilon a, Fractional a, Ord a) => [Law a]+expFieldLaws =+  [ ( "sqrt . (**(one+one)) ≈ id"+    , Unary+        (\a ->+           not (veryPositive a) ||+           (a > 10.0) ||+           (sqrt . (** (one + one)) $ a) ≈ a &&+           ((** (one + one)) . sqrt $ a) ≈ a))+  , ( "log . exp ≈ id"+    , Unary+        (\a ->+           not (veryPositive a) ||+           (a > 10.0) || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))+  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"+    , Binary+        (\a b ->+           (not (veryPositive b) ||+            not (nearZero (a - zero)) ||+            (a == one) ||+            (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b))))+  ]++expFieldComplexLooseLaws :: Float -> [Law (Complex Float)]+expFieldComplexLooseLaws _ =+  [ ( "sqrt . (**(one+one)) ≈ id test contains a stack overflow"+    , Unary (const True))+  , ("log . exp test contains a stack overflow", Unary (const True))+  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"+    , Binary+        (\a b@(rb :+ ib) ->+           (not (rb > zero && ib > zero) ||+            not (nearZero (a - zero)) ||+            (a == one) ||+            (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b))))+  ]++metricNaperianFloatLaws :: (Metric (r Float) Float) => [Law (r Float)]+metricNaperianFloatLaws =+  [ ("positive", Binary (\a b -> distance a b >= (zero :: Float)))+  , ("zero if equal", Unary (\a -> distance a a == (zero :: Float)))+  , ("associative", Binary (\a b -> distance a b ≈ (distance b a :: Float)))+  , ( "triangle rule - sum of distances > distance"+    , Ternary+        (\a b c ->+           not+             (veryNegative+                (distance a c + distance b c - (distance a b :: Float))) &&+           not+             (veryNegative+                (distance a b + distance b c - (distance a c :: Float))) &&+           not+             (veryNegative+                (distance a b + distance a c - (distance b c :: Float)))))+  ]++expFieldNaperianLaws ::+     ( ExpField (r a)+     , Foldable r+     , ExpField a+     , Epsilon a+     , Signed a+     , Epsilon (r a)+     , Fractional a+     , Ord a+     )+  => [Law (r a)]+expFieldNaperianLaws =+  [ ( "sqrt . (**2) ≈ id"+    , Unary+        (\a ->+           not (all veryPositive a) ||+           any (> 10.0) a ||+           (sqrt . (** (one + one)) $ a) ≈ a &&+           ((** (one + one)) . sqrt $ a) ≈ a))+  , ( "log . exp ≈ id"+    , Unary+        (\a ->+           not (all veryPositive a) ||+           any (> 10.0) a || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))+  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"+    , Binary+        (\a b ->+           (not (all veryPositive b) ||+            not (all nearZero a) ||+            all (== one) a ||+            (all (== zero) a && all nearZero (logBase a b)) ||+            (a ** logBase a b ≈ b))))+  ]++-- module+additiveModuleLaws ::+     (Eq (r a), Epsilon a, Epsilon (r a), AdditiveModule r a) => [Law2 (r a) a]+additiveModuleLaws =+  [ ( "additive module associative: (a + b) .+ c ≈ a + (b .+ c)"+    , Ternary2 (\a b c -> (a + b) .+ c ≈ a + (b .+ c)))+  , ( "additive module commutative: (a + b) .+ c ≈ (a .+ c) + b"+    , Ternary2 (\a b c -> (a + b) .+ c ≈ (a .+ c) + b))+  , ("additive module unital: a .+ zero == a", Unary2 (\a -> a .+ zero == a))+  , ( "module additive equivalence: a .+ b ≈ b +. a"+    , Binary2 (\a b -> a .+ b ≈ b +. a))+  ]++additiveGroupModuleLaws ::+     (Eq (r a), Epsilon a, Epsilon (r a), AdditiveGroupModule r a)+  => [Law2 (r a) a]+additiveGroupModuleLaws =+  [ ( "additive group module associative: (a + b) .- c ≈ a + (b .- c)"+    , Ternary2 (\a b c -> (a + b) .- c ≈ a + (b .- c)))+  , ( "additive group module commutative: (a + b) .- c ≈ (a .- c) + b"+    , Ternary2 (\a b c -> (a + b) .- c ≈ (a .- c) + b))+  , ( "additive group module unital: a .- zero == a"+    , Unary2 (\a -> a .- zero == a))+  , ( "module additive group equivalence: a .- b ≈ negate b +. a"+    , Binary2 (\a b -> a .- b ≈ negate b +. a))+  ]++multiplicativeModuleLaws ::+     (Eq (r a), Epsilon a, Epsilon (r a), MultiplicativeModule r a)+  => [Law2 (r a) a]+multiplicativeModuleLaws =+  [ ( "multiplicative module unital: a .* one == a"+    , Unary2 (\a -> a .* one == a))+  , ( "module right distribution: (a + b) .* c ≈ (a .* c) + (b .* c)"+    , Ternary2 (\a b c -> (a + b) .* c ≈ (a .* c) + (b .* c)))+  , ( "module left distribution: c *. (a + b) ≈ (c *. a) + (c *. b)"+    , Ternary2 (\a b c -> c *. (a + b) ≈ (c *. a) + (c *. b)))+  , ("annihilation: a .* zero == zero", Unary2 (\a -> a .* zero == zero))+  , ( "module multiplicative equivalence: a .* b ≈ b *. a"+    , Binary2 (\a b -> a .* b ≈ b *. a))+  ]++multiplicativeGroupModuleLawsFail ::+     ( Eq a+     , Show a+     , Arbitrary a+     , Eq (r a)+     , Show (r a)+     , Arbitrary (r a)+     , Epsilon a+     , Epsilon (r a)+     , MultiplicativeGroupModule r a+     )+  => [Law2 (r a) a]+multiplicativeGroupModuleLawsFail =+  [ ( "multiplicative group module unital: a ./ one == a"+    , Unary2 (\a -> nearZero a || a ./ one == a))+  , ( "module multiplicative group equivalence: a ./ b ≈ recip b *. a"+    , Binary2 (\a b -> b == zero || a ./ b ≈ recip b *. a))+  ]++banachLaws ::+     ( Ord a+     , Fractional a+     , Signed a+     , Foldable r+     , Fractional b+     , Eq (r a)+     , Epsilon b+     , Epsilon (r a)+     , Metric (r a) b+     , MultiplicativeGroup b+     , Banach r a+     , Normed (r a) b+     , Singleton r+     )+  => [Law2 (r a) b]+banachLaws =+  [ ( "normalize a .* size a ≈ one"+    , Unary2+        (\a ->+           a == singleton zero ||+           (any ((> 10.0) . abs) a || (normalize a .* size a) ≈ a)))+  ]++hilbertLaws ::+    ( Eq (r a)+    , Eq a+    , Multiplicative a+    , MultiplicativeModule r a+    , Epsilon a+    , Epsilon (r a)+    , Hilbert r a)+  => [Law2 (r a) a]+hilbertLaws =+  [ ("commutative a <.> b ≈ b <.> a", Ternary2 (\a b _ -> a <.> b ≈ b <.> a))+  , ( "distributive over addition a <.> (b + c) == a <.> b + a <.> c"+    , Ternary2'' (\a b c -> a <.> (b + c) ≈ a <.> b + a <.> c))+  , ( "bilinear a <.> (s *. b + c) == s * (a <.> b) + a <.> c"+    , Quad31 (\a b c s -> a <.> (s *. b + c) == s * (a <.> b) + a <.> c))+  , ( "scalar multiplication (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)"+    , Quad22 (\a b s0 s1 -> (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)))+  ]++tensorProductLaws ::+     ( Eq (r (r a))+     , Additive (r (r a))+     , Eq (r a)+     , Eq a+     , TensorProduct (r a)+     , Epsilon a+     , Epsilon (r a)+     )+  => [Law2 (r a) a]+tensorProductLaws =+  [ ( "left distribution over addition a><b + c><b == (a+c) >< b"+    , Ternary2'' (\a b c -> a >< b + c >< b == (a + c) >< b))+  , ( "right distribution over addition a><b + a><c == a >< (b+c)"+    , Ternary2'' (\a b c -> a >< b + a >< c == a >< (b + c)))+  -- , ( "left module tensor correspondance a *. (b><c) == (a><b) .* c"+  --   , Ternary2'' (\a b c -> a *. (b><c) == (a><b) .* c))+  -- , ( "right module tensor correspondance (a><b) .* c == a *. (b><c)"+  --   , Ternary2'' (\a b c -> (a><b) .* c == a *. (b><c)))+  ]++-- basis+additiveBasisLaws :: (Eq (r a), Epsilon (r a), AdditiveBasis r a) => [Law (r a)]+additiveBasisLaws =+  [ ( "associative: (a .+. b) .+. c ≈ a .+. (b .+. c)"+    , Ternary (\a b c -> (a .+. b) .+. c ≈ a .+. (b .+. c)))+  , ("left id: zero .+. a = a", Unary (\a -> zero .+. a == a))+  , ("right id: a .+. zero = a", Unary (\a -> a .+. zero == a))+  , ("commutative: a .+. b == b .+. a", Binary (\a b -> a .+. b == b .+. a))+  ]++additiveGroupBasisLaws :: (Eq (r a), Singleton r, AdditiveGroupBasis r a) => [Law (r a)]+additiveGroupBasisLaws =+  [ ( "minus: a .-. a = singleton zero"+    , Unary (\a -> (a .-. a) == singleton zero))+  ]++multiplicativeBasisLaws :: (Eq (r a), Singleton r, MultiplicativeBasis r a) => [Law (r a)]+multiplicativeBasisLaws =+  [ ( "associative: (a .*. b) .*. c == a .*. (b .*. c)"+    , Ternary (\a b c -> (a .*. b) .*. c == a .*. (b .*. c)))+  , ("left id: singleton one .*. a = a", Unary (\a -> singleton one .*. a == a))+  , ( "right id: a .*. singleton one = a"+    , Unary (\a -> a .*. singleton one == a))+  , ("commutative: a .*. b == b .*. a", Binary (\a b -> a .*. b == b .*. a))+  ]++multiplicativeGroupBasisLaws ::+     ( Eq (r a)+     , Epsilon a+     , Epsilon (r a)+     , Singleton r+     , MultiplicativeGroupBasis r a+     )+  => [Law (r a)]+multiplicativeGroupBasisLaws =+  [ ( "basis divide: a ./. a ≈ singleton one"+    , Unary (\a -> a == singleton zero || (a ./. a) ≈ singleton one))+  ]
− src/NumHask/Matrix.hs 
@@ -1,429 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_GHC -Wall #-}---- | 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(..)-    -- ** Conversion-  , someMatrix-  , unsafeToMatrix-  , toMatrix-  , unsafeFromVV-  , toVV-  , toCol-  , toRow-  , fromCol-  , fromRow-  , col-  , row-  , joinc-  , joinr-  , resize-  , reshape-    -- ** Operations-  , mmult-  , trans-  , getDiag-  , diagonal-  , mapc-  , mapr-    -- ** Arbitrary-  , ShapeM(..)-  ) where--import Data.Distributive as D-import Data.Functor.Rep-import Data.Proxy (Proxy(..))-import qualified Data.Vector as V-import GHC.Exts-import GHC.Show-import GHC.TypeLits-import Protolude (Ord(..), Fractional, Functor, Eq, Foldable, Traversable, Maybe(..), ($), (<$>), fmap, (.))-import NumHask.Algebra-import NumHask.Shape-import NumHask.Vector-import qualified Protolude as P-import Test.QuickCheck hiding (resize)-import Data.Singletons.Prelude.Num-import qualified Data.Matrix as Matrix---- | 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.------ todo: the natural type for a matrix, the output from a vector outer product for example, is a 'Vector' ('Vector' a).  We should be able to unify to a different representation such as this, using type families.-newtype Matrix m n a = Matrix-  { flattenMatrix :: V.Vector a-  } deriving (Functor, Eq, Foldable, Traversable)--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))--instance (Show a, KnownNat m, KnownNat n) =>-         Show (Matrix (m :: Nat) (n :: Nat) a) where-  show m = "[" P.++ P.intercalate "\n " (P.toList (show <$> toVV m)) P.++ "]"--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 n))-    where-      m = P.fromInteger $ natVal (Proxy :: Proxy m)-      n = P.fromInteger $ natVal (Proxy :: Proxy n)-  index (Matrix xs) (i0, i1) = xs V.! (i0 * n + i1)-    where-      n = P.fromInteger $ natVal (Proxy :: Proxy n)---- | 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 where-  type Shape SomeMatrix = (Int, Int)-  shape (SomeMatrix sh _) = sh--instance (Show a) => Show (SomeMatrix a) where-  show (SomeMatrix _ v) = show (P.toList v)---- ** 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 P.== (m, n)-    then Just $ Matrix v-    else Nothing-  where-    m = P.fromInteger $ natVal (Proxy :: Proxy m)-    n = P.fromInteger $ natVal (Proxy :: Proxy n)--toDMatrix :: forall a m n. (KnownNat m, KnownNat n)-  => Matrix (m :: Nat) (n :: Nat) a-    -> Matrix.Matrix a-toDMatrix x = Matrix.matrix m n (\(i,j) -> index x (i-1,j-1))-  where-    m = P.fromInteger $ natVal (Proxy :: Proxy m)-    n = P.fromInteger $ natVal (Proxy :: Proxy n)--fromDMatrix :: forall a m n. (AdditiveUnital a, KnownNat m, KnownNat n)-  => Matrix.Matrix a-    -> Matrix (m :: Nat) (n :: Nat) a-fromDMatrix x = fromList $ Matrix.toList x---- | 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)]---- | 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---- | conversion to a double Vector representation-toVV ::-     forall a m n. (KnownNat m, KnownNat n)-  => Matrix m n a-  -> Vector m (Vector n a)-toVV m = tabulate (row m)---- | 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)-  => Matrix m n a-  -> Int-  -> Vector n a-row (Matrix a) i = Vector $ V.unsafeSlice (i * n) n a-  where-    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)-  => Matrix m n a-  -> Int-  -> Vector m a-col (Matrix a) i = 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)----- | resize matrix, appending with zero if needed-resize :: forall m0 m1 n0 n1 a. ( KnownNat m0, KnownNat m1-                 , KnownNat n0, KnownNat n1, AdditiveUnital a)-  => Matrix m0 n0 a-  -> Matrix m1 n1 a-resize m = tabulate-    (\(i,j) -> if i < m0 P.&& i < n0 then index m (i,j) else zero)-  where-    m0 = P.fromInteger $ natVal (Proxy :: Proxy m0)-    n0 = P.fromInteger $ natVal (Proxy :: Proxy n0)---- | reshape matrix, appending with zero if needed-reshape :: forall m0 m1 n0 n1 a. ( KnownNat m0, KnownNat m1-                 , KnownNat n0, KnownNat n1, AdditiveUnital a)-  => Matrix m0 n0 a-  -> Matrix m1 n1 a-reshape (Matrix v) = tabulate-    (\(i,j) -> if i*n0+j < (m0*n0) then v V.! (i*n0+j) else zero)-  where-    m0 = P.fromInteger $ natVal (Proxy :: Proxy m0)-    n0 = P.fromInteger $ natVal (Proxy :: Proxy n0)------ ** Operations--- | matrix transposition------ trans . trans == identity-trans ::-     forall m n a. (KnownNat m, KnownNat n)-  => Matrix m n a-  -> Matrix n m a-trans x = tabulate (\(i, j) -> index x (j,i))---- | extract the matrix diagonal as a vector------ > getDiag one == one-getDiag ::-     forall n a. (KnownNat n)-  => Matrix n n a-  -> Vector n a-getDiag x = tabulate (\i -> index x (i,i))---- | create a matrix using a vector as the diagonal------ > diagonal one = one--- > getDiag . diagonal == identity-diagonal :: forall n a. (KnownNat n, AdditiveUnital a)-  => Vector n a-  -> Matrix n n a-diagonal v = tabulate (\(i,j) -> if i P.== j then index v i else zero)--inv ::-     forall n a. (BoundedField a, Eq a, Fractional a, KnownNat n)-  => Matrix n n a-  -> Matrix n n a-inv = P.either (P.const $ singleton nan) fromDMatrix . Matrix.inverse . toDMatrix---- | map a homomorphic vector function, row-wise-mapr ::-     forall m n a. (KnownNat m, KnownNat n)-  => (Vector n a -> Vector n a)-  -> Matrix m n a-  -> Matrix m n a-mapr f x = unsafeFromVV $ tabulate (f . row x)---- | map a homomorphic vector function, column-wise-mapc ::-     forall m n a. (KnownNat m, KnownNat n)-  => (Vector m a -> Vector m a)-  -> Matrix m n a-  -> Matrix m n a-mapc f x = unsafeFromVV $ distribute $ tabulate (f . col x)---- | matrix multiplication-mmult ::-     forall m n k a. (Hilbert (Vector k) 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 x i <.> col y j)---- | join column-wise-joinc :: forall m n0 n1 a. ( KnownNat m-                 , KnownNat n0-                 , KnownNat n1-                 , Representable (Matrix m (n0 :+ n1)))-  => Matrix m n0 a-  -> Matrix m n1 a-  -> Matrix m (n0 :+ n1) a-joinc x y = tabulate-    (\(i,j) -> if j<n0 then index x (i,j) else index y (i,j-n0))-  where-    n0 = P.fromInteger $ natVal (Proxy :: Proxy n0)---- | join row-wise-joinr :: forall m0 m1 n a. ( KnownNat m0-                 , KnownNat m1-                 , KnownNat n-                 , Representable (Matrix (m0 :+ m1) n))-  => Matrix m0 n a-  -> Matrix m1 n a-  -> Matrix (m0 :+ m1) n a-joinr x y = tabulate-    (\(i,j) -> if i<m0 then index x (i,j) else index y (i - m0,j))-  where-    m0 = P.fromInteger $ natVal (Proxy :: Proxy m0)---- ** Arbitrary--- | 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))-      ]---- NumHask heirarchy-instance (KnownNat m, KnownNat n, AdditiveMagma a) =>-         AdditiveMagma (Matrix m n a) where-  plus = liftR2 plus--instance (KnownNat m, KnownNat n, AdditiveUnital a) =>-         AdditiveUnital (Matrix m n a) where-  zero = singleton zero--instance (KnownNat m, KnownNat n, AdditiveAssociative a) =>-         AdditiveAssociative (Matrix m n a)--instance (KnownNat m, KnownNat n, AdditiveCommutative a) =>-         AdditiveCommutative (Matrix m n a)--instance (KnownNat m, KnownNat n, AdditiveInvertible a) =>-         AdditiveInvertible (Matrix m n a) where-  negate = fmapRep negate--instance (KnownNat m, KnownNat n, Additive a) => Additive (Matrix m n a)--instance (KnownNat m, KnownNat n, AdditiveGroup a) =>-         AdditiveGroup (Matrix m n a)--instance (KnownNat n, Semiring a) =>-         MultiplicativeMagma (Matrix n n a) where-  times = mmult--instance (KnownNat n, Semiring a) =>-         MultiplicativeUnital (Matrix n n a) where-  one = tabulate (\(i,j) -> if i P.== j then one else zero)--instance (KnownNat n, Semiring a) =>-         MultiplicativeAssociative (Matrix n n a)--instance (KnownNat n, Fractional a, Eq a, BoundedField a, Semiring a) =>-         MultiplicativeInvertible (Matrix n n a) where-    recip = NumHask.Matrix.inv--instance (KnownNat n, Semiring a) =>-         Distribution (Matrix n n a)--instance (KnownNat n, Semiring a) =>-         Semiring (Matrix n n a)--instance (KnownNat n, AdditiveGroup a, Semiring a) =>-         Ring (Matrix n n a)--instance (Eq a, Fractional a, BoundedField a, KnownNat n, AdditiveGroup a, Semiring a) =>-         Semifield (Matrix n n a)--instance (KnownNat m, KnownNat n, Epsilon a) => Epsilon (Matrix m n a) where-  nearZero f = P.and (fmapRep nearZero f)-  aboutEqual a b = P.and (liftR2 aboutEqual a b)--instance (Semiring a, KnownNat m, KnownNat n) => Hilbert (Matrix m n) a-
src/NumHask/Prelude.hs view
@@ -18,13 +18,8 @@   , module NumHask.Algebra.Module   , module NumHask.Algebra.Multiplicative   , module NumHask.Algebra.Ring+  , module NumHask.Algebra.Singleton -    -- * Representable Functors over numbers-    -- $representable-  , module Data.Functor.Rep-  , module NumHask.Shape-  , module NumHask.Vector-  , module NumHask.Matrix   ) where  import Protolude@@ -35,7 +30,6 @@                recip, round, sin, sinh, sqrt, sum, tan, tanh, toInteger, trans,                zero) -import Data.Functor.Rep import NumHask.Algebra.Additive import NumHask.Algebra.Basis import NumHask.Algebra.Distribution@@ -46,9 +40,7 @@ import NumHask.Algebra.Module import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring-import NumHask.Matrix-import NumHask.Shape-import NumHask.Vector+import NumHask.Algebra.Singleton  -- $backend -- NumHask imports Protolude as the prelude and replaces much of the 'Num' heirarchy in base.@@ -58,8 +50,3 @@ -- -- Instances for 'Int', 'Integer', 'Float', 'Double', 'Bool' and 'Complex' are supplied. ------ $representable--- NumHask uses 'Representable' functors over number classes to supply useful vectors and matrices that are themselves numbers (ie satisfy the class laws).------ 'Vector' and 'Matrix' instances are supplied with shape held at the type-level.
− src/NumHask/Shape.hs 
@@ -1,42 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wall #-}---- | numbers with a shape-module NumHask.Shape-  ( HasShape(..)-    -- * Representable-    -- | Representable has most of what's needed to define numbers that have elements (aka scalars) and a fixed shape.-  , Representable(..)-  , Singleton(..)-  ) where--import Data.Functor.Rep---- | Not everything that has a shape is representable.------ todo: Structure is a useful alternative concept/naming convention-class HasShape f where-  type Shape f-  shape :: f a -> Shape f---- Undecidable + missing method--- instance (Representable f) => HasShape f where---     type Shape f = Rep f--- | This class could also be called replicate.  Looking forward, however, it may be useful to consider a Representable such as------ > VectorThing a = Vector a | Single a | Zero------ and then------ > singleton a = Single a--- > singleton zero = Zero------ short-circuiting an expensive computation.  As the class action then doesn't actually involve replication, it would be mis-named.----class Singleton f where-  singleton :: a -> f a--instance (Representable f) => Singleton f where-  singleton = pureRep
− src/NumHask/Vector.hs 
@@ -1,240 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_GHC -Wall #-}---- | Two classes are supplied:------ - A 'Vector' class, with fixed-length n, where shape is held at the type level.--- - A 'SomeVector' class, with fixed-length, where shape is held at the value level.-module NumHask.Vector-  ( Vector(..)-  , SomeVector(..)-    -- ** Conversion-  , someVector-  , unsafeToVector-  , toVector-    -- ** Arbitrary-  , ShapeV(..)-  ) where--import Data.Distributive as D-import Data.Foldable-import Data.Functor.Classes-import Data.Functor.Rep-import Data.Proxy (Proxy(..))-import qualified Data.Vector as V-import GHC.Exts-import GHC.Show (show)-import GHC.TypeLits-import NumHask.Algebra-import NumHask.Shape-import Protolude-       (Maybe(..), ($), (.), (<$>), fmap, fst, identity, snd, take)-import qualified Protolude as P-import qualified Test.QuickCheck as QC---- | 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 under the hood.-newtype Vector (n :: Nat) a = Vector-  { toVec :: V.Vector a-  } deriving (P.Eq, P.Functor, Foldable, P.Traversable)--instance Eq1 (Vector n) where-  liftEq c (Vector a) (Vector b) = V.all identity $ V.zipWith c a b--instance (P.Show a, KnownNat n) => P.Show (Vector (n :: Nat) a) where-  show = show . someVector---- | pads with 'zero's 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 = Data.Foldable.toList--instance forall n. (KnownNat n) => HasShape (Vector (n :: Nat)) where-  type Shape (Vector n) = Int-  shape _ = 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 n-    where-      n = P.fromInteger $ natVal (Proxy :: Proxy n)-  index (Vector xs) i = xs V.! i--instance (KnownNat n) => P.Applicative (Vector n) where-  pure = pureRep-  (<*>) = liftR2 ($)--instance (KnownNat n, QC.Arbitrary a, AdditiveUnital a) =>-         QC.Arbitrary (Vector n a) where-  arbitrary = QC.frequency [(1, P.pure zero), (9, fromList <$> QC.vector n)]-    where-      n = P.fromInteger $ natVal (Proxy :: Proxy n)---- | a one-dimensional array where shape is specified at the value level-data SomeVector a =-  SomeVector Int-             (V.Vector a)-  deriving (P.Functor, P.Eq, Foldable, P.Ord)--instance HasShape SomeVector where-  type Shape SomeVector = Int-  shape (SomeVector sh _) = sh--instance (P.Show a) => P.Show (SomeVector a) where-  show (SomeVector _ v) = show (P.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---- ** conversion--- | convert from a 'Vector' to a 'SomeVector'-someVector :: (KnownNat r) => Vector (r :: Nat) a -> SomeVector a-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-unsafeToVector (SomeVector _ v) = Vector v---- | convert from a 'SomeVector' to a 'Vector', checking shape-toVector ::-     forall a r. (KnownNat r)-  => SomeVector a-  -> P.Maybe (Vector (r :: Nat) a)-toVector (SomeVector s v) =-  if s P.== n-    then Just $ Vector v-    else Nothing-  where-    n = P.fromInteger $ natVal (Proxy :: Proxy r)---- ** arbitrary--- | ShapeV is used to generate sensible lengths for arbitrary instances of 'SomeVector' and 'SomeMatrix'-newtype ShapeV = ShapeV-  { unshapeV :: Int-  }--instance QC.Arbitrary ShapeV where-  arbitrary =-    QC.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 (QC.Arbitrary a) => QC.Arbitrary (SomeVector a) where-  arbitrary =-    QC.frequency-      [ (1, P.pure (SomeVector 0 V.empty))-      , ( 9-        , fromList <$> (take <$> (unshapeV <$> QC.arbitrary) P.<*> QC.vector 20))-      ]--instance (KnownNat n, AdditiveMagma a) => AdditiveMagma (Vector n a) where-  plus = liftR2 plus--instance (KnownNat n, AdditiveUnital a) => AdditiveUnital (Vector n a) where-  zero = singleton zero--instance (KnownNat n, AdditiveAssociative a) =>-         AdditiveAssociative (Vector n a)--instance (KnownNat n, AdditiveCommutative a) =>-         AdditiveCommutative (Vector n a)--instance (KnownNat n, AdditiveInvertible a) =>-         AdditiveInvertible (Vector n a) where-  negate = fmapRep negate--instance (KnownNat n, Additive a) => Additive (Vector n a)--instance (KnownNat n, AdditiveGroup a) => AdditiveGroup (Vector n a)--instance (KnownNat n, MultiplicativeMagma a) =>-         MultiplicativeMagma (Vector n a) where-  times = liftR2 times--instance (KnownNat n, MultiplicativeUnital a) =>-         MultiplicativeUnital (Vector n a) where-  one = singleton one--instance (KnownNat n, MultiplicativeAssociative a) =>-         MultiplicativeAssociative (Vector n a)--instance (KnownNat n, MultiplicativeCommutative a) =>-         MultiplicativeCommutative (Vector n a)--instance (KnownNat n, MultiplicativeInvertible a) =>-         MultiplicativeInvertible (Vector n a) where-  recip = fmapRep recip--instance (KnownNat n, Multiplicative a) => Multiplicative (Vector n a)--instance (KnownNat n, MultiplicativeGroup a) =>-         MultiplicativeGroup (Vector n a)--instance (KnownNat n, MultiplicativeMagma a, Additive a) =>-         Distribution (Vector n a)--instance (KnownNat n, Semiring a) => Semiring (Vector n a)--instance (KnownNat n, Ring a) => Ring (Vector n a)--instance (KnownNat n, CRing a) => CRing (Vector n a)--instance (KnownNat n, Field a) => Field (Vector n a)--instance (KnownNat n, ExpField a) => ExpField (Vector n a) where-  exp = fmapRep exp-  log = fmapRep log--instance (KnownNat n, BoundedField a) => BoundedField (Vector n a) where-  isNaN f = or (fmapRep isNaN f)--instance (KnownNat n, Signed a) => Signed (Vector n a) where-  sign = fmapRep sign-  abs = fmapRep abs--instance (ExpField a) => Normed (Vector n a) a where-  size r = sqrt $ foldr (+) zero $ (** (one + one)) <$> r--instance (KnownNat n, Epsilon a) => Epsilon (Vector n a) where-  nearZero f = and (fmapRep nearZero f)-  aboutEqual a b = and (liftR2 aboutEqual a b)--instance (KnownNat n, ExpField a) => Metric (Vector n a) a where-  distance a b = size (a - b)--instance (KnownNat n, Integral a) => Integral (Vector n a) where-  divMod a b = (d, m)-    where-      x = liftR2 divMod a b-      d = fmap fst x-      m = fmap snd x--instance (Semiring a, KnownNat n) => Hilbert (Vector n) a
stack.yaml view
@@ -1,3 +1,3 @@-resolver: lts-8.24+resolver: nightly-2017-11-07  extra-deps: []
test/test.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE NegativeLiterals #-} {-# OPTIONS_GHC -Wall #-}  -- | testing IEEE numbers is a special kind of hell, and one that I reserve for days when I can hardly think, so please forgive the horrible hackery contained within this file.@@ -12,61 +6,17 @@ module Main where  import NumHask.Prelude+import NumHask.Laws  import Test.DocTest import Test.Tasty-       (TestName, TestTree, defaultMain, localOption, testGroup)-import Test.Tasty.QuickCheck hiding ((><))+       (TestTree, defaultMain, testGroup)  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)-  | Ternary2'' (a -> a -> a -> Bool)-  | Quad31 (a -> a -> a -> b -> Bool)-  | Quad22 (a -> a -> b -> b -> Bool)-  | Failiary2 (a -> Property)--type Law a = (TestName, LawArity a)--type Law2 a b = (TestName, LawArity2 a b)--testLawOf :: (Arbitrary a, Show a) => [a] -> Law a -> TestTree-testLawOf _ (name, Nonary f) = testProperty name f-testLawOf _ (name, Unary f) = testProperty name f-testLawOf _ (name, Binary f) = testProperty name f-testLawOf _ (name, Ternary f) = testProperty name f-testLawOf _ (name, Ornary f) = testProperty name f-testLawOf _ (name, Failiary f) = testProperty name f--testLawOf2 ::-     (Arbitrary a, Show a, Arbitrary b, Show b)-  => [(a, b)]-  -> Law2 a b-  -> TestTree-testLawOf2 _ (name, Unary2 f) = testProperty name f-testLawOf2 _ (name, Binary2 f) = testProperty name f-testLawOf2 _ (name, Ternary2 f) = testProperty name f-testLawOf2 _ (name, Ternary2' f) = testProperty name f-testLawOf2 _ (name, Ternary2'' f) = testProperty name f-testLawOf2 _ (name, Quad22 f) = testProperty name f-testLawOf2 _ (name, Quad31 f) = testProperty name f-testLawOf2 _ (name, Failiary2 f) = testProperty name f- tests :: TestTree tests =   testGroup@@ -74,10 +24,6 @@     [ testsInt     , testsFloat     , testsBool-    , testsVInt-    , testsVFloat-    , testsMInt-    , testsMFloat     , testsComplexFloat     ] @@ -147,528 +93,3 @@     , testGroup "Metric" $       testLawOf ([] :: [Complex Float]) <$> metricComplexFloatLaws     ]--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 "Hilbert" $-      testLawOf2 ([] :: [(Vector 6 Int, Int)]) <$> hilbertLaws-    , testGroup "Tensor product" $-      testLawOf2 ([] :: [(Vector 6 Int, Int)]) <$> tensorProductLaws-    , 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 3 3 Int]) <$> multiplicativeMonoidalLaws-    , 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 "Hilbert" $-      testLawOf2 ([] :: [(Matrix 4 3 Int, Int)]) <$> hilbertLaws-    , testGroup "Tensor product" $-      testLawOf2 ([] :: [(Matrix 4 3 Int, Int)]) <$> tensorProductLaws-    , 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-    ]--testsVFloat :: TestTree-testsVFloat =-  testGroup-    "Vector 6 Float"-    [ testGroup "MultiplicativeGroup" $-      testLawOf ([] :: [Vector 6 Float]) <$> multiplicativeGroupLaws-    , testGroup "Signed" $ testLawOf ([] :: [Vector 6 Float]) <$> signedLaws-    , testGroup "Metric" $-      testLawOf ([] :: [Vector 6 Float]) <$> metricNaperianFloatLaws-    , testGroup "Exponential Field" $-      testLawOf ([] :: [Vector 6 Float]) <$> expFieldNaperianLaws-    , testGroup "Multiplicative Group Module" $-      localOption (QuickCheckTests 1000) .-      testLawOf2 ([] :: [(Vector 6 Float, Float)]) <$>-      multiplicativeGroupModuleLawsFail-    , testGroup "Multiplicative Group Basis" $-      testLawOf ([] :: [Vector 6 Float]) <$> multiplicativeGroupBasisLaws-    ]--testsMFloat :: TestTree-testsMFloat =-  testGroup-    "Matrix 4 3 Float"-    [ testGroup "Multiplicative Group Module" $-      localOption (QuickCheckTests 1000) .-      testLawOf2 ([] :: [(Matrix 4 3 Float, Float)]) <$>-      multiplicativeGroupModuleLawsFail-    , testGroup "Multiplicative Group Basis" $-      testLawOf ([] :: [Matrix 4 3 Float]) <$> multiplicativeGroupBasisLaws-    ]---- idempotent-idempotentLaws :: (Eq a, Additive a, Multiplicative a) => [Law a]-idempotentLaws =-  [ ("idempotent: a + a == a", Unary (\a -> a + a == a))-  , ("idempotent: a * a == a", Unary (\a -> a * a == a))-  ]---- additive-additiveLaws :: (Eq a, Additive a) => [Law a]-additiveLaws =-  [ ( "associative: (a + b) + c = a + (b + c)"-    , Ternary (\a b c -> (a + b) + c == a + (b + c)))-  , ("left id: zero + a = a", Unary (\a -> zero + a == a))-  , ("right id: a + zero = a", Unary (\a -> a + zero == a))-  , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))-  ]--additiveLawsFail :: (Eq a, Additive a, Show a, Arbitrary a) => [Law a]-additiveLawsFail =-  [ ( "associative: (a + b) + c = a + (b + c)"-    , Failiary $ expectFailure . (\a b c -> (a + b) + c == a + (b + c)))-  , ("left id: zero + a = a", Unary (\a -> zero + a == a))-  , ("right id: a + zero = a", Unary (\a -> a + zero == a))-  , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))-  ]--additiveGroupLaws :: (Eq a, AdditiveGroup a) => [Law a]-additiveGroupLaws =-  [ ("minus: a - a = zero", Unary (\a -> (a - a) == zero))-  , ("negate minus: negate a == zero - a", Unary (\a -> negate a == zero - a))-  , ( "negate left cancel: negate a + a == zero"-    , Unary (\a -> negate a + a == zero))-  , ( "negate right cancel: negate a + a == zero"-    , Unary (\a -> a + negate a == zero))-  ]---- multiplicative-multiplicativeLaws :: (Eq a, Multiplicative a) => [Law a]-multiplicativeLaws =-  [ ( "associative: (a * b) * c = a * (b * c)"-    , Ternary (\a b c -> (a * b) * c == a * (b * c)))-  , ("left id: one * a = a", Unary (\a -> one * a == a))-  , ("right id: a * one = a", Unary (\a -> a * one == a))-  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))-  ]--multiplicativeMonoidalLaws ::-     (Eq a, MultiplicativeUnital a, MultiplicativeAssociative a) => [Law a]-multiplicativeMonoidalLaws =-  [ ( "associative: (a * b) * c = a * (b * c)"-    , Ternary (\a b c -> (a `times` b) `times` c == a `times` (b `times` c)))-  , ("left id: one `times` a = a", Unary (\a -> one `times` a == a))-  , ("right id: a `times` one = a", Unary (\a -> a `times` one == a))-  ]--multiplicativeLawsFail ::-     (Eq a, Show a, Arbitrary a, Multiplicative a) => [Law a]-multiplicativeLawsFail =-  [ ( "associative: (a * b) * c = a * (b * c)"-    , Failiary $ expectFailure . (\a b c -> (a * b) * c == a * (b * c)))-  , ("left id: one * a = a", Unary (\a -> one * a == a))-  , ("right id: a * one = a", Unary (\a -> a * one == a))-  , ("commutative: a * b == b * a", Binary (\a b -> a * b == b * a))-  ]--multiplicativeGroupLaws :: (Epsilon a, Eq a, MultiplicativeGroup a) => [Law a]-multiplicativeGroupLaws =-  [ ( "divide: a == zero || a / a ≈ one"-    , Unary (\a -> a == zero || (a / a) ≈ one))-  , ( "recip divide: recip a == one / a"-    , Unary (\a -> a == zero || recip a == one / a))-  , ( "recip left: a == zero || recip a * a ≈ one"-    , Unary (\a -> a == zero || recip a * a ≈ one))-  , ( "recip right: a == zero || a * recip a ≈ one"-    , Unary (\a -> a == zero || a * recip a ≈ one))-  ]---- distribution-distributionLaws :: (Eq a, Distribution a) => [Law a]-distributionLaws =-  [ ( "left annihilation: a * zero == zero"-    , Unary (\a -> a `times` zero == zero))-  , ( "right annihilation: zero * a == zero"-    , Unary (\a -> zero `times` a == zero))-  , ( "left distributivity: a * (b + c) == a * b + a * c"-    , Ternary (\a b c -> a `times` (b + c) == a `times` b + a `times` c))-  , ( "right distributivity: (a + b) * c == a * c + b * c"-    , Ternary (\a b c -> (a + b) `times` c == a `times` c + b `times` c))-  ]--distributionLawsFail ::-     (Show a, Arbitrary a, Epsilon a, Eq a, Distribution a) => [Law a]-distributionLawsFail =-  [ ( "left annihilation: a * zero == zero"-    , Unary (\a -> a `times` zero == zero))-  , ( "right annihilation: a * zero == zero"-    , Unary (\a -> zero `times` a == zero))-  , ( "left distributivity: a * (b + c) = a * b + a * c"-    , Failiary $-      expectFailure . (\a b c -> a `times` (b + c) == a `times` b + a `times` c))-  , ( "right distributivity: (a + b) * c = a * c + b * c"-    , Failiary $-      expectFailure . (\a b c -> (a + b) `times` c == a `times` c + b `times` c))-  ]---- integral-integralLaws :: (Eq a, Integral a, FromInteger a, ToInteger a) => [Law a]-integralLaws =-  [ ( "integral divmod: b == zero || b * (a `div` b) + (a `mod` b) == a"-    , Binary (\a b -> b == zero || b `times` (a `div` b) + (a `mod` b) == a))-  , ("fromIntegral a = a", Unary (\a -> fromIntegral a == a))-  ]---- metric-signedLaws :: (Eq a, Signed a) => [Law a]-signedLaws = [("sign a * abs a == a", Unary (\a -> sign a `times` abs a == a))]--metricFloatLaws :: () => [Law Float]-metricFloatLaws =-  [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))-  , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))-  , ( "associative"-    , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))-  , ( "triangle rule - sum of distances > distance"-    , Ternary-        (\a b c ->-           (abs a > 10.0) ||-           (abs b > 10.0) ||-           (abs c > 10.0) ||-           not-             (veryNegative-                (distance a c + distance b c - (distance a b :: Float))) &&-           not-             (veryNegative-                (distance a b + distance b c - (distance a c :: Float))) &&-           not-             (veryNegative-                (distance a b + distance a c - (distance b c :: Float)))))-  ]--metricComplexFloatLaws :: () => [Law (Complex Float)]-metricComplexFloatLaws =-  [ ("positive", Binary (\a b -> (distance a b :: Float) >= zero))-  , ("zero if equal", Unary (\a -> (distance a a :: Float) == zero))-  , ( "associative"-    , Binary (\a b -> (distance a b :: Float) ≈ (distance b a :: Float)))-  , ( "triangle rule - sum of distances > distance"-    , Ternary-        (\a b c ->-           (size a > (10.0 :: Float)) ||-           (size b > (10.0 :: Float)) ||-           (size c > (10.0 :: Float)) ||-           not-             (veryNegative-                (distance a c + distance b c - (distance a b :: Float))) &&-           not-             (veryNegative-                (distance a b + distance b c - (distance a c :: Float))) &&-           not-             (veryNegative-                (distance a b + distance a c - (distance b c :: Float)))))-  ]--metricNaperianFloatLaws :: (Metric (r Float) Float) => [Law (r Float)]-metricNaperianFloatLaws =-  [ ("positive", Binary (\a b -> distance a b >= (zero :: Float)))-  , ("zero if equal", Unary (\a -> distance a a == (zero :: Float)))-  , ("associative", Binary (\a b -> distance a b ≈ (distance b a :: Float)))-  , ( "triangle rule - sum of distances > distance"-    , Ternary-        (\a b c ->-           not-             (veryNegative-                (distance a c + distance b c - (distance a b :: Float))) &&-           not-             (veryNegative-                (distance a b + distance b c - (distance a c :: Float))) &&-           not-             (veryNegative-                (distance a b + distance a c - (distance b c :: Float)))))-  ]---- field-boundedFieldFloatLaws :: [Law Float]-boundedFieldFloatLaws =-  [ ( "infinity laws"-    , Unary-        (\a ->-           ((one :: Float) / zero + infinity == infinity) &&-           (infinity + a == infinity) &&-           isNaN ((infinity :: Float) - infinity) &&-           isNaN ((infinity :: Float) / infinity) &&-           isNaN (nan + a) && (zero :: Float) / zero /= nan))-  ]--quotientFieldLaws :: (Ord a, Field a, QuotientField a, FromInteger a) => [Law a]-quotientFieldLaws =-  [ ( "a - one < floor a <= a <= ceiling a < a + one"-    , Unary-        (\a ->-           ((a - one) < fromIntegral (floor a)) &&-           (fromIntegral (floor a) <= a) &&-           (a <= fromIntegral (ceiling a)) &&-           (fromIntegral (ceiling a) < a + one)))-  , ( "round a == floor (a + one/(one+one))"-    , Unary (\a -> round a == floor (a + one / (one + one))))-  ]--expFieldLaws ::-     (ExpField a, Signed a, Epsilon a, Fractional a, Ord a) => [Law a]-expFieldLaws =-  [ ( "sqrt . (**(one+one)) ≈ id"-    , Unary-        (\a ->-           not (veryPositive a) ||-           (a > 10.0) ||-           (sqrt . (** (one + one)) $ a) ≈ a &&-           ((** (one + one)) . sqrt $ a) ≈ a))-  , ( "log . exp ≈ id"-    , Unary-        (\a ->-           not (veryPositive a) ||-           (a > 10.0) || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))-  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"-    , Binary-        (\a b ->-           (not (veryPositive b) ||-            not (nearZero (a - zero)) ||-            (a == one) ||-            (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b))))-  ]--expFieldComplexLooseLaws :: Float -> [Law (Complex Float)]-expFieldComplexLooseLaws _ =-  [ ( "sqrt . (**(one+one)) ≈ id test contains a stack overflow"-    , Unary (const True))-  , ("log . exp test contains a stack overflow", Unary (const True))-  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"-    , Binary-        (\a b@(rb :+ ib) ->-           (not (rb > zero && ib > zero) ||-            not (nearZero (a - zero)) ||-            (a == one) ||-            (a == zero && nearZero (logBase a b)) || (a ** logBase a b ≈ b))))-  ]--expFieldNaperianLaws ::-     ( ExpField (r a)-     , Foldable r-     , ExpField a-     , Epsilon a-     , Signed a-     , Epsilon (r a)-     , Fractional a-     , Ord a-     )-  => [Law (r a)]-expFieldNaperianLaws =-  [ ( "sqrt . (**2) ≈ id"-    , Unary-        (\a ->-           not (all veryPositive a) ||-           any (> 10.0) a ||-           (sqrt . (** (one + one)) $ a) ≈ a &&-           ((** (one + one)) . sqrt $ a) ≈ a))-  , ( "log . exp ≈ id"-    , Unary-        (\a ->-           not (all veryPositive a) ||-           any (> 10.0) a || (log . exp $ a) ≈ a && (exp . log $ a) ≈ a))-  , ( "for +ive b, a != 0,1: a ** logBase a b ≈ b"-    , Binary-        (\a b ->-           (not (all veryPositive b) ||-            not (all nearZero a) ||-            all (== one) a ||-            (all (== zero) a && all nearZero (logBase a b)) ||-            (a ** logBase a b ≈ b))))-  ]---- module-additiveModuleLaws ::-     (Eq (r a), Epsilon a, Epsilon (r a), AdditiveModule r a) => [Law2 (r a) a]-additiveModuleLaws =-  [ ( "additive module associative: (a + b) .+ c ≈ a + (b .+ c)"-    , Ternary2 (\a b c -> (a + b) .+ c ≈ a + (b .+ c)))-  , ( "additive module commutative: (a + b) .+ c ≈ (a .+ c) + b"-    , Ternary2 (\a b c -> (a + b) .+ c ≈ (a .+ c) + b))-  , ("additive module unital: a .+ zero == a", Unary2 (\a -> a .+ zero == a))-  , ( "module additive equivalence: a .+ b ≈ b +. a"-    , Binary2 (\a b -> a .+ b ≈ b +. a))-  ]--additiveGroupModuleLaws ::-     (Eq (r a), Epsilon a, Epsilon (r a), AdditiveGroupModule r a)-  => [Law2 (r a) a]-additiveGroupModuleLaws =-  [ ( "additive group module associative: (a + b) .- c ≈ a + (b .- c)"-    , Ternary2 (\a b c -> (a + b) .- c ≈ a + (b .- c)))-  , ( "additive group module commutative: (a + b) .- c ≈ (a .- c) + b"-    , Ternary2 (\a b c -> (a + b) .- c ≈ (a .- c) + b))-  , ( "additive group module unital: a .- zero == a"-    , Unary2 (\a -> a .- zero == a))-  , ( "module additive group equivalence: a .- b ≈ negate b +. a"-    , Binary2 (\a b -> a .- b ≈ negate b +. a))-  ]--multiplicativeModuleLaws ::-     (Eq (r a), Epsilon a, Epsilon (r a), MultiplicativeModule r a)-  => [Law2 (r a) a]-multiplicativeModuleLaws =-  [ ( "multiplicative module unital: a .* one == a"-    , Unary2 (\a -> a .* one == a))-  , ( "module right distribution: (a + b) .* c ≈ (a .* c) + (b .* c)"-    , Ternary2 (\a b c -> (a + b) .* c ≈ (a .* c) + (b .* c)))-  , ( "module left distribution: c *. (a + b) ≈ (c *. a) + (c *. b)"-    , Ternary2 (\a b c -> c *. (a + b) ≈ (c *. a) + (c *. b)))-  , ("annihilation: a .* zero == zero", Unary2 (\a -> a .* zero == zero))-  , ( "module multiplicative equivalence: a .* b ≈ b *. a"-    , Binary2 (\a b -> a .* b ≈ b *. a))-  ]--multiplicativeGroupModuleLawsFail ::-     ( Eq a-     , Show a-     , Arbitrary a-     , Eq (r a)-     , Show (r a)-     , Arbitrary (r a)-     , Epsilon a-     , Epsilon (r a)-     , MultiplicativeGroupModule r a-     )-  => [Law2 (r a) a]-multiplicativeGroupModuleLawsFail =-  [ ( "multiplicative group module unital: a ./ one == a"-    , Unary2 (\a -> nearZero a || a ./ one == a))-  , ( "module multiplicative group equivalence: a ./ b ≈ recip b *. a"-    , Binary2 (\a b -> b == zero || a ./ b ≈ recip b *. a))-  ]--banachLaws ::-     ( Ord a-     , Fractional a-     , Signed a-     , Foldable r-     , Fractional b-     , Eq (r a)-     , Epsilon b-     , Epsilon (r a)-     , Metric (r a) b-     , MultiplicativeGroup b-     , Banach r a-     , Normed (r a) b-     )-  => [Law2 (r a) b]-banachLaws =-  [ ( "normalize a .* size a ≈ one"-    , Unary2-        (\a ->-           a == singleton zero ||-           (any ((> 10.0) . abs) a || (normalize a .* size a) ≈ a)))-  ]--hilbertLaws ::-     (Eq (r a), Eq a, Multiplicative a, Epsilon a, Epsilon (r a), Hilbert r a)-  => [Law2 (r a) a]-hilbertLaws =-  [ ("commutative a <.> b ≈ b <.> a", Ternary2 (\a b _ -> a <.> b ≈ b <.> a))-  , ( "distributive over addition a <.> (b + c) == a <.> b + a <.> c"-    , Ternary2'' (\a b c -> a <.> (b + c) ≈ a <.> b + a <.> c))-  , ( "bilinear a <.> (s *. b + c) == s * (a <.> b) + a <.> c"-    , Quad31 (\a b c s -> a <.> (s *. b + c) == s * (a <.> b) + a <.> c))-  , ( "scalar multiplication (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)"-    , Quad22 (\a b s0 s1 -> (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)))-  ]--tensorProductLaws ::-     ( Eq (r (r a))-     , Additive (r (r a))-     , Eq (r a)-     , Eq a-     , TensorProduct (r a)-     , Epsilon a-     , Epsilon (r a)-     , Representable r-     )-  => [Law2 (r a) a]-tensorProductLaws =-  [ ( "left distribution over addition a><b + c><b == (a+c) >< b"-    , Ternary2'' (\a b c -> a >< b + c >< b == (a + c) >< b))-  , ( "right distribution over addition a><b + a><c == a >< (b+c)"-    , Ternary2'' (\a b c -> a >< b + a >< c == a >< (b + c)))-  -- , ( "left module tensor correspondance a *. (b><c) == (a><b) .* c"-  --   , Ternary2'' (\a b c -> a *. (b><c) == (a><b) .* c))-  -- , ( "right module tensor correspondance (a><b) .* c == a *. (b><c)"-  --   , Ternary2'' (\a b c -> (a><b) .* c == a *. (b><c)))-  ]---- basis-additiveBasisLaws :: (Eq (r a), Epsilon (r a), AdditiveBasis r a) => [Law (r a)]-additiveBasisLaws =-  [ ( "associative: (a .+. b) .+. c ≈ a .+. (b .+. c)"-    , Ternary (\a b c -> (a .+. b) .+. c ≈ a .+. (b .+. c)))-  , ("left id: zero .+. a = a", Unary (\a -> zero .+. a == a))-  , ("right id: a .+. zero = a", Unary (\a -> a .+. zero == a))-  , ("commutative: a .+. b == b .+. a", Binary (\a b -> a .+. b == b .+. a))-  ]--additiveGroupBasisLaws :: (Eq (r a), AdditiveGroupBasis r a) => [Law (r a)]-additiveGroupBasisLaws =-  [ ( "minus: a .-. a = singleton zero"-    , Unary (\a -> (a .-. a) == singleton 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: singleton one .*. a = a", Unary (\a -> singleton one .*. a == a))-  , ( "right id: a .*. singleton one = a"-    , Unary (\a -> a .*. singleton one == a))-  , ("commutative: a .*. b == b .*. a", Binary (\a b -> a .*. b == b .*. a))-  ]--multiplicativeGroupBasisLaws ::-     ( Eq (r a)-     , Epsilon a-     , Epsilon (r a)-     , Singleton r-     , MultiplicativeGroupBasis r a-     )-  => [Law (r a)]-multiplicativeGroupBasisLaws =-  [ ( "basis divide: a ./. a ≈ singleton one"-    , Unary (\a -> a == singleton zero || (a ./. a) ≈ singleton one))-  ]