diff options
Diffstat (limited to 'packages/base/src/Internal')
-rw-r--r-- | packages/base/src/Internal/CG.hs | 21 |
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 | |||
14 | import Internal.Container | 14 | import Internal.Container |
15 | import Internal.Sparse | 15 | import Internal.Sparse |
16 | import Numeric.Vector() | 16 | import Numeric.Vector() |
17 | import Internal.Algorithms(linearSolveLS, relativeError, pnorm, NormType(..)) | 17 | import Internal.Algorithms(linearSolveLS, linearSolve, relativeError, pnorm, NormType(..)) |
18 | import Control.Arrow((***)) | 18 | import 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 | ||
60 | conjugrad | 60 | conjugrad |
61 | :: Bool -> GMatrix -> V -> V -> R -> R -> [CGState] | 61 | :: Bool -> GMatrix -> V -> V -> R -> R -> [CGState] |
62 | conjugrad sym a b = solveG (tr a !#>) (a !#>) (cg sym) b | 62 | conjugrad sym a b = solveG sym (tr a !#>) (a !#>) (cg sym) b |
63 | 63 | ||
64 | solveG | 64 | solveG |
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] |
71 | solveG mat ma meth rawb x0' ϵb ϵx | 72 | solveG 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 | ||