alglib 0.1.1

data/ext/alglib/gqgengauss.cpp

@@ -0,0 +1,235 @@
+/*************************************************************************
+Copyright (c) 2005-2007, Sergey Bochkanov (ALGLIB project).
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer listed
+  in this license in the documentation and/or other materials
+  provided with the distribution.
+
+- Neither the name of the copyright holders nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*************************************************************************/
+
+#include <stdafx.h>
+#include <stdio.h>
+#include "gqgengauss.h"
+
+static void testgenerategaussquadrature();
+
+/*************************************************************************
+Computation of nodes and weights for a Gauss quadrature formula
+
+The algorithm generates the N-point Gauss quadrature formula with weighting
+function given by coefficients alpha and beta  of  a  recurrence  relation
+which generates a system of orthogonal polynomials:
+
+P-1(x)   =  0
+P0(x)    =  1
+Pn+1(x)  =  (x-alpha(n))*Pn(x)  -  beta(n)*Pn-1(x)
+
+and zero moment Mu0
+
+Mu0 = integral(W(x)dx,a,b)
+
+
+Input parameters:
+    Alpha   �   array of coefficients.
+                Array whose index ranges within [0..N-1].
+    Beta    �   array of coefficients.
+                Array whose index ranges within [0..N-1].
+                Zero-indexed element is not used and may be arbitrary.
+                Beta[I]>0.
+    Mu0     �   zeroth moment of the weighting function.
+    N       �   number of nodes of the quadrature formula, N>=1
+
+Output parameters:
+    X       �   array of nodes of the quadrature formula (in ascending order).
+                Array whose index ranges within [0..N-1].
+    W       �   array of weights of the quadrature formula.
+                Array whose index ranges within [0..N-1].
+
+Result:
+    True, if the algorithm finished its work successfully.
+    False, if the algorithm of finding the eigenvalues has not converged,
+    or one or more of the Beta coefficients is less or equal to 0.
+
+  -- ALGLIB --
+     Copyright 2005 by Bochkanov Sergey
+*************************************************************************/
+bool generategaussquadrature(const ap::real_1d_array& alpha,
+     const ap::real_1d_array& beta,
+     double mu0,
+     int n,
+     ap::real_1d_array& x,
+     ap::real_1d_array& w)
+{
+    bool result;
+    int i;
+    ap::real_1d_array d;
+    ap::real_1d_array e;
+    ap::real_2d_array z;
+
+    if( n<1 )
+    {
+        result = false;
+        return result;
+    }
+    
+    //
+    // Initialize
+    //
+    d.setbounds(1, n);
+    e.setbounds(1, n);
+    for(i = 1; i <= n-1; i++)
+    {
+        d(i) = alpha(i-1);
+        if( beta(i)<=0 )
+        {
+            result = false;
+            return result;
+        }
+        e(i) = sqrt(beta(i));
+    }
+    d(n) = alpha(n-1);
+    
+    //
+    // EVD
+    //
+    result = tridiagonalevd(d, e, n, 3, z);
+    if( !result )
+    {
+        return result;
+    }
+    
+    //
+    // Generate
+    //
+    x.setbounds(0, n-1);
+    w.setbounds(0, n-1);
+    for(i = 1; i <= n; i++)
+    {
+        x(i-1) = d(i);
+        w(i-1) = mu0*ap::sqr(z(1,i));
+    }
+    return result;
+}
+
+
+static void testgenerategaussquadrature()
+{
+    ap::real_1d_array alpha;
+    ap::real_1d_array beta;
+    ap::real_1d_array x;
+    ap::real_1d_array w;
+    double err;
+    int n;
+    int i;
+
+    printf("TESTING GAUSS QUADRATURES GENERATION\n");
+    
+    //
+    // first test
+    //
+    alpha.setbounds(0, 1);
+    beta.setbounds(0, 1);
+    alpha(0) = 0;
+    alpha(1) = 0;
+    beta(1) = double(1)/double(4*1*1-1);
+    generategaussquadrature(alpha, beta, 2.0, 2, x, w);
+    err = 0;
+    err = ap::maxreal(err, fabs(x(0)+sqrt(double(3))/3));
+    err = ap::maxreal(err, fabs(x(1)-sqrt(double(3))/3));
+    err = ap::maxreal(err, fabs(w(0)-1));
+    err = ap::maxreal(err, fabs(w(1)-1));
+    printf("First test (Gauss-Legendre 2): error is %6.3le\n",
+        double(err));
+    
+    //
+    // second test
+    //
+    alpha.setbounds(0, 4);
+    beta.setbounds(0, 4);
+    alpha(0) = 0;
+    alpha(1) = 0;
+    alpha(2) = 0;
+    alpha(3) = 0;
+    alpha(4) = 0;
+    for(i = 1; i <= 4; i++)
+    {
+        beta(i) = ap::sqr(double(i))/(4*ap::sqr(double(i))-1);
+    }
+    generategaussquadrature(alpha, beta, 2.0, 5, x, w);
+    err = 0;
+    err = ap::maxreal(err, fabs(x(0)+sqrt(245+14*sqrt(double(70)))/21));
+    err = ap::maxreal(err, fabs(x(0)+x(4)));
+    err = ap::maxreal(err, fabs(x(1)+sqrt(245-14*sqrt(double(70)))/21));
+    err = ap::maxreal(err, fabs(x(1)+x(3)));
+    err = ap::maxreal(err, fabs(x(2)));
+    err = ap::maxreal(err, fabs(w(0)-(322-13*sqrt(double(70)))/900));
+    err = ap::maxreal(err, fabs(w(0)-w(4)));
+    err = ap::maxreal(err, fabs(w(1)-(322+13*sqrt(double(70)))/900));
+    err = ap::maxreal(err, fabs(w(1)-w(3)));
+    err = ap::maxreal(err, fabs(w(2)-double(128)/double(225)));
+    printf("Second test (Gauss-Legendre 5): error is %6.3le\n",
+        double(err));
+    
+    //
+    // chebyshev test 1, 10, 100
+    //
+    n = 1;
+    while(n<=512)
+    {
+        alpha.setbounds(0, n-1);
+        beta.setbounds(0, n-1);
+        for(i = 0; i <= n-1; i++)
+        {
+            alpha(i) = 0;
+            if( i==0 )
+            {
+                beta(i) = 0;
+            }
+            if( i==1 )
+            {
+                beta(i) = double(1)/double(2);
+            }
+            if( i>1 )
+            {
+                beta(i) = double(1)/double(4);
+            }
+        }
+        generategaussquadrature(alpha, beta, ap::pi(), n, x, w);
+        err = 0;
+        for(i = 0; i <= n-1; i++)
+        {
+            err = ap::maxreal(err, fabs(x(i)-cos(ap::pi()*(n-i-0.5)/n)));
+            err = ap::maxreal(err, fabs(w(i)-ap::pi()/n));
+        }
+        printf("Gauss-Chebyshev test (N=%0ld): error is %6.3le\n",
+            long(n),
+            double(err));
+        n = n*2;
+    }
+}
+
+
+

