]> gitweb.michael.orlitzky.com - numerical-analysis.git/blob - src/FEM/R1.hs
922469f730dff4af6ed9d8387928c60335acd223
[numerical-analysis.git] / src / FEM / R1.hs
1 {-# LANGUAGE GADTs #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 -- | Finite Element Method (FEM) to solve the problem,
5 --
6 -- -(A(x)*u'(x))' + c(x)*u*(x) = f(x) on (a,b)
7 --
8 -- with one of the two types of boundary conditions,
9 --
10 -- * Dirichlet: u(a) = u(b) = 0
11 --
12 -- * A(a)u'(a) = alpha, A(b)u'(b) = beta
13 --
14 -- if c(x) = 0, then it is assumed that the boundary conditions are
15 -- Dirichlet.
16 --
17 -- The code creates a linear system,
18 --
19 -- (K + M)x = F
20 --
21 -- to be solved for @x@, where @K@ (\"big_K\") is the stiffness
22 -- matrix, @M@ (\"big_M\") is the mass matrix, and @F@ (\"big_F\")
23 -- is the load vector.
24 --
25 -- Warning: until PLU factorization is implemented, we can only
26 -- solve the resulting system if it's positive definite!
27 --
28 module FEM.R1
29 where
30
31 import qualified Algebra.Algebraic as Algebraic ( C )
32 import qualified Algebra.Field as Field ( C )
33 import qualified Algebra.RealField as RealField ( C )
34 import qualified Algebra.ToRational as ToRational ( C )
35 import Data.Vector.Fixed ( Arity, S )
36 import NumericPrelude
37 import qualified Prelude as P
38
39 import Integration.Gaussian ( gaussian )
40 import Linear.Matrix (
41 Col,
42 Mat(..),
43 Row,
44 (!!!),
45 construct,
46 fromList,
47 ifoldl2,
48 nrows,
49 set_idx )
50 import Linear.System ( solve_positive_definite )
51 import Polynomials.Orthogonal ( legendre )
52
53 -- | Dirichlet boundary conditions. Since u(a)=u(b)=0 are fixed,
54 -- there's no additional information conveyed by this type.
55 data Dirichlet a = Dirichlet { domain_dirichlet :: Interval a }
56
57 -- | Neumann boundary conditions. @alpha@ specifies A(a)u'(b) and
58 -- @beta@ specifies A(b)u'(b).
59 data Neumann a =
60 Neumann { domain_neumann :: Interval a,
61 alpha :: a,
62 beta :: a }
63
64 -- | Boundary conditions can be either Dirichlet or Neumann.
65 type BoundaryConditions a = Either (Dirichlet a) (Neumann a)
66
67 type Interval a = (a,a)
68
69 -- | The data for the PDE that we are attempting to solve.
70 data PDE a =
71 PDE {
72 -- | A(x)
73 big_A :: (a -> a),
74 -- | c(x)
75 c :: (a -> a),
76 -- | f(x)
77 f :: (a -> a),
78
79 -- | The boundary conditions. The domain also specifies the
80 -- boundary in R^1.
81 bdy :: BoundaryConditions a }
82
83
84
85 -- | Non-PDE parameters for the finite element method. The additional
86 -- type parameter @n@ should be a type-level representation of the
87 -- largest element in @max_degrees@. It needs to be known statically
88 -- for the dimensions of the pointer matrix. The parameter @l@ is
89 -- the number of global basis functions. It's equal to the number of
90 -- /internal/ mesh nodes (i.e. m-1), plus the sum of (p_i - 1) for
91 -- each p_i in max_degrees.
92 data Params m n l a =
93 Params {
94 -- | A partition of the domain.
95 mesh :: Col m (Interval a),
96
97 -- | A list of the highest-degree polynomial that we will use over
98 -- each interval in our mesh.
99 max_degrees :: Col m Int }
100
101
102 -- | The pointer matrix mapping local basis elements to global
103 -- ones. The (i,j)th entry of the matrix contains the index of the
104 -- global basis function corresponding to the jth local basis
105 -- function over element i.
106 --
107 -- TODO: This works for Dirichlet boundary conditions only.
108 --
109 -- Note that the number of columns in the matrix depends on the
110 --
111 -- Examples:
112 --
113 -- >>> import Data.Vector.Fixed ( N5, N6 )
114 -- >>> import Linear.Matrix ( Col5, fromList )
115 -- >>> import Naturals ( N19 )
116 --
117 -- >>> let p = fromList [[3],[3],[5],[4],[5]] :: Col5 Int
118 -- >>> let mesh = undefined :: Col5 (Int,Int)
119 -- >>> let params = Params mesh p :: Params N5 N5 N19 Int
120 -- >>> let row1 = [0,1,5,6,0,0] :: [Int]
121 -- >>> let row2 = [1,2,7,8,0,0] :: [Int]
122 -- >>> let row3 = [2,3,9,10,11,12] :: [Int]
123 -- >>> let row4 = [3,4,13,14,15,0] :: [Int]
124 -- >>> let row5 = [4,0,16,17,18,19] :: [Int]
125 -- >>> let expected = fromList [row1,row2,row3,row4,row5] :: Mat N5 N6 Int
126 -- >>> pointer params == expected
127 -- True
128 --
129 pointer :: (Arity m, Arity n, Arity l) => Params m n l a -> Mat m (S n) Int
130 pointer params =
131 construct lambda
132 where
133 -- | The number of polynomials in the local basis for element i.
134 numpolys :: Int -> Int
135 numpolys i = ((max_degrees params) !!! (i,0)) + 1
136
137 lambda i j
138
139 -- The first two (linear) basis functions are easy to do.
140 | j < 2 = if i + j >= (nrows $ mesh params) then 0 else i + j
141
142 -- No local basis function exists for this j.
143 | j >= (numpolys i) = 0
144
145 -- The first row we handle as a special case.
146 | i == 0 = (nrows $ mesh params) + j - 2
147
148 -- The first entry for this row not corresponding to one of the
149 -- linear polynomials (which we did in the first guard). This
150 -- grabs the biggest number in the previous row and begins counting
151 -- from there.
152 | j == 2 = (lambda (i-1) (numpolys (i-1) - 1)) + 1
153
154 -- If none of the other cases apply, we can compute our value by
155 -- looking to the left in the matrix.
156 | otherwise = (lambda i (j-1)) + 1
157
158
159
160 -- | An affine transform taking the interval [x1,x2] into [-1,1].
161 --
162 -- Examples:
163 --
164 -- >>> let phi = affine (-6,7)
165 -- >>> phi (-6)
166 -- -1.0
167 -- >>> phi 7
168 -- 1.0
169 --
170 affine :: Field.C a => (a,a) -> (a -> a)
171 affine (x1,x2) x = (fromInteger 2)*(x - x1)/(x2 - x1) - (fromInteger 1)
172
173 -- | The inverse of 'affine'. It should send [-1,1] into [x1,x2].
174 --
175 -- Examples:
176 --
177 -- >>> let phi = affine_inv (-6,7)
178 -- >>> phi (-1)
179 -- -6.0
180 -- >>> phi 1
181 -- 7.0
182 --
183 affine_inv :: Field.C a => (a,a) -> (a -> a)
184 affine_inv (x1,x2) x =
185 x*(x2 - x1)/two + (x1 + x2)/two
186 where
187 two = fromInteger 2
188
189
190 -- * Load vector
191
192 -- | Normalized integrals of orthogonal basis functions over
193 -- n[-1,1]. The test case below comes from Sage where the
194 -- orthogonality of the polynomials' derivatives can easily be
195 -- tested.
196 --
197 -- Examples:
198 --
199 -- >>> import qualified Algebra.Absolute as Absolute ( abs )
200 --
201 -- >>> let expected = 2.99624907925257
202 -- >>> let actual = big_N 4 1.5 :: Double
203 -- >>> Absolute.abs (actual - expected) < 1e-12
204 -- True
205 --
206 big_N :: forall a. (Algebraic.C a, RealField.C a) => Integer -> a -> a
207 big_N k x
208 | k < 0 = error "requested a negative basis function"
209 | k == 0 = (one - x) / (fromInteger 2)
210 | k == 1 = (one + x) / (fromInteger 2)
211 | otherwise =
212 coeff * ( legendre k x - legendre (k-2) x )
213 where
214 two = fromInteger 2
215 four = fromInteger 4
216 coeff = one / (sqrt (four*(fromInteger k) - two)) :: a
217
218
219 -- | A matrix containing 'big_N' functions indexed by their
220 -- element/number. Each row in the matrix represents a finite element
221 -- (i.e. an interval in the mesh). Within row @i@, column @j@ contains
222 -- the @j@th 'big_N' basis function.
223 --
224 -- Any given 'big_N' will probably wind up in this matrix multiple
225 -- times; the basis functions don't change depending on the
226 -- interval. Only the /number/ of basis functions does. Computing
227 -- them this way allows us to easily construct a lookup \"table\" of
228 -- the proper dimensions.
229 --
230 -- The second example below relies on the fact that @big_N 3@ and
231 -- @big_N 6@ expand to Legendre polynomials (2,4) and (5,7)
232 -- respectively and so should be orthogonal over [-1,1].
233 --
234 -- Examples:
235 --
236 -- >>> import Data.Vector.Fixed ( N5, N6 )
237 -- >>> import Integration.Gaussian ( gaussian )
238 -- >>> import Linear.Matrix ( Col5, fromList )
239 -- >>> import Naturals ( N19 )
240 --
241 -- >>> let p = fromList [[3],[3],[5],[4],[5]] :: Col5 Int
242 -- >>> let mesh = undefined :: Col5 (Double,Double)
243 -- >>> let params = Params mesh p :: Params N5 N5 N19 Double
244 -- >>> let big_ns = big_N_matrix :: Mat N5 N6 (Double -> Double)
245 -- >>> let n1 = big_ns !!! (1,0)
246 -- >>> let n4 = big_ns !!! (4,0)
247 -- >>> n1 1.5 == n4 1.5
248 -- True
249 -- >>> let n1 = big_ns !!! (1,3)
250 -- >>> let n2 = big_ns !!! (2,4)
251 -- >>> gaussian (\x -> (n1 x) * (n2 x)) < 1e-12
252 -- True
253 --
254 big_N_matrix :: (Arity m, Arity n, Algebraic.C a, RealField.C a)
255 => Mat m n (a -> a)
256 big_N_matrix =
257 construct lambda
258 where
259 lambda _ j x = big_N (toInteger j) x
260
261
262 -- | The matrix of (N_i * N_j) functions used in the integrand of
263 -- the mass matrices.
264 big_Ns_matrix :: (Arity m, Arity n, Algebraic.C a, RealField.C a)
265 => Mat m n (a -> a)
266 big_Ns_matrix =
267 construct lambda
268 where
269 lambda i j x = (big_N (toInteger i) x) * (big_N (toInteger j) x)
270
271
272 -- | Compute the global load vector F.
273 --
274 -- Examples:
275 --
276 -- >>> import Linear.Matrix ( Col4, frobenius_norm, fromList )
277 -- >>> import Naturals ( N3, N4, N7 )
278 --
279 -- >>> let big_A = const (1::Double)
280 -- >>> let c x = sin x
281 -- >>> let f x = x*(sin x)
282 -- >>> let bdy = Left (Dirichlet (0,1::Double))
283 -- >>> let pde = PDE big_A c f bdy
284 --
285 -- >>> let i1 = (0.0,1/3)
286 -- >>> let i2 = (1/3,2/3)
287 -- >>> let i3 = (2/3,4/5)
288 -- >>> let i4 = (4/5,1.0)
289 -- >>> let mesh = fromList [[i1], [i2], [i3], [i4]] :: Col4 (Double,Double)
290 -- >>> let pvec = fromList [[2],[3],[2],[1]] :: Col4 Int
291 -- >>> let params = Params mesh pvec :: Params N4 N3 N7 Double
292 --
293 -- >>> let f1 = [0.0418]
294 -- >>> let f2 = [0.0805]
295 -- >>> let f3 = [0.1007]
296 -- >>> let f4 = [-0.0045]
297 -- >>> let f5 = [-0.0332]
298 -- >>> let f6 = [-0.0054]
299 -- >>> let f7 = [-0.0267]
300 -- >>> let expected = fromList [f1,f2,f3,f4,f5,f6,f7] :: Col N7 Double
301 -- >>> let actual = big_F pde params
302 -- >>> frobenius_norm (actual - expected) < 1e-4
303 -- True
304 --
305 big_F :: forall m n l a.
306 (Arity l, Arity m, Arity n,
307 Algebraic.C a, RealField.C a, ToRational.C a)
308 => PDE a
309 -> Params m n l a
310 -> Col l a
311 big_F pde params =
312 ifoldl2 accum zero (big_N_matrix :: Mat m (S n) (a -> a))
313 where
314 accum :: Int -> Int -> Col l a -> (a -> a) -> Col l a
315 accum i j prev_F this_N =
316 prev_F + this_F
317 where
318 two = fromInteger 2
319 (x1,x2) = (mesh params) !!! (i,0)
320 q = affine_inv (x1,x2)
321 integrand x = ((f pde) (q x)) * (this_N x)
322
323 -- The pointer matrix numbers from 1 so subtract one here to
324 -- get the right index.
325 k = ((pointer params) !!! (i,j)) - 1
326 integral = (gaussian integrand)*(x2 - x1) / two
327 this_F = set_idx zero (k,0) integral
328
329
330 -- * Stiffness matrix
331
332 -- | Derivatives of the 'big_N's, that is, orthogonal basis functions
333 -- over [-1,1]. The test case below comes from Sage where the
334 -- orthogonality of the polynomials' derivatives can easily be
335 -- tested. The indices are shifted by one so that k=0 is the first
336 -- basis function.
337 --
338 -- Examples:
339 --
340 -- >>> import qualified Algebra.Absolute as Absolute ( abs )
341 --
342 -- >>> let expected = 11.5757525403319
343 -- >>> let actual = big_N' 3 1.5 :: Double
344 -- >>> Absolute.abs (actual - expected) < 1e-10
345 -- True
346 --
347 big_N' :: forall a. (Algebraic.C a, RealField.C a) => Integer -> a -> a
348 big_N' k x
349 | k < 0 = error "requested a negative basis function"
350 | k == 0 = negate ( one / (fromInteger 2))
351 | k == 1 = one / (fromInteger 2)
352 | otherwise = coeff * ( legendre k x )
353 where
354 two = fromInteger 2
355 coeff = sqrt ((two*(fromInteger k) + one) / two) :: a
356
357
358 -- | The matrix of (N_i' * N_j') functions used in the integrand of
359 -- the stiffness matrix.
360 big_N's_matrix :: (Arity m, Arity n, Algebraic.C a, RealField.C a)
361 => Mat m n (a -> a)
362 big_N's_matrix =
363 construct lambda
364 where
365 lambda i j x = (big_N' (toInteger i) x) * (big_N' (toInteger j) x)
366
367
368 big_K_elem :: forall m n l a b.
369 (Arity l, Arity m, Arity n,
370 Algebraic.C a, RealField.C a, ToRational.C a)
371 => PDE a
372 -> Params m n l a
373 -> Int
374 -> Int
375 -> Mat l l a
376 -> b
377 -> Mat l l a
378 big_K_elem pde params _ k cur_K _ =
379 ifoldl2 accum cur_K (big_N's_matrix :: Mat m (S n) (a -> a))
380 where
381 accum :: Int -> Int -> Mat l l a -> (a -> a) -> Mat l l a
382 accum i j prev_K these_N's =
383 prev_K + this_K
384 where
385 two = fromInteger 2
386 (x1,x2) = (mesh params) !!! (k,0)
387 q = affine_inv (x1,x2)
388 integrand x = ((big_A pde) (q x)) * (these_N's x)
389 -- The pointer matrix numbers from 1 so subtract one here to
390 -- get the right index.
391 row_idx = ((pointer params) !!! (k,i)) - 1
392 col_idx = ((pointer params) !!! (k,j)) - 1
393 integral = (two/(x2 - x1))* (gaussian integrand)
394 this_K = set_idx zero (row_idx, col_idx) integral
395
396
397
398 -- | Compute the \"big K\" stiffness matrix. There are three
399 -- parameters needed for K, namely i,j,k so a fold over a matrix will
400 -- not do. This little gimmick simulates a three-index fold by doing a
401 -- two-index fold over a row of the proper dimensions.
402 --
403 -- Examples:
404 --
405 -- >>> import Linear.Matrix ( Col4, frobenius_norm, fromList )
406 -- >>> import Naturals ( N3, N4, N7 )
407 --
408 -- >>> let big_A = const (1::Double)
409 -- >>> let c x = sin x
410 -- >>> let f x = x*(sin x)
411 -- >>> let bdy = Left (Dirichlet (0,1::Double))
412 -- >>> let pde = PDE big_A c f bdy
413 --
414 -- >>> let i1 = (0.0,1/3)
415 -- >>> let i2 = (1/3,2/3)
416 -- >>> let i3 = (2/3,4/5)
417 -- >>> let i4 = (4/5,1.0)
418 -- >>> let mesh = fromList [[i1], [i2], [i3], [i4]] :: Col4 (Double,Double)
419 -- >>> let pvec = fromList [[2],[3],[2],[1]] :: Col4 Int
420 -- >>> let params = Params mesh pvec :: Params N4 N3 N7 Double
421 --
422 -- >>> let k1 = [6, -3, 0, 0, 0, 0, 0] :: [Double]
423 -- >>> let k2 = [-3, 10.5, -7.5, 0, 0, 0, 0] :: [Double]
424 -- >>> let k3 = [0, -7.5, 12.5, 0, 0, 0, 0] :: [Double]
425 -- >>> let k4 = [0, 0, 0, 6, 0, 0, 0] :: [Double]
426 -- >>> let k5 = [0, 0, 0, 0, 6, 0, 0] :: [Double]
427 -- >>> let k6 = [0, 0, 0, 0, 0, 6, 0] :: [Double]
428 -- >>> let k7 = [0, 0, 0, 0, 0, 0, 15] :: [Double]
429 -- >>> let expected = fromList [k1,k2,k3,k4,k5,k6,k7] :: Mat N7 N7 Double
430 -- >>> let actual = big_K pde params
431 -- >>> frobenius_norm (actual - expected) < 1e-10
432 -- True
433 --
434 big_K :: forall m n l a.
435 (Arity l, Arity m, Arity n,
436 Algebraic.C a, RealField.C a, ToRational.C a)
437 => PDE a
438 -> Params m n l a
439 -> Mat l l a
440 big_K pde params =
441 ifoldl2 (big_K_elem pde params) zero col_idxs
442 where
443 col_idxs = fromList [map fromInteger [0..]] :: Row m a
444
445
446 -- * Mass matrix
447
448 big_M_elem :: forall m n l a b.
449 (Arity l, Arity m, Arity n,
450 Algebraic.C a, RealField.C a, ToRational.C a)
451 => PDE a
452 -> Params m n l a
453 -> Int
454 -> Int
455 -> Mat l l a
456 -> b
457 -> Mat l l a
458 big_M_elem pde params _ k cur_M _ =
459 ifoldl2 accum cur_M (big_Ns_matrix :: Mat m (S n) (a -> a))
460 where
461 accum :: Int -> Int -> Mat l l a -> (a -> a) -> Mat l l a
462 accum i j prev_M these_Ns =
463 prev_M + this_M
464 where
465 two = fromInteger 2
466 (x1,x2) = (mesh params) !!! (k,0)
467 q = affine_inv (x1,x2)
468 integrand x = ((c pde) (q x)) * (these_Ns x)
469 -- The pointer matrix numbers from 1 so subtract one here to
470 -- get the right index.
471 row_idx = ((pointer params) !!! (k,i)) - 1
472 col_idx = ((pointer params) !!! (k,j)) - 1
473 integral = (x2 - x1)*(gaussian integrand) / two
474 this_M = set_idx zero (row_idx, col_idx) integral
475
476
477 -- | Compute the \"big M\" mass matrix. There are three
478 -- parameters needed for M, namely i,j,k so a fold over a matrix will
479 -- not do. This little gimmick simulates a three-index fold by doing a
480 -- two-index fold over a row of the proper dimensions.
481 --
482 -- Examples:
483 --
484 -- >>> import Linear.Matrix ( Col4, frobenius_norm, fromList )
485 -- >>> import Naturals ( N3, N4, N7 )
486 --
487 -- >>> let big_A = const (1::Double)
488 -- >>> let c x = sin x
489 -- >>> let f x = x*(sin x)
490 -- >>> let bdy = Left (Dirichlet (0,1::Double))
491 -- >>> let pde = PDE big_A c f bdy
492 --
493 -- >>> let i1 = (0.0,1/3)
494 -- >>> let i2 = (1/3,2/3)
495 -- >>> let i3 = (2/3,4/5)
496 -- >>> let i4 = (4/5,1.0)
497 -- >>> let mesh = fromList [[i1], [i2], [i3], [i4]] :: Col4 (Double,Double)
498 -- >>> let pvec = fromList [[2],[3],[2],[1]] :: Col4 Int
499 -- >>> let params = Params mesh pvec :: Params N4 N3 N7 Double
500 --
501 -- >>> let m1 = [0.0723,0.0266,0,-0.0135,-0.0305,0.0058,0] :: [Double]
502 -- >>> let m2 = [0.0266,0.0897,0.0149,0,-0.0345,-0.0109,-0.0179] :: [Double]
503 -- >>> let m3 = [0,0.0149,0.0809,0,0,0,-0.0185] :: [Double]
504 -- >>> let m4 = [-0.0135,0,0,0.0110,0,0,0] :: [Double]
505 -- >>> let m5 = [-0.0305,-0.0345,0,0,0.0319,0.0018,0] :: [Double]
506 -- >>> let m6 = [0.0058,-0.0109,0,0,0.0018,0.0076,0] :: [Double]
507 -- >>> let m7 = [0,-0.0179,-0.0185,0,0,0,0.0178] :: [Double]
508 --
509 -- >>> let expected = fromList [m1,m2,m3,m4,m5,m6,m7] :: Mat N7 N7 Double
510 -- >>> let actual = big_M pde params
511 -- >>> frobenius_norm (actual - expected) < 1e-3
512 -- True
513 --
514 big_M :: forall m n l a.
515 (Arity l, Arity m, Arity n,
516 Algebraic.C a, RealField.C a, ToRational.C a)
517 => PDE a
518 -> Params m n l a
519 -> Mat l l a
520 big_M pde params =
521 ifoldl2 (big_M_elem pde params) zero col_idxs
522 where
523 col_idxs = fromList [map fromInteger [0..]] :: Row m a
524
525
526
527 -- | Determine the coefficient vector @x@ from the system @(K + M)x = F@.
528 --
529 -- Examples:
530 --
531 -- >>> import Linear.Matrix ( Col4, Col7, frobenius_norm, fromList )
532 -- >>> import Naturals ( N3, N4, N7 )
533 --
534 -- >>> let big_A = const (1::Double)
535 -- >>> let c x = sin x
536 -- >>> let f x = x*(sin x)
537 -- >>> let bdy = Left (Dirichlet (0,1::Double))
538 -- >>> let pde = PDE big_A c f bdy
539 --
540 -- >>> let i1 = (0.0,1/3)
541 -- >>> let i2 = (1/3,2/3)
542 -- >>> let i3 = (2/3,4/5)
543 -- >>> let i4 = (4/5,1.0)
544 -- >>> let mesh = fromList [[i1], [i2], [i3], [i4]] :: Col4 (Double,Double)
545 -- >>> let pvec = fromList [[2],[3],[2],[1]] :: Col4 Int
546 -- >>> let params = Params mesh pvec :: Params N4 N3 N7 Double
547 --
548 -- >>> let c1 = [0.02366220347687] :: [Double]
549 -- >>> let c2 = [0.03431630082636] :: [Double]
550 -- >>> let c3 = [0.02841800893264] :: [Double]
551 -- >>> let c4 = [-0.00069489654996] :: [Double]
552 -- >>> let c5 = [-0.00518637005151] :: [Double]
553 -- >>> let c6 = [-0.00085028505337] :: [Double]
554 -- >>> let c7 = [-0.00170478210110] :: [Double]
555 -- >>> let expected = fromList [c1,c2,c3,c4,c5,c6,c7] :: Col7 Double
556 -- >>> let actual = coefficients pde params
557 -- >>> frobenius_norm (actual - expected) < 1e-8
558 -- True
559 --
560 coefficients :: forall m n l a.
561 (Arity m, Arity n, Arity l,
562 Algebraic.C a, Eq a, RealField.C a, ToRational.C a)
563 => PDE a
564 -> Params m n (S l) a
565 -> Col (S l) a
566 coefficients pde params =
567 solve_positive_definite matrix b
568 where
569 matrix = (big_K pde params) + (big_M pde params)
570 b = big_F pde params