alglib 0.1.1

data/ext/alglib/hcholesky.cpp

@@ -0,0 +1,339 @@
+/*************************************************************************
+Copyright (c) 1992-2007 The University of Tennessee.  All rights reserved.
+
+Contributors:
+    * Sergey Bochkanov (ALGLIB project). Translation from FORTRAN to
+      pseudocode.
+
+See subroutines comments for additional copyrights.
+
+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 "hcholesky.h"
+
+/*************************************************************************
+Cholesky decomposition
+
+The algorithm computes Cholesky decomposition  of  a  Hermitian  positive-
+definite matrix.
+
+The result of an algorithm is a representation of matrix A as A = U'*U  or
+A = L*L' (here X' detones conj(X^T)).
+
+Input parameters:
+    A       -   upper or lower triangle of a factorized matrix.
+                array with elements [0..N-1, 0..N-1].
+    N       -   size of matrix A.
+    IsUpper -   if IsUpper=True, then A contains an upper triangle of
+                a symmetric matrix, otherwise A contains a lower one.
+
+Output parameters:
+    A       -   the result of factorization. If IsUpper=True, then
+                the upper triangle contains matrix U, so that A = U'*U,
+                and the elements below the main diagonal are not modified.
+                Similarly, if IsUpper = False.
+
+Result:
+    If the matrix is positive-definite, the function returns True.
+    Otherwise, the function returns False. This means that the
+    factorization could not be carried out.
+
+  -- LAPACK routine (version 3.0) --
+     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+     Courant Institute, Argonne National Lab, and Rice University
+     February 29, 1992
+*************************************************************************/
+bool hmatrixcholesky(ap::complex_2d_array& a, int n, bool isupper)
+{
+    bool result;
+    int j;
+    double ajj;
+    ap::complex v;
+    double r;
+    ap::complex_1d_array t;
+    ap::complex_1d_array t2;
+    ap::complex_1d_array t3;
+    int i;
+    ap::complex_2d_array a1;
+    int i_;
+
+    if( !isupper )
+    {
+        a1.setbounds(1, n, 1, n);
+        for(i = 1; i <= n; i++)
+        {
+            for(j = 1; j <= n; j++)
+            {
+                a1(i,j) = a(i-1,j-1);
+            }
+        }
+        result = hermitiancholeskydecomposition(a1, n, isupper);
+        for(i = 1; i <= n; i++)
+        {
+            for(j = 1; j <= n; j++)
+            {
+                a(i-1,j-1) = a1(i,j);
+            }
+        }
+        return result;
+    }
+    t.setbounds(0, n-1);
+    t2.setbounds(0, n-1);
+    t3.setbounds(0, n-1);
+    result = true;
+    if( n<0 )
+    {
+        result = false;
+        return result;
+    }
+    if( n==0 )
+    {
+        return result;
+    }
+    if( isupper )
+    {
+        for(j = 0; j <= n-1; j++)
+        {
+            v = 0.0;
+            for(i_=0; i_<=j-1;i_++)
+            {
+                v += ap::conj(a(i_,j))*a(i_,j);
+            }
+            ajj = (a(j,j)-v).x;
+            if( ajj<=0 )
+            {
+                a(j,j) = ajj;
+                result = false;
+                return result;
+            }
+            ajj = sqrt(ajj);
+            a(j,j) = ajj;
+            if( j<n-1 )
+            {
+                for(i_=0; i_<=j-1;i_++)
+                {
+                    t2(i_) = ap::conj(a(i_,j));
+                }
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    t3(i_) = a(j,i_);
+                }
+                complexmatrixvectormultiply(a, 0, j-1, j+1, n-1, true, false, t2, 0, j-1, -1.0, t3, j+1, n-1, 1.0, t);
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    a(j,i_) = t3(i_);
+                }
+                r = 1/ajj;
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    a(j,i_) = r*a(j,i_);
+                }
+            }
+        }
+    }
+    else
+    {
+        for(j = 0; j <= n-1; j++)
+        {
+            v = 0.0;
+            for(i_=0; i_<=j-1;i_++)
+            {
+                v += ap::conj(a(j,i_))*a(j,i_);
+            }
+            ajj = (a(j,j)-v).x;
+            if( ajj<=0 )
+            {
+                a(j,j) = ajj;
+                result = false;
+                return result;
+            }
+            ajj = sqrt(ajj);
+            a(j,j) = ajj;
+            if( j<n-1 )
+            {
+                for(i_=0; i_<=j-1;i_++)
+                {
+                    t2(i_) = ap::conj(a(j,i_));
+                }
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    t3(i_) = a(i_,j);
+                }
+                complexmatrixvectormultiply(a, j+1, n-1, 0, j-1, false, false, t2, 0, j-1, -1.0, t3, j+1, n-1, 1.0, t);
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    a(i_,j) = t3(i_);
+                }
+                r = 1/ajj;
+                for(i_=j+1; i_<=n-1;i_++)
+                {
+                    a(i_,j) = r*a(i_,j);
+                }
+            }
+        }
+    }
+    return result;
+}
+
+
+/*************************************************************************
+Obsolete 1-based subroutine
+*************************************************************************/
+bool hermitiancholeskydecomposition(ap::complex_2d_array& a,
+     int n,
+     bool isupper)
+{
+    bool result;
+    int j;
+    double ajj;
+    ap::complex v;
+    double r;
+    ap::complex_1d_array t;
+    ap::complex_1d_array t2;
+    ap::complex_1d_array t3;
+    int i_;
+
+    t.setbounds(1, n);
+    t2.setbounds(1, n);
+    t3.setbounds(1, n);
+    result = true;
+    if( n<0 )
+    {
+        result = false;
+        return result;
+    }
+    if( n==0 )
+    {
+        return result;
+    }
+    if( isupper )
+    {
+        for(j = 1; j <= n; j++)
+        {
+            v = 0.0;
+            for(i_=1; i_<=j-1;i_++)
+            {
+                v += ap::conj(a(i_,j))*a(i_,j);
+            }
+            ajj = (a(j,j)-v).x;
+            if( ajj<=0 )
+            {
+                a(j,j) = ajj;
+                result = false;
+                return result;
+            }
+            ajj = sqrt(ajj);
+            a(j,j) = ajj;
+            if( j<n )
+            {
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    a(i_,j) = ap::conj(a(i_,j));
+                }
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    t2(i_) = a(i_,j);
+                }
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    t3(i_) = a(j,i_);
+                }
+                complexmatrixvectormultiply(a, 1, j-1, j+1, n, true, false, t2, 1, j-1, -1.0, t3, j+1, n, 1.0, t);
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    a(j,i_) = t3(i_);
+                }
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    a(i_,j) = ap::conj(a(i_,j));
+                }
+                r = 1/ajj;
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    a(j,i_) = r*a(j,i_);
+                }
+            }
+        }
+    }
+    else
+    {
+        for(j = 1; j <= n; j++)
+        {
+            v = 0.0;
+            for(i_=1; i_<=j-1;i_++)
+            {
+                v += ap::conj(a(j,i_))*a(j,i_);
+            }
+            ajj = (a(j,j)-v).x;
+            if( ajj<=0 )
+            {
+                a(j,j) = ajj;
+                result = false;
+                return result;
+            }
+            ajj = sqrt(ajj);
+            a(j,j) = ajj;
+            if( j<n )
+            {
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    a(j,i_) = ap::conj(a(j,i_));
+                }
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    t2(i_) = a(j,i_);
+                }
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    t3(i_) = a(i_,j);
+                }
+                complexmatrixvectormultiply(a, j+1, n, 1, j-1, false, false, t2, 1, j-1, -1.0, t3, j+1, n, 1.0, t);
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    a(i_,j) = t3(i_);
+                }
+                for(i_=1; i_<=j-1;i_++)
+                {
+                    a(j,i_) = ap::conj(a(j,i_));
+                }
+                r = 1/ajj;
+                for(i_=j+1; i_<=n;i_++)
+                {
+                    a(i_,j) = r*a(i_,j);
+                }
+            }
+        }
+    }
+    return result;
+}
+
+
+

