summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/base/src/Internal/Algorithms.hs18
-rw-r--r--packages/base/src/Internal/Modular.hs2
-rw-r--r--packages/base/src/Numeric/LinearAlgebra.hs1
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs6
4 files changed, 19 insertions, 8 deletions
diff --git a/packages/base/src/Internal/Algorithms.hs b/packages/base/src/Internal/Algorithms.hs
index d2f17f4..ee3ddff 100644
--- a/packages/base/src/Internal/Algorithms.hs
+++ b/packages/base/src/Internal/Algorithms.hs
@@ -470,17 +470,25 @@ eigenvaluesSH (Her m) = eigenvaluesSH' m
470 470
471-------------------------------------------------------------- 471--------------------------------------------------------------
472 472
473-- | QR decomposition of a matrix in compact form. (The orthogonal matrix is not explicitly formed.)
474data QR t = QR (Matrix t) (Vector t)
475
473-- | QR factorization. 476-- | QR factorization.
474-- 477--
475-- If @(q,r) = qr m@ then @m == q \<> r@, where q is unitary and r is upper triangular. 478-- If @(q,r) = qr m@ then @m == q \<> r@, where q is unitary and r is upper triangular.
476qr :: Field t => Matrix t -> (Matrix t, Matrix t) 479qr :: Field t => Matrix t -> (Matrix t, Matrix t)
477qr = {-# SCC "qr" #-} unpackQR . qr' 480qr = {-# SCC "qr" #-} unpackQR . qr'
478 481
479qrRaw m = qr' m 482-- | Compute the QR decomposition of a matrix in compact form.
483qrRaw :: Field t => Matrix t -> QR t
484qrRaw m = QR x v
485 where
486 (x,v) = qr' m
480 487
481{- | generate a matrix with k orthogonal columns from the output of qrRaw 488-- | generate a matrix with k orthogonal columns from the compact QR decomposition obtained by 'qrRaw'.
482-} 489--
483qrgr n (a,t) 490qrgr :: Field t => Int -> QR t -> Matrix t
491qrgr n (QR a t)
484 | dim t > min (cols a) (rows a) || n < 0 || n > dim t = error "qrgr expects k <= min(rows,cols)" 492 | dim t > min (cols a) (rows a) || n < 0 || n > dim t = error "qrgr expects k <= min(rows,cols)"
485 | otherwise = qrgr' n (a,t) 493 | otherwise = qrgr' n (a,t)
486 494
@@ -870,6 +878,8 @@ fixPerm' s = res $ mutable f s0
870triang r c h v = (r><c) [el s t | s<-[0..r-1], t<-[0..c-1]] 878triang r c h v = (r><c) [el s t | s<-[0..r-1], t<-[0..c-1]]
871 where el p q = if q-p>=h then v else 1 - v 879 where el p q = if q-p>=h then v else 1 - v
872 880
881-- | Compute the explicit LU decomposition from the compact one obtained by 'luPacked'.
882luFact :: Numeric t => LU t -> (Matrix t, Matrix t, Matrix t, t)
873luFact (LU l_u perm) 883luFact (LU l_u perm)
874 | r <= c = (l ,u ,p, s) 884 | r <= c = (l ,u ,p, s)
875 | otherwise = (l',u',p, s) 885 | otherwise = (l',u',p, s)
diff --git a/packages/base/src/Internal/Modular.hs b/packages/base/src/Internal/Modular.hs
index a3421a8..239c742 100644
--- a/packages/base/src/Internal/Modular.hs
+++ b/packages/base/src/Internal/Modular.hs
@@ -371,7 +371,7 @@ test = (ok, info)
371 371
372 checkLU okf t = norm_Inf $ flatten (l <> u <> p - t) 372 checkLU okf t = norm_Inf $ flatten (l <> u <> p - t)
373 where 373 where
374 (l,u,p,_ :: Int) = luFact (LU x' p') 374 (l,u,p,_) = luFact (LU x' p')
375 where 375 where
376 (x',p') = mutable (luST okf) t 376 (x',p') = mutable (luST okf) t
377 377
diff --git a/packages/base/src/Numeric/LinearAlgebra.hs b/packages/base/src/Numeric/LinearAlgebra.hs
index 7be2600..a1c0158 100644
--- a/packages/base/src/Numeric/LinearAlgebra.hs
+++ b/packages/base/src/Numeric/LinearAlgebra.hs
@@ -162,6 +162,7 @@ module Numeric.LinearAlgebra (
162 Transposable, 162 Transposable,
163 LU(..), 163 LU(..),
164 LDL(..), 164 LDL(..),
165 QR(..),
165 CGState(..), 166 CGState(..),
166 Testable(..) 167 Testable(..)
167) where 168) where
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
index 30480d7..ecda6c1 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
@@ -500,10 +500,10 @@ sliceTest = utest "slice test" $ and
500 , testSlice (test_qrgr 4 tau2) qrr2 500 , testSlice (test_qrgr 4 tau2) qrr2
501 ] 501 ]
502 where 502 where
503 (qrr1,tau1) = qrRaw (rec :: Matrix R) 503 QR qrr1 tau1 = qrRaw (rec :: Matrix R)
504 (qrr2,tau2) = qrRaw (rec :: Matrix C) 504 QR qrr2 tau2 = qrRaw (rec :: Matrix C)
505 505
506 test_qrgr n t x = qrgr n (x,t) 506 test_qrgr n t x = qrgr n (QR x t)
507 507
508 ok_qrgr x = simeq 1E-15 q q' 508 ok_qrgr x = simeq 1E-15 q q'
509 where 509 where