From 5623e4d4e613b89786a225265a4d8373680096f3 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 02:20:49 -0700
Subject: re-implemented exactDim and exactLength in terms of the native GHC
 TypeLits API with sameNat

---
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 19 ++++++++-----------
 1 file changed, 8 insertions(+), 11 deletions(-)

(limited to 'packages/base')

diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index 3e772b2..a55ae44 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -78,6 +78,7 @@ import Data.Proxy(Proxy(..))
 import Internal.Static
 import Control.Arrow((***))
 import Text.Printf
+import Data.Type.Equality ((:~:)(Refl))
 
 ud1 :: R n -> Vector ℝ
 ud1 (R (Dim v)) = v
@@ -444,11 +445,9 @@ exactLength
     :: forall n m . (KnownNat n, KnownNat m)
     => R m
     -> Maybe (R n)
-exactLength v
-    | natVal (Proxy :: Proxy n) == natVal (Proxy :: Proxy m)
-        = Just (mkR (unwrap v))
-    | otherwise
-        = Nothing
+exactLength v = do
+    Refl <- sameNat (Proxy :: Proxy n) (Proxy :: Proxy m)
+    return $ mkR (unwrap v)
 
 withMatrix
     :: forall z
@@ -470,12 +469,10 @@ exactDims
     :: forall n m j k . (KnownNat n, KnownNat m, KnownNat j, KnownNat k)
     => L m n
     -> Maybe (L j k)
-exactDims m
-    | natVal (Proxy :: Proxy m) == natVal (Proxy :: Proxy j)
-   && natVal (Proxy :: Proxy n) == natVal (Proxy :: Proxy k)
-        = Just (mkL (unwrap m))
-    | otherwise
-        = Nothing
+exactDims m = do
+    Refl <- sameNat (Proxy :: Proxy m) (Proxy :: Proxy j)
+    Refl <- sameNat (Proxy :: Proxy n) (Proxy :: Proxy k)
+    return $ mkL (unwrap m)
 
 randomVector
     :: forall n . KnownNat n
-- 
cgit v1.2.3


From 37c1348ade91807bdad45272801115b32572ad40 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 02:35:19 -0700
Subject: Additive, Transposable instances for Static data types

---
 packages/base/src/Internal/Static.hs              | 12 ++++++++++++
 packages/base/src/Numeric/LinearAlgebra/Static.hs |  7 +++++++
 2 files changed, 19 insertions(+)

(limited to 'packages/base')

diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs
index 381f3bc..9ed4710 100644
--- a/packages/base/src/Internal/Static.hs
+++ b/packages/base/src/Internal/Static.hs
@@ -518,6 +518,18 @@ instance (KnownNat n, KnownNat m) => Floating (M n m) where
     (**)  = lift2MD (**)
     pi    = M pi
 
+instance Additive (R n) where
+    add = (+)
+
+instance Additive (C n) where
+    add = (+)
+
+instance (KnownNat m, KnownNat n) => Additive (L m n) where
+    add = (+)
+
+instance (KnownNat m, KnownNat n) => Additive (M m n) where
+    add = (+)
+
 --------------------------------------------------------------------------------
 
 
diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index a55ae44..2ffc531 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -821,3 +821,10 @@ instance KnownNat n => Floating (Sym n)
     sqrt  = mkSym sqrt
     (**)  = mkSym2 (**)
     pi    = Sym pi
+
+instance KnownNat n => Additive (Sym n) where
+    add = (+)
+
+instance KnownNat n => Transposable (Sym n) (Sym n) where
+    tr (Sym m) = Sym (tr m)
+    tr' = id
-- 
cgit v1.2.3


From 79369ee4c72d3c4844c734219c8f6430b3b0c4ab Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 02:49:18 -0700
Subject: Transposable instance for Her

---
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

(limited to 'packages/base')

diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index 2ffc531..8019558 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -827,4 +827,8 @@ instance KnownNat n => Additive (Sym n) where
 
 instance KnownNat n => Transposable (Sym n) (Sym n) where
     tr (Sym m) = Sym (tr m)
-    tr' = id
+    tr'        = id
+
+instance KnownNat n => Transposable (Her n) (Her n) where
+    tr          = id
+    tr' (Her m) = Her (tr' m)
-- 
cgit v1.2.3


From 3ddb98ef66ed672c4da67e38ff2127cc912aefe7 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 08:37:10 -0700
Subject: added determinate functions to Domain typeclass.  Rationale is that
 these can be verified to be square and are therefore total, compared to the
 determinate function from the untyped packages.

