alglib 0.1.1

data/ext/alglib/elliptic.h

@@ -0,0 +1,217 @@
+/*************************************************************************
+Cephes Math Library Release 2.8:  June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+
+Contributors:
+    * Sergey Bochkanov (ALGLIB project). Translation from C 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 _elliptic_h
+#define _elliptic_h
+
+#include "ap.h"
+#include "ialglib.h"
+
+/*************************************************************************
+Complete elliptic integral of the first kind
+
+Approximates the integral
+
+
+
+           pi/2
+            -
+           | |
+           |           dt
+K(m)  =    |    ------------------
+           |                   2
+         | |    sqrt( 1 - m sin t )
+          -
+           0
+
+using the approximation
+
+    P(x)  -  log x Q(x).
+
+ACCURACY:
+
+                     Relative error:
+arithmetic   domain     # trials      peak         rms
+   IEEE       0,1        30000       2.5e-16     6.8e-17
+
+Cephes Math Library, Release 2.8:  June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*************************************************************************/
+double ellipticintegralk(double m);
+
+
+/*************************************************************************
+Complete elliptic integral of the first kind
+
+Approximates the integral
+
+
+
+           pi/2
+            -
+           | |
+           |           dt
+K(m)  =    |    ------------------
+           |                   2
+         | |    sqrt( 1 - m sin t )
+          -
+           0
+
+where m = 1 - m1, using the approximation
+
+    P(x)  -  log x Q(x).
+
+The argument m1 is used rather than m so that the logarithmic
+singularity at m = 1 will be shifted to the origin; this
+preserves maximum accuracy.
+
+K(0) = pi/2.
+
+ACCURACY:
+
+                     Relative error:
+arithmetic   domain     # trials      peak         rms
+   IEEE       0,1        30000       2.5e-16     6.8e-17
+
+�������� ���� �� ���������� Cephes
+*************************************************************************/
+double ellipticintegralkhighprecision(double m1);
+
+
+/*************************************************************************
+Incomplete elliptic integral of the first kind F(phi|m)
+
+Approximates the integral
+
+
+
+               phi
+                -
+               | |
+               |           dt
+F(phi_\m)  =    |    ------------------
+               |                   2
+             | |    sqrt( 1 - m sin t )
+              -
+               0
+
+of amplitude phi and modulus m, using the arithmetic -
+geometric mean algorithm.
+
+
+
+
+ACCURACY:
+
+Tested at random points with m in [0, 1] and phi as indicated.
+
+                     Relative error:
+arithmetic   domain     # trials      peak         rms
+   IEEE     -10,10       200000      7.4e-16     1.0e-16
+
+Cephes Math Library Release 2.8:  June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*************************************************************************/
+double incompleteellipticintegralk(double phi, double m);
+
+
+/*************************************************************************
+Complete elliptic integral of the second kind
+
+Approximates the integral
+
+
+           pi/2
+            -
+           | |                 2
+E(m)  =    |    sqrt( 1 - m sin t ) dt
+         | |
+          -
+           0
+
+using the approximation
+
+     P(x)  -  x log x Q(x).
+
+ACCURACY:
+
+                     Relative error:
+arithmetic   domain     # trials      peak         rms
+   IEEE       0, 1       10000       2.1e-16     7.3e-17
+
+Cephes Math Library, Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*************************************************************************/
+double ellipticintegrale(double m);
+
+
+/*************************************************************************
+Incomplete elliptic integral of the second kind
+
+Approximates the integral
+
+
+               phi
+                -
+               | |
+               |                   2
+E(phi_\m)  =    |    sqrt( 1 - m sin t ) dt
+               |
+             | |
+              -
+               0
+
+of amplitude phi and modulus m, using the arithmetic -
+geometric mean algorithm.
+
+ACCURACY:
+
+Tested at random arguments with phi in [-10, 10] and m in
+[0, 1].
+                     Relative error:
+arithmetic   domain     # trials      peak         rms
+   IEEE     -10,10      150000       3.3e-15     1.4e-16
+
+Cephes Math Library Release 2.8:  June, 2000
+Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier
+*************************************************************************/
+double incompleteellipticintegrale(double phi, double m);
+
+
+#endif

data/ext/alglib/estnorm.cpp