data/ext/alglib/gqgengauss.h

@@ -0,0 +1,92 @@
+/*************************************************************************
+Copyright (c) 2005-2007, Sergey Bochkanov (ALGLIB project).
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer listed
+  in this license in the documentation and/or other materials
+  provided with the distribution.
+
+- Neither the name of the copyright holders nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*************************************************************************/
+
+#ifndef _gqgengauss_h
+#define _gqgengauss_h
+
+#include "ap.h"
+#include "ialglib.h"
+
+#include "blas.h"
+#include "rotations.h"
+#include "tdevd.h"
+
+
+/*************************************************************************
+Computation of nodes and weights for a Gauss quadrature formula
+
+The algorithm generates the N-point Gauss quadrature formula with weighting
+function given by coefficients alpha and beta  of  a  recurrence  relation
+which generates a system of orthogonal polynomials:
+
+P-1(x)   =  0
+P0(x)    =  1
+Pn+1(x)  =  (x-alpha(n))*Pn(x)  -  beta(n)*Pn-1(x)
+
+and zero moment Mu0
+
+Mu0 = integral(W(x)dx,a,b)
+
+
+Input parameters:
+    Alpha   �   array of coefficients.
+                Array whose index ranges within [0..N-1].
+    Beta    �   array of coefficients.
+                Array whose index ranges within [0..N-1].
+                Zero-indexed element is not used and may be arbitrary.
+                Beta[I]>0.
+    Mu0     �   zeroth moment of the weighting function.
+    N       �   number of nodes of the quadrature formula, N>=1
+
+Output parameters:
+    X       �   array of nodes of the quadrature formula (in ascending order).
+                Array whose index ranges within [0..N-1].
+    W       �   array of weights of the quadrature formula.
+                Array whose index ranges within [0..N-1].
+
+Result:
+    True, if the algorithm finished its work successfully.
+    False, if the algorithm of finding the eigenvalues has not converged,
+    or one or more of the Beta coefficients is less or equal to 0.
+
+  -- ALGLIB --
+     Copyright 2005 by Bochkanov Sergey
+*************************************************************************/
+bool generategaussquadrature(const ap::real_1d_array& alpha,
+     const ap::real_1d_array& beta,
+     double mu0,
+     int n,
+     ap::real_1d_array& x,
+     ap::real_1d_array& w);
+
+
+#endif