---
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'packages/base')

diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index 8019558..2e7c462 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -79,6 +79,7 @@ import Internal.Static
 import Control.Arrow((***))
 import Text.Printf
 import Data.Type.Equality ((:~:)(Refl))
+import Data.Bifunctor (first)
 
 ud1 :: R n -> Vector ℝ
 ud1 (R (Dim v)) = v
@@ -534,6 +535,8 @@ class Domain field vec mat | mat -> vec field, vec -> mat field, field -> mat ve
     dmmap :: forall n m. (KnownNat m, KnownNat n) => (field -> field) -> mat n m -> mat n m
     outer :: forall n m. (KnownNat m, KnownNat n) => vec n -> vec m -> mat n m
     zipWithVector :: forall n. KnownNat n => (field -> field -> field) -> vec n -> vec n -> vec n
+    det :: forall n. KnownNat n => mat n n -> field
+    invlndet :: forall n. KnownNat n => mat n n -> (mat n n, (field, field))
 
 
 instance Domain ℝ R L
@@ -547,6 +550,8 @@ instance Domain ℝ R L
     dmmap = mapL
     outer = outerR
     zipWithVector = zipWithR
+    det = detL
+    invlndet = invlndetL
 
 instance Domain ℂ C M
   where
@@ -559,6 +564,8 @@ instance Domain ℂ C M
     dmmap = mapM'
     outer = outerC
     zipWithVector = zipWithC
+    det = detM
+    invlndet = invlndetM
 
 --------------------------------------------------------------------------------
 
@@ -610,6 +617,11 @@ zipWithR f (extract -> x) (extract -> y) = mkR (LA.zipVectorWith f x y)
 mapL :: (KnownNat n, KnownNat m) => (ℝ -> ℝ) -> L n m -> L n m
 mapL f (unwrap -> m) = mkL (LA.cmap f m)
 
+detL :: KnownNat n => Sq n -> ℝ
+detL = LA.det . unwrap
+
+invlndetL :: KnownNat n => Sq n -> (L n n, (ℝ, ℝ))
+invlndetL = first mkL . LA.invlndet . unwrap
 
 --------------------------------------------------------------------------------
 
@@ -661,6 +673,12 @@ zipWithC f (extract -> x) (extract -> y) = mkC (LA.zipVectorWith f x y)
 mapM' :: (KnownNat n, KnownNat m) => (ℂ -> ℂ) -> M n m -> M n m
 mapM' f (unwrap -> m) = mkM (LA.cmap f m)
 
+detM :: KnownNat n => M n n -> ℂ
+detM = LA.det . unwrap
+
+invlndetM :: KnownNat n => M n n -> (M n n, (ℂ, ℂ))
+invlndetM = first mkM . LA.invlndet . unwrap
+
 
 --------------------------------------------------------------------------------
 
-- 
cgit v1.2.3


From d272e5428b3bb9acf3e9680c38d18d099dca7890 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 08:39:02 -0700
Subject: added Complex type synonym to export list

---
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'packages/base')

diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index 2e7c462..c764038 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -42,7 +42,7 @@ module Numeric.LinearAlgebra.Static(
     blockAt,
     matrix,
     -- * Complex
-    C, M, Her, her, 𝑖,
+    ℂ, C, M, Her, her, 𝑖,
     -- * Products
     (<>),(#>),(<.>),
     -- * Linear Systems
-- 
cgit v1.2.3


From 5a23359dfea4f11a83d17d6aa7ec139003084782 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 08:46:54 -0700
Subject: The conjugate transpose of a symmetric real matrix is itself

---
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'packages/base')

diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index c764038..64c0f14 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -844,8 +844,8 @@ instance KnownNat n => Additive (Sym n) where
     add = (+)
 
 instance KnownNat n => Transposable (Sym n) (Sym n) where
-    tr (Sym m) = Sym (tr m)
-    tr'        = id
+    tr  = id
+    tr' = id
 
 instance KnownNat n => Transposable (Her n) (Her n) where
     tr          = id
-- 
cgit v1.2.3


From cd6caa8f08e686fd4a90dae5f3414264aa2700a0 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Wed, 25 May 2016 09:42:49 -0700
Subject: added expm and logm; the justification is again that they may only be
 called on square matrices.

---
 packages/base/src/Internal/Static.hs              | 11 +++++++++++
 packages/base/src/Numeric/LinearAlgebra/Static.hs | 22 ++++++++++++++++++++--
 2 files changed, 31 insertions(+), 2 deletions(-)

(limited to 'packages/base')

diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs
index 9ed4710..f9dfff0 100644
--- a/packages/base/src/Internal/Static.hs
+++ b/packages/base/src/Internal/Static.hs
@@ -567,6 +567,17 @@ instance KnownNat n => Disp (C n)
 
 --------------------------------------------------------------------------------
 
+overMatL' :: (KnownNat m, KnownNat n)
+          => (LA.Matrix ℝ -> LA.Matrix ℝ) -> L m n -> L m n
+overMatL' f = mkL . f . unwrap
+{-# INLINE overMatL' #-}
+
+overMatM' :: (KnownNat m, KnownNat n)
+          => (LA.Matrix ℂ -> LA.Matrix ℂ) -> M m n -> M m n
+overMatM' f = mkM . f . unwrap
+{-# INLINE overMatM' #-}
+
+
 #else
 
 module Numeric.LinearAlgebra.Static.Internal where
diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs
index 64c0f14..296f8c7 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Static.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs
@@ -537,6 +537,8 @@ class Domain field vec mat | mat -> vec field, vec -> mat field, field -> mat ve
     zipWithVector :: forall n. KnownNat n => (field -> field -> field) -> vec n -> vec n -> vec n
     det :: forall n. KnownNat n => mat n n -> field
     invlndet :: forall n. KnownNat n => mat n n -> (mat n n, (field, field))
+    expm :: forall n. KnownNat n => mat n n -> mat n n
+    sqrtm :: forall n. KnownNat n => mat n n -> mat n n
 
 
 instance Domain ℝ R L
@@ -552,6 +554,8 @@ instance Domain ℝ R L
     zipWithVector = zipWithR
     det = detL
     invlndet = invlndetL
+    expm = expmL
+    sqrtm = sqrtmL
 
 instance Domain ℂ C M
   where
@@ -566,6 +570,8 @@ instance Domain ℂ C M
     zipWithVector = zipWithC
     det = detM
     invlndet = invlndetM
+    expm = expmM
+    sqrtm = sqrtmM
 
 --------------------------------------------------------------------------------
 
@@ -615,7 +621,7 @@ zipWithR :: KnownNat n => (ℝ -> ℝ -> ℝ) -> R n -> R n -> R n
 zipWithR f (extract -> x) (extract -> y) = mkR (LA.zipVectorWith f x y)
 
 mapL :: (KnownNat n, KnownNat m) => (ℝ -> ℝ) -> L n m -> L n m
-mapL f (unwrap -> m) = mkL (LA.cmap f m)
+mapL f = overMatL' (LA.cmap f)
 
 detL :: KnownNat n => Sq n -> ℝ
 detL = LA.det . unwrap
@@ -623,6 +629,12 @@ detL = LA.det . unwrap
 invlndetL :: KnownNat n => Sq n -> (L n n, (ℝ, ℝ))
 invlndetL = first mkL . LA.invlndet . unwrap
 
+expmL :: KnownNat n => Sq n -> Sq n
+expmL = overMatL' LA.expm
+
+sqrtmL :: KnownNat n => Sq n -> Sq n
+sqrtmL = overMatL' LA.sqrtm
+
 --------------------------------------------------------------------------------
 
 mulC :: forall m k n. (KnownNat m, KnownNat k, KnownNat n) => M m k -> M k n -> M m n
@@ -671,7 +683,7 @@ zipWithC :: KnownNat n => (ℂ -> ℂ -> ℂ) -> C n -> C n -> C n
 zipWithC f (extract -> x) (extract -> y) = mkC (LA.zipVectorWith f x y)
 
 mapM' :: (KnownNat n, KnownNat m) => (ℂ -> ℂ) -> M n m -> M n m
-mapM' f (unwrap -> m) = mkM (LA.cmap f m)
+mapM' f = overMatM' (LA.cmap f)
 
 detM :: KnownNat n => M n n -> ℂ
 detM = LA.det . unwrap
@@ -679,6 +691,12 @@ detM = LA.det . unwrap
 invlndetM :: KnownNat n => M n n -> (M n n, (ℂ, ℂ))
 invlndetM = first mkM . LA.invlndet . unwrap
 
+expmM :: KnownNat n => M n n -> M n n
+expmM = overMatM' LA.expm
+
+sqrtmM :: KnownNat n => M n n -> M n n
+sqrtmM = overMatM' LA.sqrtm
+
 
 --------------------------------------------------------------------------------
 
-- 
cgit v1.2.3