summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Internal')
-rw-r--r--packages/base/src/Internal/CG.hs21
1 files changed, 15 insertions, 6 deletions
diff --git a/packages/base/src/Internal/CG.hs b/packages/base/src/Internal/CG.hs
index 8c4afee..f0142cd 100644
--- a/packages/base/src/Internal/CG.hs
+++ b/packages/base/src/Internal/CG.hs
@@ -14,7 +14,7 @@ import Internal.IO
14import Internal.Container 14import Internal.Container
15import Internal.Sparse 15import Internal.Sparse
16import Numeric.Vector() 16import Numeric.Vector()
17import Internal.Algorithms(linearSolveLS, relativeError, pnorm, NormType(..)) 17import Internal.Algorithms(linearSolveLS, linearSolve, relativeError, pnorm, NormType(..))
18import Control.Arrow((***)) 18import Control.Arrow((***))
19 19
20{- 20{-
@@ -59,20 +59,21 @@ cg sym at a (CGState p r r2 x _) = CGState p' r' r'2 x' rdx
59 59
60conjugrad 60conjugrad
61 :: Bool -> GMatrix -> V -> V -> R -> R -> [CGState] 61 :: Bool -> GMatrix -> V -> V -> R -> R -> [CGState]
62conjugrad sym a b = solveG (tr a !#>) (a !#>) (cg sym) b 62conjugrad sym a b = solveG sym (tr a !#>) (a !#>) (cg sym) b
63 63
64solveG 64solveG
65 :: (V -> V) -> (V -> V) 65 :: Bool
66 -> (V -> V) -> (V -> V)
66 -> ((V -> V) -> (V -> V) -> CGState -> CGState) 67 -> ((V -> V) -> (V -> V) -> CGState -> CGState)
67 -> V 68 -> V
68 -> V 69 -> V
69 -> R -> R 70 -> R -> R
70 -> [CGState] 71 -> [CGState]
71solveG mat ma meth rawb x0' ϵb ϵx 72solveG sym mat ma meth rawb x0' ϵb ϵx
72 = takeUntil ok . iterate (meth mat ma) $ CGState p0 r0 r20 x0 1 73 = takeUntil ok . iterate (meth mat ma) $ CGState p0 r0 r20 x0 1
73 where 74 where
74 a = mat . ma 75 a = if sym then ma else mat . ma
75 b = mat rawb 76 b = if sym then rawb else mat rawb
76 x0 = if x0' == 0 then konst 0 (dim b) else x0' 77 x0 = if x0' == 0 then konst 0 (dim b) else x0'
77 r0 = b - a x0 78 r0 = b - a x0
78 r20 = r0 <.> r0 79 r20 = r0 <.> r0
@@ -138,6 +139,11 @@ instance Testable GMatrix
138 s5 = cgSolve False sm v 139 s5 = cgSolve False sm v
139 d5 = denseSolve dm v 140 d5 = denseSolve dm v
140 141
142 symassoc = [((0,0),1.0),((1,1),2.0),((0,1),0.5),((1,0),0.5)]
143 b = vect [3,4]
144 d6 = flatten $ linearSolve (toDense symassoc) (asColumn b)
145 s6 = cgSolve True (mkSparse symassoc) b
146
141 info = do 147 info = do
142 print sm 148 print sm
143 disp (toDense sma) 149 disp (toDense sma)
@@ -147,12 +153,15 @@ instance Testable GMatrix
147 print s4; print d4 153 print s4; print d4
148 print s5; print d5 154 print s5; print d5
149 print $ relativeError (pnorm Infinity) s5 d5 155 print $ relativeError (pnorm Infinity) s5 d5
156 print s6; print d6
157 print $ relativeError (pnorm Infinity) s6 d6
150 158
151 ok = s1==d1 159 ok = s1==d1
152 && s2==d2 160 && s2==d2
153 && s3==d3 161 && s3==d3
154 && s4==d4 162 && s4==d4
155 && relativeError (pnorm Infinity) s5 d5 < 1E-10 163 && relativeError (pnorm Infinity) s5 d5 < 1E-10
164 && relativeError (pnorm Infinity) s6 d6 < 1E-10
156 165
157 disp = putStr . dispf 2 166 disp = putStr . dispf 2
158 167