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/src')

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