data/ext/alglib/hcholesky.h

@@ -0,0 +1,91 @@
+/*************************************************************************
+Copyright (c) 1992-2007 The University of Tennessee.  All rights reserved.
+
+Contributors:
+    * Sergey Bochkanov (ALGLIB project). Translation from FORTRAN to
+      pseudocode.
+
+See subroutines comments for additional copyrights.
+
+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 _hcholesky_h
+#define _hcholesky_h
+
+#include "ap.h"
+#include "ialglib.h"
+
+#include "cblas.h"
+
+
+/*************************************************************************
+Cholesky decomposition
+
+The algorithm computes Cholesky decomposition  of  a  Hermitian  positive-
+definite matrix.
+
+The result of an algorithm is a representation of matrix A as A = U'*U  or
+A = L*L' (here X' detones conj(X^T)).
+
+Input parameters:
+    A       -   upper or lower triangle of a factorized matrix.
+                array with elements [0..N-1, 0..N-1].
+    N       -   size of matrix A.
+    IsUpper -   if IsUpper=True, then A contains an upper triangle of
+                a symmetric matrix, otherwise A contains a lower one.
+
+Output parameters:
+    A       -   the result of factorization. If IsUpper=True, then
+                the upper triangle contains matrix U, so that A = U'*U,
+                and the elements below the main diagonal are not modified.
+                Similarly, if IsUpper = False.
+
+Result:
+    If the matrix is positive-definite, the function returns True.
+    Otherwise, the function returns False. This means that the
+    factorization could not be carried out.
+
+  -- LAPACK routine (version 3.0) --
+     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+     Courant Institute, Argonne National Lab, and Rice University
+     February 29, 1992
+*************************************************************************/
+bool hmatrixcholesky(ap::complex_2d_array& a, int n, bool isupper);
+
+
+/*************************************************************************
+Obsolete 1-based subroutine
+*************************************************************************/
+bool hermitiancholeskydecomposition(ap::complex_2d_array& a,
+     int n,
+     bool isupper);
+
+
+#endif

