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.

1 files changed, 18 insertions, 0 deletions

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
+
 
 --------------------------------------------------------------------------------