@@ -0,0 +1,429 @@
+/*************************************************************************
+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 <stdio.h>
+#include "estnorm.h"
+
+static void testiterativeestimatenorm();
+
+/*************************************************************************
+Matrix norm estimation
+
+The algorithm estimates the 1-norm of square matrix A  on  the  assumption
+that the multiplication of matrix  A  by  the  vector  is  available  (the
+iterative method is used). It is recommended to use this algorithm  if  it
+is hard  to  calculate  matrix  elements  explicitly  (for  example,  when
+estimating the inverse matrix norm).
+
+The algorithm uses back communication for multiplying the  vector  by  the
+matrix.  If  KASE=0  after  returning from a subroutine, its execution was
+completed successfully, otherwise it is required to multiply the  returned
+vector by matrix A and call the subroutine again.
+
+The DemoIterativeEstimateNorm subroutine shows a simple example.
+
+Parameters:
+    N       -   size of matrix A.
+    V       -   vector.   It is initialized by the subroutine on the first
+                call. It is then passed into it on repeated calls.
+    X       -   if KASE<>0, it contains the vector to be replaced by:
+                    A * X,      if KASE=1
+                    A^T * X,    if KASE=2
+                Array whose index ranges within [1..N].
+    ISGN    -   vector. It is initialized by the subroutine on  the  first
+                call. It is then passed into it on repeated calls.
+    EST     -   if KASE=0, it contains the lower boundary of the matrix
+                norm estimate.
+    KASE    -   on the first call, it should be equal to 0. After the last
+                return, it is equal to 0 (EST contains the  matrix  norm),
+                on intermediate returns it can be equal to 1 or 2 depending
+                on the operation to be performed on vector X.
+
+  -- LAPACK auxiliary routine (version 3.0) --
+     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+     Courant Institute, Argonne National Lab, and Rice University
+     February 29, 1992
+*************************************************************************/
+void iterativeestimate1norm(int n,
+     ap::real_1d_array& v,
+     ap::real_1d_array& x,
+     ap::integer_1d_array& isgn,
+     double& est,
+     int& kase)
+{
+    int itmax;
+    int i;
+    double t;
+    bool flg;
+    int positer;
+    int posj;
+    int posjlast;
+    int posjump;
+    int posaltsgn;
+    int posestold;
+    int postemp;
+
+    itmax = 5;
+    posaltsgn = n+1;
+    posestold = n+2;
+    postemp = n+3;
+    positer = n+1;
+    posj = n+2;
+    posjlast = n+3;
+    posjump = n+4;
+    if( kase==0 )
+    {
+        v.setbounds(1, n+3);
+        x.setbounds(1, n);
+        isgn.setbounds(1, n+4);
+        t = double(1)/double(n);
+        for(i = 1; i <= n; i++)
+        {
+            x(i) = t;
+        }
+        kase = 1;
+        isgn(posjump) = 1;
+        return;
+    }
+    
+    //
+    //     ................ ENTRY   (JUMP = 1)
+    //     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
+    //
+    if( isgn(posjump)==1 )
+    {
+        if( n==1 )
+        {
+            v(1) = x(1);
+            est = fabs(v(1));
+            kase = 0;
+            return;
+        }
+        est = 0;
+        for(i = 1; i <= n; i++)
+        {
+            est = est+fabs(x(i));
+        }
+        for(i = 1; i <= n; i++)
+        {
+            if( x(i)>=0 )
+            {
+                x(i) = 1;
+            }
+            else
+            {
+                x(i) = -1;
+            }
+            isgn(i) = ap::sign(x(i));
+        }
+        kase = 2;
+        isgn(posjump) = 2;
+        return;
+    }
+    
+    //
+    //     ................ ENTRY   (JUMP = 2)
+    //     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
+    //
+    if( isgn(posjump)==2 )
+    {
+        isgn(posj) = 1;
+        for(i = 2; i <= n; i++)
+        {
+            if( fabs(x(i))>fabs(x(isgn(posj))) )
+            {
+                isgn(posj) = i;
+            }
+        }
+        isgn(positer) = 2;
+        
+        //
+        // MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
+        //
+        for(i = 1; i <= n; i++)
+        {
+            x(i) = 0;
+        }
+        x(isgn(posj)) = 1;
+        kase = 1;
+        isgn(posjump) = 3;
+        return;
+    }
+    
+    //
+    //     ................ ENTRY   (JUMP = 3)
+    //     X HAS BEEN OVERWRITTEN BY A*X.
+    //
+    if( isgn(posjump)==3 )
+    {
+        ap::vmove(&v(1), &x(1), ap::vlen(1,n));
+        v(posestold) = est;
+        est = 0;
+        for(i = 1; i <= n; i++)
+        {
+            est = est+fabs(v(i));
+        }
+        flg = false;
+        for(i = 1; i <= n; i++)
+        {
+            if( x(i)>=0&&isgn(i)<0||x(i)<0&&isgn(i)>=0 )
+            {
+                flg = true;
+            }
+        }
+        
+        //
+        // REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
+        // OR MAY BE CYCLING.
+        //
+        if( !flg||est<=v(posestold) )
+        {
+            v(posaltsgn) = 1;
+            for(i = 1; i <= n; i++)
+            {
+                x(i) = v(posaltsgn)*(1+double(i-1)/double(n-1));
+                v(posaltsgn) = -v(posaltsgn);
+            }
+            kase = 1;
+            isgn(posjump) = 5;
+            return;
+        }
+        for(i = 1; i <= n; i++)
+        {
+            if( x(i)>=0 )
+            {
+                x(i) = 1;
+                isgn(i) = 1;
+            }
+            else
+            {
+                x(i) = -1;
+                isgn(i) = -1;
+            }
+        }
+        kase = 2;
+        isgn(posjump) = 4;
+        return;
+    }
+    
+    //
+    //     ................ ENTRY   (JUMP = 4)
+    //     X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
+    //
+    if( isgn(posjump)==4 )
+    {
+        isgn(posjlast) = isgn(posj);
+        isgn(posj) = 1;
+        for(i = 2; i <= n; i++)
+        {
+            if( fabs(x(i))>fabs(x(isgn(posj))) )
+            {
+                isgn(posj) = i;
+            }
+        }
+        if( x(isgn(posjlast))!=fabs(x(isgn(posj)))&&isgn(positer)<itmax )
+        {
+            isgn(positer) = isgn(positer)+1;
+            for(i = 1; i <= n; i++)
+            {
+                x(i) = 0;
+            }
+            x(isgn(posj)) = 1;
+            kase = 1;
+            isgn(posjump) = 3;
+            return;
+        }
+        
+        //
+        // ITERATION COMPLETE.  FINAL STAGE.
+        //
+        v(posaltsgn) = 1;
+        for(i = 1; i <= n; i++)
+        {
+            x(i) = v(posaltsgn)*(1+double(i-1)/double(n-1));
+            v(posaltsgn) = -v(posaltsgn);
+        }
+        kase = 1;
+        isgn(posjump) = 5;
+        return;
+    }
+    
+    //
+    //     ................ ENTRY   (JUMP = 5)
+    //     X HAS BEEN OVERWRITTEN BY A*X.
+    //
+    if( isgn(posjump)==5 )
+    {
+        v(postemp) = 0;
+        for(i = 1; i <= n; i++)
+        {
+            v(postemp) = v(postemp)+fabs(x(i));
+        }
+        v(postemp) = 2*v(postemp)/(3*n);
+        if( v(postemp)>est )
+        {
+            ap::vmove(&v(1), &x(1), ap::vlen(1,n));
+            est = v(postemp);
+        }
+        kase = 0;
+        return;
+    }
+}
+
+
+/*************************************************************************
+Example of usage of an IterativeEstimateNorm subroutine
+
+Input parameters:
+    A   -   matrix.
+            Array whose indexes range within [1..N, 1..N].
+
+Return:
+    Matrix norm estimated by the subroutine.
+
+  -- ALGLIB --
+     Copyright 2005 by Bochkanov Sergey
+*************************************************************************/
+double demoiterativeestimate1norm(const ap::real_2d_array& a, int n)
+{
+    double result;
+    int i;
+    double s;
+    ap::real_1d_array x;
+    ap::real_1d_array t;
+    ap::real_1d_array v;
+    ap::integer_1d_array iv;
+    int kase;
+
+    kase = 0;
+    t.setbounds(1, n);
+    iterativeestimate1norm(n, v, x, iv, result, kase);
+    while(kase!=0)
+    {
+        if( kase==1 )
+        {
+            for(i = 1; i <= n; i++)
+            {
+                s = ap::vdotproduct(&a(i, 1), &x(1), ap::vlen(1,n));
+                t(i) = s;
+            }
+        }
+        else
+        {
+            for(i = 1; i <= n; i++)
+            {
+                s = ap::vdotproduct(a.getcolumn(i, 1, n), x.getvector(1, n));
+                t(i) = s;
+            }
+        }
+        ap::vmove(&x(1), &t(1), ap::vlen(1,n));
+        iterativeestimate1norm(n, v, x, iv, result, kase);
+    }
+    return result;
+}
+
+
+static void testiterativeestimatenorm()
+{
+    ap::real_2d_array a;
+    int n;
+    int i;
+    int j;
+    int k;
+    double avg;
+    double nrm1a;
+    double estnrm1a;
+    double v;
+    int pass;
+    int passcount;
+    double maxerr;
+    double avgerr;
+
+    passcount = 1000;
+    avg = 100;
+    maxerr = 0;
+    avgerr = 0;
+    for(pass = 1; pass <= passcount; pass++)
+    {
+        n = 1+ap::randominteger(50);
+        a.setbounds(1, n, 1, n);
+        
+        //
+        // fill
+        //
+        for(i = 1; i <= n; i++)
+        {
+            for(j = 1; j <= n; j++)
+            {
+                a(i,j) = sqrt(avg)*(2*ap::randomreal()-1);
+                a(i,j) = ap::sqr(a(i,j));
+            }
+        }
+        a(1+ap::randominteger(n),1+ap::randominteger(n)) = 1.5*avg*(2*ap::randomreal()-1);
+        
+        //
+        // norm A
+        //
+        nrm1a = 0;
+        for(k = 1; k <= n; k++)
+        {
+            v = 0;
+            for(i = 1; i <= n; i++)
+            {
+                v = v+fabs(a(i,k));
+            }
+            nrm1a = ap::maxreal(nrm1a, v);
+        }
+        estnrm1a = demoiterativeestimate1norm(a, n);
+        
+        //
+        // test
+        //
+        maxerr = ap::maxreal(maxerr, fabs(1-estnrm1a/nrm1a));
+        avgerr = avgerr+fabs(1-estnrm1a/nrm1a);
+    }
+    printf("TOTAL PASS COUNT %0ld\n",
+        long(passcount));
+    printf("1-norm: avg %4.2lf percents of exact, max %4.2lf\n",
+        double(100*avgerr/passcount),
+        double(100*maxerr));
+}
+
+
+