data/ext/alglib/hermite.cpp

@@ -0,0 +1,114 @@
+
+#include <stdafx.h>
+#include "hermite.h"
+
+/*************************************************************************
+Calculation of the value of the Hermite polynomial.
+
+Parameters:
+    n   -   degree, n>=0
+    x   -   argument
+
+Result:
+    the value of the Hermite polynomial Hn at x
+*************************************************************************/
+double hermitecalculate(const int& n, const double& x)
+{
+    double result;
+    int i;
+    double a;
+    double b;
+
+    
+    //
+    // Prepare A and B
+    //
+    a = 1;
+    b = 2*x;
+    
+    //
+    // Special cases: N=0 or N=1
+    //
+    if( n==0 )
+    {
+        result = a;
+        return result;
+    }
+    if( n==1 )
+    {
+        result = b;
+        return result;
+    }
+    
+    //
+    // General case: N>=2
+    //
+    for(i = 2; i <= n; i++)
+    {
+        result = 2*x*b-2*(i-1)*a;
+        a = b;
+        b = result;
+    }
+    return result;
+}
+
+
+/*************************************************************************
+Summation of Hermite polynomials using Clenshaw�s recurrence formula.
+
+This routine calculates
+    c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x)
+
+Parameters:
+    n   -   degree, n>=0
+    x   -   argument
+
+Result:
+    the value of the Hermite polynomial at x
+*************************************************************************/
+double hermitesum(const ap::real_1d_array& c, const int& n, const double& x)
+{
+    double result;
+    double b1;
+    double b2;
+    int i;
+
+    b1 = 0;
+    b2 = 0;
+    for(i = n; i >= 0; i--)
+    {
+        result = 2*(x*b1-(i+1)*b2)+c(i);
+        b2 = b1;
+        b1 = result;
+    }
+    return result;
+}
+
+
+/*************************************************************************
+Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N
+
+Input parameters:
+    N   -   polynomial degree, n>=0
+
+Output parameters:
+    C   -   coefficients
+*************************************************************************/
+void hermitecoefficients(const int& n, ap::real_1d_array& c)
+{
+    int i;
+
+    c.setbounds(0, n);
+    for(i = 0; i <= n; i++)
+    {
+        c(i) = 0;
+    }
+    c(n) = exp(n*log(double(2)));
+    for(i = 0; i <= n/2-1; i++)
+    {
+        c(n-2*(i+1)) = -c(n-2*i)*(n-2*i)*(n-2*i-1)/4/(i+1);
+    }
+}
+
+
+