Numerical integration/Gauss-Legendre Quadrature

From Rosetta Code
Revision as of 02:35, 11 June 2011 by rosettacode>Sluggo (added Ursala)
Task
Numerical integration/Gauss-Legendre Quadrature
You are encouraged to solve this task according to the task description, using any language you may know.

In a general Gaussian quadrature rule, an definite integral of is first approximated over the interval by a polynomial approximable function and a known weighting function .

Those are then approximated by a sum of function values at specified points multiplied by some weights :

In the case of Gauss-Legendre quadrature, the weighting function , so we can approximate an integral of with:

For this, we first need to calculate the nodes and the weights, but after we have them, we can reuse them for numerious integral evaluations, which greatly speeds up the calculation compared to more simple numerical integration methods.

The evaluation points for a n-point rule, also called "nodes", are roots of n-th order Legendre Polynomials . Legendre polynomials are defined by the following recursive rule:

There is also a recursive equation for their derivative:

The roots of those polynomials are in general not analytically solvable, so they have to be approximated numerically, for example by Newton-Raphson iteration:

The first guess for the -th root of a -order polynomial can be given by

After we get the nodes , we compute the appropriate weights by:

After we have the nodes and the weights for a n-point quadrature rule, we can approximate an integral over any interval by


Task description

Similar to the task Numerical Integration, the task here is to calculate the definite integral of a function , but by applying an n-point Gauss-Legendre quadrature rule, as described here, for example. The input values should be an function f to integrate, the bounds of the integration interval a and b, and the number of gaussian evaluation points n. An reference implementation in Common Lisp is provided for comparison.

To demonstrate the calculation, compute the weights and nodes for an 5-point quadrature rule and then use them to compute

Common Lisp

<lang lisp>;; Computes the initial guess for the root i of a n-order Legendre polynomial. (defun guess (n i)

 (cos (* pi
         (/ (- i 0.25d0)
            (+ n 0.5d0)))))
Computes and evaluates the n-order Legendre polynomial at the point x.

(defun legpoly (n x)

 (let ((pa 1.0d0)
       (pb x)
       (pn))
   (cond ((= n 0) pa)
         ((= n 1) pb)
         (t (loop for i from 2 to n do
                 (setf pn (- (* (/ (- (* 2 i) 1) i) x pb) 
                             (* (/ (- i 1) i) pa)))
                 (setf pa pb)
                 (setf pb pn)
                 finally (return pn))))))
Computes and evaluates the derivative of an n-order Legendre polynomial at point x.

(defun legdiff (n x)

 (* (/ n (- (* x x) 1))
    (- (* x (legpoly n x))
       (legpoly (- n 1) x))))
Computes the n nodes for an n-point quadrature rule. (i.e. n roots of a n-order polynomial)

(defun nodes (n)

 (let ((x (make-array n :initial-element 0.0d0)))
   (loop for i from 0 to (- n 1) do
        (let ((val (guess n (+ i 1))) ;Nullstellen-Schätzwert.
              (itermax 5))     
          (dotimes (j itermax)
            (setf val (- val
                         (/ (legpoly n val)
                            (legdiff n val)))))
          (setf (aref x i) val)))
   x))
Computes the weight for an n-order polynomial at the point (node) x.

(defun legwts (n x)

 (/ 2 
    (* (- 1 (* x x))
       (expt (legdiff n x) 2))))
Takes a array of nodes x and computes an array of corresponding weights w.

(defun weights (x)

 (let* ((n (car (array-dimensions x)))
        (w (make-array n :initial-element 0.0d0)))
   (loop for i from 0 to (- n 1) do
        (setf (aref w i) (legwts n (aref x i))))
   w))
Integrates a function f with a n-point Gauss-Legendre quadrature rule over the interval [a,b].

(defun int (f n a b)

 (let* ((x (nodes n))
        (w (weights x)))
   (* (/ (- b a) 2.0d0)
      (loop for i from 0 to (- n 1)
         sum (* (aref w i)
                (funcall f (+ (* (/ (- b a) 2.0d0)
                                 (aref x i))
                              (/ (+ a b) 2.0d0))))))))</lang>