data/ext/alglib/gqgenhermite.cpp

@@ -0,0 +1,268 @@
+/*************************************************************************
+Copyright (c) 2005-2007, Sergey Bochkanov (ALGLIB project).
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+- Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer listed
+  in this license in the documentation and/or other materials
+  provided with the distribution.
+
+- Neither the name of the copyright holders nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*************************************************************************/
+
+#include <stdafx.h>
+#include <stdio.h>
+#include "gqgenhermite.h"
+
+static double f(double x);
+static void testquad();
+
+/*************************************************************************
+Computation of nodes and weights for a Gauss-Hermite quadrature formula
+
+The  algorithm  calculates  the  nodes  and  weights  of the Gauss-Hermite
+quadrature  formula on domain  (-infinity, +infinity) with weight function
+W(x)=Exp(-x*x).
+
+Input parameters:
+    n   �   a required number of nodes.
+            1 <= n <= 190.
+
+Output parameters:
+    x   -   array of nodes.
+            Array whose index ranges from 0 to N-1.
+    w   -   array of weighting coefficients.
+            Array whose index ranges from 0 to N-1.
+
+The algorithm was designed by using information from the QUADRULE library.
+*************************************************************************/
+void buildgausshermitequadrature(int n,
+     ap::real_1d_array& x,
+     ap::real_1d_array& w)
+{
+    int i;
+    int j;
+    double r;
+    double r1;
+    double p1;
+    double p2;
+    double p3;
+    double dp3;
+    double pipm4;
+
+    x.setbounds(0, n-1);
+    w.setbounds(0, n-1);
+    pipm4 = pow(ap::pi(), -0.25);
+    for(i = 0; i <= (n+1)/2-1; i++)
+    {
+        if( i==0 )
+        {
+            r = sqrt(double(2*n+1))-1.85575*pow(double(2*n+1), -double(1)/double(6));
+        }
+        else
+        {
+            if( i==1 )
+            {
+                r = r-1.14*pow(double(n), 0.426)/r;
+            }
+            else
+            {
+                if( i==2 )
+                {
+                    r = 1.86*r-0.86*x(0);
+                }
+                else
+                {
+                    if( i==3 )
+                    {
+                        r = 1.91*r-0.91*x(1);
+                    }
+                    else
+                    {
+                        r = 2*r-x(i-2);
+                    }
+                }
+            }
+        }
+        do
+        {
+            p2 = 0;
+            p3 = pipm4;
+            for(j = 0; j <= n-1; j++)
+            {
+                p1 = p2;
+                p2 = p3;
+                p3 = p2*r*sqrt(double(2)/double(j+1))-p1*sqrt(double(j)/double(j+1));
+            }
+            dp3 = sqrt(double(2*j))*p2;
+            r1 = r;
+            r = r-p3/dp3;
+        }
+        while(fabs(r-r1)>=ap::machineepsilon*(1+fabs(r))*100);
+        x(i) = r;
+        w(i) = 2/(dp3*dp3);
+        x(n-1-i) = -x(i);
+        w(n-1-i) = w(i);
+    }
+}
+
+
+static double f(double x)
+{
+    double result;
+
+    result = sin(x)*sin(x);
+    return result;
+}
+
+
+static void testquad()
+{
+    double epsilon;
+    double a;
+    double b;
+    ap::real_1d_array x;
+    ap::real_1d_array w;
+    int n;
+    int i;
+    int j;
+    double v1;
+    double v2;
+    double h;
+    double s;
+    double s1;
+    double s2;
+    double s3;
+    double tx;
+    int simpfunccalls;
+    double nodedist;
+    double nodesectstart;
+    double nodesectend;
+    double tmp;
+
+    n = 10;
+    epsilon = 0.000000001;
+    a = -1;
+    b = 1;
+    printf("PRIMARY POINTS TEST\n");
+    v1 = 0;
+    simpfunccalls = 2;
+    s2 = 1;
+    h = b-a;
+    s = exp(-a*a)*f(a)+exp(-b*b)*f(b);
+    do
+    {
+        s3 = s2;
+        h = h/2;
+        s1 = 0;
+        tx = a+h;
+        do
+        {
+            s1 = s1+2*exp(-tx*tx)*f(tx);
+            simpfunccalls = simpfunccalls+1;
+            tx = tx+2*h;
+        }
+        while(tx<b);
+        s = s+s1;
+        s2 = (s+s1)*h/3;
+        tx = fabs(s3-s2)/15;
+    }
+    while(tx>epsilon);
+    v1 = s2;
+    printf("Simpson (%1ld calls) result %12.8lf\n",
+        long(simpfunccalls),
+        double(v1));
+    buildgausshermitequadrature(n, x, w);
+    v2 = 0;
+    for(i = 0; i <= n-1; i++)
+    {
+        v2 = v2+w(i)*f(x(i));
+    }
+    printf("Quadrature (%1ld points) result %12.8lf\n",
+        long(n),
+        double(v2));
+    printf("Difference is %5.3le\n",
+        double(fabs(v2-v1)));
+    n = 56;
+    printf("\n\nMIN NODE DISTANCE TEST\n");
+    buildgausshermitequadrature(n, x, w);
+    for(i = 0; i <= n-1; i++)
+    {
+        for(j = 0; j <= n-2-i; j++)
+        {
+            if( x(j)>=x(j+1) )
+            {
+                tmp = x(j);
+                x(j) = x(j+1);
+                x(j+1) = tmp;
+                tmp = w(j);
+                w(j) = w(j+1);
+                w(j+1) = tmp;
+            }
+        }
+    }
+    for(i = 0; i <= 4; i++)
+    {
+        nodedist = x(n-1)-x(0);
+        nodesectstart = nodedist*(0.2*i-0.5);
+        nodesectend = nodedist*(0.2*(i+1)-0.5);
+        for(j = 0; j <= n-2; j++)
+        {
+            if( x(j)>=nodesectstart&&x(j)<=nodesectend||x(j+1)>=nodesectstart&&x(j+1)<=nodesectend )
+            {
+                if( nodedist>x(j+1)-x(j) )
+                {
+                    nodedist = x(j+1)-x(j);
+                }
+            }
+        }
+        printf("Node distance at [%7.2lf, %7.2lf] is %7.3le\n",
+            double(nodesectstart),
+            double(nodesectend),
+            double(nodedist));
+    }
+    for(i = 0; i <= 4; i++)
+    {
+        tmp = x(n-1)-x(0);
+        nodesectstart = tmp*(0.2*i-0.5);
+        nodesectend = tmp*(0.2*(i+1)-0.5);
+        nodedist = 0;
+        for(j = 0; j <= n-1; j++)
+        {
+            if( x(j)>=nodesectstart&&x(j)<=nodesectend )
+            {
+                if( nodedist<fabs(w(j)) )
+                {
+                    nodedist = fabs(w(j));
+                }
+            }
+        }
+        printf("Max weight at [%7.2lf, %7.2lf] is %7.3le\n",
+            double(nodesectstart),
+            double(nodesectend),
+            double(nodedist));
+    }
+}
+
+
+