Example:

<lang lisp>(nodes 5)

  1. (0.906179845938664d0 0.5384693101056831d0 2.996272867003007d-95 -0.5384693101056831d0 -0.906179845938664d0)

(weights (nodes 5))

  1. (0.23692688505618917d0 0.47862867049936647d0 0.5688888888888889d0 0.47862867049936647d0 0.23692688505618917d0)

(int #'exp 5 -3 3) 20.035577718385568d0</lang>

Comparison of the 5-point rule with simpler, but more costly methods from the task Numerical Integration:

<lang lisp>(int #'(lambda (x) (expt x 3)) 5 0 1) 0.24999999999999997d0

(int #'(lambda (x) (/ 1 x)) 5 1 100) 4.059147508941519d0

(int #'(lambda (x) x) 5 0 5000) 1.25d7

(int #'(lambda (x) x) 5 0 6000) 1.8000000000000004d7</lang>

Tcl

Translation of: Common Lisp
Library: Tcllib (Package: math::constants)
Library: Tcllib (Package: math::polynomials)
Library: Tcllib (Package: math::special)

<lang tcl>package require Tcl 8.5 package require math::special package require math::polynomials package require math::constants math::constants::constants pi

  1. Computes the initial guess for the root i of a n-order Legendre polynomial

proc guess {n i} {

   global pi
   expr { cos($pi * ($i - 0.25) / ($n + 0.5)) }

}

  1. Computes and evaluates the n-order Legendre polynomial at the point x

proc legpoly {n x} {

   math::polynomials::evalPolyn [math::special::legendre $n] $x

}

  1. Computes and evaluates the derivative of an n-order Legendre polynomial at point x

proc legdiff {n x} {

   expr {$n / ($x**2 - 1) * ($x * [legpoly $n $x] - [legpoly [incr n -1] $x])}

}

  1. Computes the n nodes for an n-point quadrature rule. (i.e. n roots of a n-order polynomial)

proc nodes n {

   set x [lrepeat $n 0.0]
   for {set i 0} {$i < $n} {incr i} {

set val [guess $n [expr {$i + 1}]] foreach . {1 2 3 4 5} { set val [expr {$val - [legpoly $n $val] / [legdiff $n $val]}] } lset x $i $val

   }
   return $x

}

  1. Computes the weight for an n-order polynomial at the point (node) x

proc legwts {n x} {

   expr {2.0 / (1 - $x**2) / [legdiff $n $x]**2}

}

  1. Takes a array of nodes x and computes an array of corresponding weights w

proc weights x {

   set n [llength $x]
   set w {}
   foreach xi $x {

lappend w [legwts $n $xi]

   }
   return $w

}

  1. Integrates a lambda term f with a n-point Gauss-Legendre quadrature rule over the interval [a,b]

proc gausslegendreintegrate {f n a b} {

   set x [nodes $n]
   set w [weights $x]
   set rangesize2 [expr {($b - $a)/2}]
   set rangesum2 [expr {($a + $b)/2}]
   set sum 0.0
   foreach xi $x wi $w {

set y [expr {$rangesize2*$xi + $rangesum2}] set sum [expr {$sum + $wi*[apply $f $y]}]

   }
   expr {$sum * $rangesize2}

}</lang> Demonstrating: <lang tcl>puts "nodes(5) = [nodes 5]" puts "weights(5) = [weights [nodes 5]]" set exp {x {expr {exp($x)}}} puts "int(exp,-3,3) = [gausslegendreintegrate $exp 5 -3 3]"</lang> Output:

nodes(5) = 0.906179845938664 0.5384693101056831 -1.198509146801203e-94 -0.5384693101056831 -0.906179845938664
weights(5) = 0.2369268850561896 0.4786286704993664 0.5688888888888889 0.4786286704993664 0.2369268850561896
int(exp,-3,3) = 20.03557771838559

Ursala

using arbitrary precision arithmetic <lang Ursala>#import std

  1. import nat

legendre = # takes n to the pair of functions (P_n,P'_n), where P_n is the Legendre polynomial of order n

~&?\(1E0!,0E0!)! -+

  ^|/~& //mp..vid^ mp..sub\1E0+ mp..sqr,
  ~~ "c". ~&\1E0; ~&\"c"; ~&ar^?\0E0! mp..add^/mp..mul@alrPrhPX ^|R/~& ^|\~&t ^/~&l mp..mul,
  @iiXNX ~&rZ->r @l ^/^|(~&tt+ sum@NNiCCiX+ successor,~&) both~&g&&~&+ -+
     ~* mp..zero_p?/~& (&&~&r ~&EZ+ ~~ mp..prec)^/~& ^(~&,..shr\8); mp..equ^|(~&,..gro\8)->l @r ^/~& ..shr\8,
     ^(~&rl,mp..mul*lrrPD)^/..nat2mp@r -+
        ^(~&l,mp..sub*+ zipp0E0^|\~& :/0E0)+ ~&rrt->lhthPX ^(
           ^lrNCC\~&lh mp..vid^*D/..nat2mp@rl -+
              mp..sub*+ zipp0E0^|\~& :/0E0,
              mp..mul~*brlD^|bbI/~&hthPX @l ..nat2mp~~+ predecessor~~NiCiX+-,
           @r ^|/successor predecessor),
        ^|(mp..grow/1E0; @iNC ^lrNCC\~& :/0E0,~&/2)+-+-+-

nodes = # takes precision and order (p,n) to a list of nodes and weights <(x_1,w_1)..(x_n,w_n)>

-+

  ^H(
     @lrr *+ ^/~&+ mp..div/( ..nat2mp 2)++ mp..mul^/(mp..sqr; //mp..sub ..nat2mp 1)+ mp..sqr+,
     mp..shr^*DrlXS/~&ll ^|H\~& *+ @NiX+ ->l^|(~&lZ!|+ not+ //mp..eq,@r+ ^/~&+ mp..sub^/~&+ mp..div^)),
  ^/^|(~&,legendre) mp..cos*+ mp..mul^*D(
     mp..div^|/mp..pi@NiC mp..add/5E-1+ ..nat2mp,
     @r mp..bus/*2.5E-1+ ..nat2mp*+ nrange/1)+-

integral = # takes precision and order (p,n) to a function taking a function and interval (f,(a,b))

("p","n"). -+

  mp..shrink^/~& difference\"p"+ mp..prec,
  mp..mul^|/~& mp..add:-0E0+ * mp..mul^/~&rr ^H/~&ll mp..add^\~&lrr mp..mul@lrPrXl,
  ^(~&rl,-*nodes("p","n"))^|/~& mp..vid~~G/2E0+ ^/mp..bus mp..add+-</lang>

demonstration program:<lang Ursala>#show+

demo =

~&lNrCT (

  ^|lNrCT(:/'nodes:',:/'weights:')@lSrSX ..mp2str~~* nodes/160 5,
  :/'integral:' ~&iNC ..mp2str integral(160,5) (mp..exp,-3E0,3E0))</lang>

output:

nodes:
9.0617984593866399279762687829939296512565191076233E-01
5.3846931010568309103631442070020880496728660690555E-01
0.0000000000000000000000000000000000000000000000000E+00
-5.3846931010568309103631442070020880496728660690555E-01
-9.0617984593866399279762687829939296512565191076233E-01

weights:
2.3692688505618908751426404071991736264326000220463E-01
4.7862867049936646804129151483563819291229555334456E-01
5.6888888888888888888888888888888888888888888888896E-01
4.7862867049936646804129151483563819291229555334456E-01
2.3692688505618908751426404071991736264326000220463E-01

integral:
2.0035577718385562153928535725275093931501627207110E+01