gavindiaz/EA_with_Python
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
codex/20260607_separate_ea
EA_with_Python/Include/Math/Alglib/linalg.mqh
T

37630 lines
1.4 MiB
Plaintext
Raw Permalink Blame History

//+------------------------------------------------------------------+
//| linalg.mqh |
//| Copyright 2003-2022 Sergey Bochkanov (ALGLIB project) |
//| Copyright 2012-2026, MetaQuotes Ltd. |
//| www.mql5.com |
//+------------------------------------------------------------------+
//| Implementation of ALGLIB library in MetaQuotes Language 5 |
//| |
//| The features of the library include: |
//| - Linear algebra (direct algorithms, EVD, SVD) |
//| - Solving systems of linear and non-linear equations |
//| - Interpolation |
//| - Optimization |
//| - FFT (Fast Fourier Transform) |
//| - Numerical integration |
//| - Linear and nonlinear least-squares fitting |
//| - Ordinary differential equations |
//| - Computation of special functions |
//| - Descriptive statistics and hypothesis testing |
//| - Data analysis - classification, regression |
//| - Implementing linear algebra algorithms, interpolation, etc. |
//| in high-precision arithmetic (using MPFR) |
//| |
//| This file is free software; you can redistribute it and/or |
//| modify it under the terms of the GNU General Public License as |
//| published by the Free Software Foundation (www.fsf.org); either |
//| version 2 of the License, or (at your option) any later version. |
//| |
//| This program is distributed in the hope that it will be useful, |
//| but WITHOUT ANY WARRANTY;without even the implied warranty of |
//| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
//| GNU General Public License for more details. |
//+------------------------------------------------------------------+
#include "alglibinternal.mqh"
#include "alglibmisc.mqh"
//+------------------------------------------------------------------+
//| Work with matrix forms |
//+------------------------------------------------------------------+
class CAblas
{
public:
//--- size
static int AblasBlockSize(void) { return(32);}
static int AblasMicroBlockSize(void) { return(8); }
static int AblasComplexBlockSize(void) { return(24);}
static const int m_blas2minvendorkernelsize;
//--- split lenght
static void AblasSplitLength(const CMatrixDouble &a,const int n,int &n1,int &n2);
static void AblasComplexSplitLength(const CMatrixComplex &a,const int n,int &n1,int &n2);
//--- real numbers
static void RMatrixSyrk(const int n,const int k,const double alpha,const CMatrixDouble &a,const int ia,const int ja,const int OpTypea,const double beta,CMatrixDouble &c,const int ic,const int jc,const bool IsUpper);
static void RMatrixGemm(const int m,const int n,const int k,const double alpha,const CMatrixDouble &a,const int ia,const int ja,const int OpTypea,const CMatrixDouble &b,const int ib,const int jb,const int OpTypeb,const double beta,CMatrixDouble &c,const int ic,const int jc);
static void RMatrixTranspose(const int m,const int n,const CMatrixDouble &a,const int ia,const int ja,CMatrixDouble &b,const int ib,const int jb);
static void RMatrixEnforceSymmetricity(CMatrixDouble &a,int n,bool IsUpper=true);
static void RMatrixCopy(const int m,const int n,const CMatrixDouble &a,const int ia,const int ja,CMatrixDouble &b,const int ib,const int jb);
static void RVectorCopy(int n,CRowDouble &a,int ia,CRowDouble &b,int ib);
static void RMatrixGenCopy(int m,int n,double alpha,CMatrixDouble &a,int ia,int ja,double beta,CMatrixDouble &b,int ib,int jb);
static void RMatrixGer(int m,int n,CMatrixDouble &a,int ia,int ja,double alpha,CRowDouble &u,int iu,CRowDouble &v,int iv);
static void RMatrixRank1(const int m,const int n,CMatrixDouble &a,const int ia,const int ja,const double &u[],const int iu,const double &v[],const int iv);
static void RMatrixRank1(const int m,const int n,CMatrixDouble &a,const int ia,const int ja,const CRowDouble &u,const int iu,const CRowDouble &v,const int iv);
static void RMatrixGemVect(int m,int n,double alpha,CMatrixDouble &a,int ia,int ja,int opa,CRowDouble &x,int ix,double beta,CRowDouble &y,int iy);
static void RMatrixMVect(const int m,const int n,const CMatrixDouble &a,const int ia,const int ja,const int opa,const double &x[],const int ix,double &y[],const int iy);
static void RMatrixMVect(const int m,const int n,const CMatrixDouble &a,const int ia,const int ja,const int opa,const CRowDouble &x,const int ix,CRowDouble &y,const int iy);
static void RMatrixSymVect(int n,double alpha,CMatrixDouble &a,int ia,int ja,bool IsUpper,CRowDouble &x,int ix,double beta,CRowDouble &y,int iy);
static double RMatrixSyvMVect(int n,CMatrixDouble &a,int ia,int ja,bool IsUpper,CRowDouble &x,int ix,CRowDouble &tmp);
static void RMatrixTrsVect(int n,CMatrixDouble &a,int ia,int ja,bool IsUpper,bool IsUnit,int OpType,CRowDouble &x,int ix);
static void RMatrixRightTrsM(const int m,const int n,CMatrixDouble &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixDouble &x,const int i2,const int j2);
static void RMatrixLeftTrsM(const int m,const int n,CMatrixDouble &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixDouble &x,const int i2,const int j2);
//--- complex numbers
static void CMatrixHerk(int n,int k,complex alpha,CMatrixComplex &a,int ia,int ja,int OpTypea,complex beta,CMatrixComplex &c,int ic,int jc,bool IsUpper);
static void CMatrixSyrk(const int n,const int k,const double alpha,CMatrixComplex &a,const int ia,const int ja,const int OpTypea,const double beta,CMatrixComplex &c,const int ic,const int jc,const bool IsUpper);
static void CMatrixGemm(const int m,const int n,const int k,complex &alpha,CMatrixComplex &a,const int ia,const int ja,const int OpTypea,CMatrixComplex &b,const int ib,const int jb,const int OpTypeb,complex &beta,CMatrixComplex &c,const int ic,const int jc);
static void CMatrixTranspose(const int m,const int n,const CMatrixComplex &a,const int ia,const int ja,CMatrixComplex &b,const int ib,const int jb);
static void CMatrixCopy(const int m,const int n,const CMatrixComplex &a,const int ia,const int ja,CMatrixComplex &b,const int ib,const int jb);
static void CMatrixRank1(const int m,const int n,CMatrixComplex &a,const int ia,const int ja,const complex &u[],const int iu,const complex &v[],const int iv);
static void CMatrixRank1(const int m,const int n,CMatrixComplex &a,const int ia,const int ja,const CRowComplex &u,const int iu,const CRowComplex &v,const int iv);
static void CMatrixMVect(const int m,const int n,const CMatrixComplex &a,const int ia,const int ja,const int opa,const complex &x[],const int ix,complex &y[],const int iy);
static void CMatrixMVect(const int m,const int n,const CMatrixComplex &a,const int ia,const int ja,const int opa,const CRowComplex &x,const int ix,CRowComplex &y,const int iy);
static void CMatrixRightTrsM(const int m,const int n,CMatrixComplex &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixComplex &x,const int i2,const int j2);
static void CMatrixLeftTrsM(const int m,const int n,CMatrixComplex &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixComplex &x,const int i2,const int j2);
//--- reflection
static void GenerateReflection(CRowDouble &x,int n,double &tau);
static void ApplyReflectionFromTheLeft(CMatrixDouble &c,double tau,CRowDouble &v,int m1,int m2,int n1,int n2,CRowDouble &work);
static void ApplyReflectionFromTheRight(CMatrixDouble &c,double tau,CRowDouble &v,int m1,int m2,int n1,int n2,CRowDouble &work);
//---
static void RowWiseGramSchmidt(CMatrixDouble &q,int m,int n,CRowDouble &x,CRowDouble &qx,bool needqx);
private:
//--- split lenght
static void AblasInternalSplitLength(const int n,const int nb,int &n1,int &n2);
//--- real numbers
static void RMatrixSyrk2(const int n,const int k,const double alpha,const CMatrixDouble &a,const int ia,const int ja,const int OpTypea,const double beta,CMatrixDouble &c,const int ic,const int jc,const bool IsUpper);
static void RMatrixGemmK(const int m,const int n,const int k,const double alpha,const CMatrixDouble &a,const int ia,const int ja,const int OpTypea,const CMatrixDouble &b,const int ib,const int jb,const int OpTypeb,const double beta,CMatrixDouble &c,const int ic,const int jc);
static void RMatrixGemmRec(int m,int n,int k,double alpha,const CMatrixDouble &a,int ia,int ja,int OpTypea,const CMatrixDouble &b,int ib,int jb,int OpTypeb,double beta,CMatrixDouble &c,int ic,int jc);
static void RMatrixRightTrsM2(const int m,const int n,CMatrixDouble &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixDouble &x,const int i2,const int j2);
static void RMatrixLeftTrsM2(const int m,const int n,CMatrixDouble &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixDouble &x,const int i2,const int j2);
//--- complex numbers
static void CMatrixHerk2(int n,int k,complex alpha,CMatrixComplex &a,int ia,int ja,int OpTypea,complex beta,CMatrixComplex &c,int ic,int jc,bool IsUpper);
static void CMatrixSyrk2(const int n,const int k,const complex alpha,const CMatrixComplex &a,const int ia,const int ja,const int OpTypea,const complex beta,CMatrixComplex &c,const int ic,const int jc,const bool IsUpper);
static void CMatrixGemmk(const int m,const int n,const int k,complex &alpha,const CMatrixComplex &a,const int ia,const int ja,const int OpTypea,const CMatrixComplex &b,const int ib,const int jb,const int OpTypeb,complex &beta,CMatrixComplex &c,const int ic,const int jc);
static void CMatrixGemmRec(int m,int n,int k,complex alpha,CMatrixComplex &a,int ia,int ja,int OpTypea,CMatrixComplex &b,int ib,int jb,int OpTypeb,complex beta,CMatrixComplex &c,int ic,int jc);
static void CMatrixRightTrsM2(const int m,const int n,CMatrixComplex &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixComplex &x,const int i2,const int j2);
static void CMatrixLeftTrsM2(const int m,const int n,CMatrixComplex &a,const int i1,const int j1,const bool IsUpper,const bool IsUnit,const int OpType,CMatrixComplex &x,const int i2,const int j2);
};
//+------------------------------------------------------------------+
//| This subroutine calculates C=alpha*A*A^T+beta*C or |
//| C=alpha*A^T*A+beta*C where: |
//| * C is NxN symmetric matrix given by its upper/lower triangle |
//| * A is NxK matrix when A*A^T is calculated, KxN matrix otherwise |
//| Additional info: |
//| * multiplication result replaces C. If Beta=0, C elements are not|
//| used in calculations (not multiplied by zero - just not |
//| referenced) |
//| * if Alpha=0, A is not used (not multiplied by zero - just not |
//| referenced) |
//| * if both Beta and Alpha are zero, C is filled by zeros. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| K - matrix size, K>=0 |
//| Alpha - coefficient |
//| A - matrix |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| OpTypeA - multiplication type: |
//| * 0 - A*A^T is calculated |
//| * 2 - A^T*A is calculated |
//| Beta - coefficient |
//| C - preallocated input/output matrix |
//| IC - submatrix offset (row index) |
//| JC - submatrix offset (column index) |
//| IsUpper - whether C is upper triangular or lower triangular |
//+------------------------------------------------------------------+
void CAblas::RMatrixSyrk(const int n,const int k,const double alpha,
const CMatrixDouble &a,const int ia,const int ja,
const int OpTypea,const double beta,CMatrixDouble &c,
const int ic,const int jc,const bool IsUpper)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(n,k)<=tsb?tsa:tsb);
//--- check
if(!CAp::Assert(tscur>=1,"RMatrixSYRK: integrity check failed"))
return;
//--- check
if(MathMax(n,k)<=tsa)
{
RMatrixSyrk2(n,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
return;
}
//--- check
if(k>=n)
{
//--- Split K
CApServ::TiledSplit(k,tscur,s1,s2);
//--- check
if(OpTypea==0)
{
RMatrixSyrk(n,s1,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixSyrk(n,s2,alpha,a,ia,ja+s1,OpTypea,1.0,c,ic,jc,IsUpper);
}
else
{
RMatrixSyrk(n,s1,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixSyrk(n,s2,alpha,a,ia+s1,ja,OpTypea,1.0,c,ic,jc,IsUpper);
}
}
else
{
//--- Split N
CApServ::TiledSplit(n,tscur,s1,s2);
//--- check
switch(IsUpper)
{
case true:
if(OpTypea==0)
{
RMatrixSyrk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixGemm(s1,s2,k,alpha,a,ia,ja,0,a,ia+s1,ja,1,beta,c,ic,jc+s1);
RMatrixSyrk(s2,k,alpha,a,ia+s1,ja,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
}
else
{
RMatrixSyrk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixGemm(s1,s2,k,alpha,a,ia,ja,1,a,ia,ja+s1,0,beta,c,ic,jc+s1);
RMatrixSyrk(s2,k,alpha,a,ia,ja+s1,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
}
break;
case false:
if(OpTypea==0)
{
RMatrixSyrk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixGemm(s2,s1,k,alpha,a,ia+s1,ja,0,a,ia,ja,1,beta,c,ic+s1,jc);
RMatrixSyrk(s2,k,alpha,a,ia+s1,ja,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
}
else
{
RMatrixSyrk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
RMatrixGemm(s2,s1,k,alpha,a,ia,ja+s1,1,a,ia,ja,0,beta,c,ic+s1,jc);
RMatrixSyrk(s2,k,alpha,a,ia,ja+s1,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
}
break;
}
}
//--- exit the function
return;
}
//+------------------------------------------------------------------+
//| Splits matrix length in two parts, left part should match ABLAS |
//| block size |
//| INPUT PARAMETERS: |
//| A - real matrix, is passed to ensure that we didn't split|
//| complex matrix using real splitting subroutine. |
//| matrix itself is not changed. |
//| N - length, N>0 |
//| OUTPUT PARAMETERS: |
//| N1 - length |
//| N2 - length |
//| N1+N2=N, N1>=N2, N2 may be zero |
//+------------------------------------------------------------------+
void CAblas::AblasSplitLength(const CMatrixDouble &a,const int n,
int &n1,int &n2)
{
//--- initialization
n1=0;
n2=0;
//--- check
if(n>AblasBlockSize())
AblasInternalSplitLength(n,AblasBlockSize(),n1,n2);
else
AblasInternalSplitLength(n,AblasMicroBlockSize(),n1,n2);
//--- exit the function
return;
}
//+------------------------------------------------------------------+
//| Complex ABLASSplitLength |
//+------------------------------------------------------------------+
void CAblas::AblasComplexSplitLength(const CMatrixComplex &a,const int n,
int &n1,int &n2)
{
//--- check
if(n>AblasComplexBlockSize())
AblasInternalSplitLength(n,AblasComplexBlockSize(),n1,n2);
else
AblasInternalSplitLength(n,AblasMicroBlockSize(),n1,n2);
}
//+------------------------------------------------------------------+
//| This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:|
//| * C is MxN general matrix |
//| * op1(A) is MxK matrix |
//| * op2(B) is KxN matrix |
//|*"op" may be identity transformation, transposition |
//| Additional info: |
//| * cache-oblivious algorithm is used. |
//| * multiplication result replaces C. If Beta=0, C elements are not|
//| used in calculations (not multiplied by zero - just not |
//| referenced) |
//| * if Alpha=0, A is not used (not multiplied by zero - just not |
//| referenced) |
//| * if both Beta and Alpha are zero, C is filled by zeros. |
//| IMPORTANT: This function does NOT preallocate output matrix C, it|
//| MUST be preallocated by caller prior to calling this |
//| function. In case C does not have enough space to |
//| store result, exception will be generated. |
//| INPUT PARAMETERS: |
//| M - matrix size, M>0 |
//| N - matrix size, N>0 |
//| K - matrix size, K>0 |
//| Alpha - coefficient |
//| A - matrix |
//| IA - submatrix offset |
//| JA - submatrix offset |
//| OpTypeA - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| B - matrix |
//| IB - submatrix offset |
//| JB - submatrix offset |
//| OpTypeB - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| Beta - coefficient |
//| C - PREALLOCATED output matrix, large enough to store |
//| result |
//| IC - submatrix offset |
//| JC - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::RMatrixGemm(const int m,const int n,const int k,const double alpha,
const CMatrixDouble &a,const int ia,const int ja,
const int OpTypea,const CMatrixDouble &b,
const int ib,const int jb,const int OpTypeb,
const double beta,CMatrixDouble &c,const int ic,
const int jc)
{
//--- Check input sizes for correctness
if(!CAp::Assert(OpTypea==0 || OpTypea==1,__FUNCTION__+": incorrect OpTypeA (must be 0 or 1)"))
return;
if(!CAp::Assert(OpTypeb==0 || OpTypeb==1,__FUNCTION__+": incorrect OpTypeB (must be 0 or 1)"))
return;
//--- check
if(!CAp::Assert(ic+m<=c.Rows(),__FUNCTION__+": incorect size of output matrix C"))
return;
if(!CAp::Assert(jc+n<=c.Cols(),__FUNCTION__+": incorect size of output matrix C"))
return;
//--- Start actual work
RMatrixGemmRec(m,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
//+------------------------------------------------------------------+
//| Level 2 subrotuine |
//+------------------------------------------------------------------+
void CAblas::RMatrixSyrk2(const int n,const int k,const double alpha,
const CMatrixDouble &a,const int ia,const int ja,
const int OpTypea,const double beta,CMatrixDouble &c,
const int ic,const int jc,const bool IsUpper)
{
//--- check
if((alpha==0.0 || k==0.0) && beta==1.0)
return;
//--- create variables
int i=0;
int j=0;
int j1=0;
int j2=0;
double v=0;
int i_=0;
int i1_=0;
//--- SYRK
if(OpTypea==0)
{
//--- C=alpha*A*A^H+beta*C
for(i=0; i<n; i++)
{
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
for(j=j1; j<=j2; j++)
{
//--- check
if(alpha!=0 && k>0)
{
v=0.0;
for(i_=ja; i_<ja+k; i_++)
v+=a.Get(ia+i,i_)*a.Get(ia+j,i_);
}
else
v=0;
//--- check
if(beta==0)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
}
else
{
//--- C=alpha*A^H*A+beta*C
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
//--- check
if(beta==0)
{
for(j=j1; j<=j2; j++)
c.Set(ic+i,jc+j,0);
}
else
{
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Mul(ic+i,i_,beta);
}
}
if(k>0)
for(i=0; i<k; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(IsUpper)
{
j1=j;
j2=n-1;
}
else
{
j1=0;
j2=j;
}
//--- change values
v=alpha*a.Get(ia+i,ja+j);
i1_=(ja+j1)-(jc+j1);
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Set(ic+j,i_,c.Get(ic+j,i_)+v*a.Get(ia+i,i_+i1_));
}
}
}
}
//+------------------------------------------------------------------+
//| Complex ABLASSplitLength |
//+------------------------------------------------------------------+
void CAblas::AblasInternalSplitLength(const int n,const int nb,
int &n1,int &n2)
{
//--- initialization
int r=0;
n1=0;
n2=0;
//--- check
if(n<=nb)
{
//--- Block size, no further splitting
n1=n;
n2=0;
}
else
{
//--- Greater than block size
if(n%nb!=0)
{
//--- Split remainder
n2=n%nb;
n1=n-n2;
}
else
{
//--- Split on block boundaries
n2=n/2;
n1=n-n2;
//--- check
if(n1%nb==0)
return;
r=nb-n1%nb;
n1+=r;
n2-=r;
}
}
}
//+------------------------------------------------------------------+
//| GEMM kernel |
//+------------------------------------------------------------------+
void CAblas::RMatrixGemmK(const int m,const int n,const int k,const double alpha,
const CMatrixDouble &a,const int ia,const int ja,
const int OpTypea,const CMatrixDouble &b,const int ib,
const int jb,const int OpTypeb,const double beta,
CMatrixDouble &c,const int ic,const int jc)
{
//--- check
if(m*n==0)
return;
//--- create variables
int i=0;
int j=0;
double v=0;
int i_=0;
int i1_=0;
//--- if K=0, then C=Beta*C
if(k==0)
{
//--- check
if(beta!=1)
{
//--- check
if(beta!=0)
{
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j));
}
else
{
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,0);
}
}
}
else
switch(OpTypea)
{
case 0:
//--- check
if(OpTypeb==0)
{
//--- a*b
for(i=0; i<m; i++)
{
//--- check
if(beta!=0)
{
for(i_=jc; i_<jc+n; i_++)
c.Set(ic+i,i_,beta*c.Get(ic+i,i_));
}
else
{
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,0);
}
//--- check
if(alpha!=0)
{
for(j=0; j<k; j++)
{
v=alpha*a.Get(ia+i,ja+j);
i1_=jb-jc;
for(i_=jc; i_<jc+n; i_++)
c.Set(ic+i,i_,c.Get(ic+i,i_)+v*b.Get(ib+j,i_+i1_));
}
}
}
}
else
{
//--- a*b'
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(k==0 || alpha==0)
v=0;
else
{
i1_=jb-ja;
v=0.0;
for(i_=ja; i_<ja+k; i_++)
v+=a.Get(ia+i,i_)*b.Get(ib+j,i_+i1_);
}
//--- check
if(beta==0)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
}
break;
default:
//--- check
if(OpTypeb==0)
{
//--- a`*b
if(beta==0)
{
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,0);
}
else
{
for(i=0; i<m; i++)
for(i_=jc; i_<jc+n; i_++)
c.Set(ic+i,i_,beta*c.Get(ic+i,i_));
}
//--- check
if(alpha!=0)
{
for(j=0; j<k; j++)
for(i=0; i<m; i++)
{
v=alpha*a.Get(ia+j,ja+i);
i1_=jb-jc;
for(i_=jc; i_<jc+n; i_++)
c.Set(ic+i,i_,c.Get(ic+i,i_)+v*b.Get(ib+j,i_+i1_));
}
}
}
else
{
//--- a`*b`
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(alpha==0)
v=0;
else
{
i1_=(jb)-(ia);
v=0.0;
for(i_=ia; i_<ia+k; i_++)
v+=a.Get(i_,ja+i)*b.Get(ib+j,i_+i1_);
}
//--- check
if(beta==0)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
}
break;
}
}
//+------------------------------------------------------------------+
//| This subroutine is an actual implementation of RMatrixGEMM. It |
//| does not perform some integrity checks performed in the driver |
//| function, and it does not activate multithreading framework |
//| (driver decides whether to activate workers or not). |
//+------------------------------------------------------------------+
void CAblas::RMatrixGemmRec(int m,int n,int k,double alpha,
const CMatrixDouble &a,int ia,int ja,
int OpTypea,const CMatrixDouble &b,
int ib,int jb,int OpTypeb,
double beta,CMatrixDouble &c,
int ic,int jc)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(m,MathMax(n,k))<=tsb?tsa:tsb);
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
if((m<=tsa && n<=tsa) && k<=tsa)
{
CAblasF::RMatrixGemmK(m,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
return;
}
//--- Recursive algorithm: split on M or N
if(m>=n && m>=k)
{
//--- A*B = (A1 A2)^T*B
CApServ::TiledSplit(m,tscur,s1,s2);
if(OpTypea==0)
{
RMatrixGemmRec(s2,n,k,alpha,a,ia+s1,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic+s1,jc);
RMatrixGemmRec(s1,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
else
{
RMatrixGemmRec(s2,n,k,alpha,a,ia,ja+s1,OpTypea,b,ib,jb,OpTypeb,beta,c,ic+s1,jc);
RMatrixGemmRec(s1,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
return;
}
if(n>=m && n>=k)
{
//--- A*B = A*(B1 B2)
CApServ::TiledSplit(n,tscur,s1,s2);
if(OpTypeb==0)
{
RMatrixGemmRec(m,s2,k,alpha,a,ia,ja,OpTypea,b,ib,jb+s1,OpTypeb,beta,c,ic,jc+s1);
RMatrixGemmRec(m,s1,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
else
{
RMatrixGemmRec(m,s2,k,alpha,a,ia,ja,OpTypea,b,ib+s1,jb,OpTypeb,beta,c,ic,jc+s1);
RMatrixGemmRec(m,s1,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
return;
}
//--- Recursive algorithm: split on K
//--- A*B = (A1 A2)*(B1 B2)^T
CApServ::TiledSplit(k,tscur,s1,s2);
switch(OpTypea)
{
case 0:
if(OpTypeb==0)
{
RMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
RMatrixGemmRec(m,n,s2,alpha,a,ia,ja+s1,OpTypea,b,ib+s1,jb,OpTypeb,1.0,c,ic,jc);
}
else
{
RMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
RMatrixGemmRec(m,n,s2,alpha,a,ia,ja+s1,OpTypea,b,ib,jb+s1,OpTypeb,1.0,c,ic,jc);
}
break;
default:
if(OpTypeb==0)
{
RMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
RMatrixGemmRec(m,n,s2,alpha,a,ia+s1,ja,OpTypea,b,ib+s1,jb,OpTypeb,1.0,c,ic,jc);
}
else
{
RMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
RMatrixGemmRec(m,n,s2,alpha,a,ia+s1,ja,OpTypea,b,ib,jb+s1,OpTypeb,1.0,c,ic,jc);
}
break;
}
}
//+------------------------------------------------------------------+
//| Cache-oblivous complex "copy-and-transpose" |
//| Input parameters: |
//| M - number of rows |
//| N - number of columns |
//| A - source matrix, MxN submatrix is copied and transposed|
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| B - destination matrix |
//| IB - submatrix offset (row index) |
//| JB - submatrix offset (column index) |
//+------------------------------------------------------------------+
void CAblas::CMatrixTranspose(const int m,const int n,const CMatrixComplex &a,
const int ia,const int ja,CMatrixComplex &b,
const int ib,const int jb)
{
//--- create variables
int i=0;
int s1=0;
int s2=0;
int i_=0;
int i1_=0;
//--- check
if(m<=2*AblasComplexBlockSize() && n<=2*AblasComplexBlockSize())
{
//--- base case
for(i=0; i<m; i++)
{
i1_=ja-ib;
for(i_=ib; i_<ib+n; i_++)
b.Set(i_,jb+i,a.Get(ia+i,i_+i1_));
}
}
else
{
//--- Cache-oblivious recursion
if(m>n)
{
//--- split
AblasComplexSplitLength(a,m,s1,s2);
//--- function call
CMatrixTranspose(s1,n,a,ia,ja,b,ib,jb);
CMatrixTranspose(s2,n,a,ia+s1,ja,b,ib,jb+s1);
}
else
{
//--- split
AblasComplexSplitLength(a,n,s1,s2);
//--- function call
CMatrixTranspose(m,s1,a,ia,ja,b,ib,jb);
CMatrixTranspose(m,s2,a,ia,ja+s1,b,ib+s1,jb);
}
}
}
//+------------------------------------------------------------------+
//| Cache-oblivous real "copy-and-transpose" |
//| Input parameters: |
//| M - number of rows |
//| N - number of columns |
//| A - source matrix, MxN submatrix is copied and transposed|
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| A - destination matrix |
//| IB - submatrix offset (row index) |
//| JB - submatrix offset (column index) |
//+------------------------------------------------------------------+
void CAblas::RMatrixTranspose(const int m,const int n,const CMatrixDouble &a,
const int ia,const int ja,CMatrixDouble &b,
const int ib,const int jb)
{
//--- create variables
int i=0;
int s1=0;
int s2=0;
int i_=0;
int i1_=0;
//--- check
if(m<=2*AblasBlockSize() && n<=2*AblasBlockSize())
{
//--- base case
for(i=0; i<m; i++)
{
i1_=ja-ib;
for(i_=ib; i_<ib+n; i_++)
b.Set(i_,jb+i,a.Get(ia+i,i_+i1_));
}
}
else
{
//--- Cache-oblivious recursion
if(m>n)
{
//--- split
AblasSplitLength(a,m,s1,s2);
//--- function call
RMatrixTranspose(s1,n,a,ia,ja,b,ib,jb);
RMatrixTranspose(s2,n,a,ia+s1,ja,b,ib,jb+s1);
}
else
{
//--- split
AblasSplitLength(a,n,s1,s2);
//--- function call
RMatrixTranspose(m,s1,a,ia,ja,b,ib,jb);
RMatrixTranspose(m,s2,a,ia,ja+s1,b,ib+s1,jb);
}
}
}
//+------------------------------------------------------------------+
//| This code enforces symmetricy of the matrix by copying Upper part|
//| to lower one (or vice versa). |
//| INPUT PARAMETERS: |
//| A - matrix |
//| N - number of rows/columns |
//| IsUpper - whether we want to copy upper triangle to lower |
//| one (True) or vice versa (False). |
//+------------------------------------------------------------------+
void CAblas::RMatrixEnforceSymmetricity(CMatrixDouble &a,
int n,
bool IsUpper=true)
{
//--- create variables
int i=0;
int j=0;
//--- check
if(!CAp::Assert(a.Rows()>=n,__FUNCTION__+": N more then rows in matrix A"))
return;
//--- check
if(!CAp::Assert(a.Cols()>=n,__FUNCTION__+": N more then columns in matrix A"))
return;
if(IsUpper)
{
for(i=0; i<n; i++)
for(j=i+1; j<n; j++)
a.Set(j,i,a.Get(i,j));
}
else
{
for(i=0; i<n; i++)
for(j=i+1; j<n; j++)
a.Set(i,j,a.Get(j,i));
}
}
//+------------------------------------------------------------------+
//| Copy |
//| Input parameters: |
//| M - number of rows |
//| N - number of columns |
//| A - source matrix, MxN submatrix is copied and transposed|
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| B - destination matrix |
//| IB - submatrix offset (row index) |
//| JB - submatrix offset (column index) |
//+------------------------------------------------------------------+
void CAblas::CMatrixCopy(const int m,const int n,const CMatrixComplex &a,
const int ia,const int ja,CMatrixComplex &b,
const int ib,const int jb)
{
//--- create variables
int i=0;
int i_=0;
int i1_=0;
//--- copy
for(i=0; i<m; i++)
{
i1_=ja-jb;
for(i_=jb; i_<jb+n; i_++)
b.Set(ib+i,i_,a.Get(ia+i,i_+i1_));
}
}
//+------------------------------------------------------------------+
//| Copy |
//| Input parameters: |
//| N - subvector size |
//| A - source vector, N elements are copied |
//| IA - source offset (first element index) |
//| B - destination vector, must be large enough to store |
//| result |
//| IB - destination offset (first element index) |
//+------------------------------------------------------------------+
void CAblas::RVectorCopy(int n,
CRowDouble &a,
int ia,
CRowDouble &b,
int ib)
{
//--- check
if(n==0)
return;
if(ia==0 && ib==0 && a.Size()<=n)
CAblasF::RCopyV(n,a,b);
else
CAblasF::RCopyVX(n,a,ia,b,ib);
}
//+------------------------------------------------------------------+
//| Copy |
//| Input parameters: |
//| M - number of rows |
//| N - number of columns |
//| A - source matrix, MxN submatrix is copied and transposed|
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| B - destination matrix |
//| IB - submatrix offset (row index) |
//| JB - submatrix offset (column index) |
//+------------------------------------------------------------------+
void CAblas::RMatrixCopy(const int m,const int n,const CMatrixDouble &a,
const int ia,const int ja,CMatrixDouble &b,
const int ib,const int jb)
{
//--- create variables
int i=0;
int i_=0;
int i1_=ja-jb;
//--- copy
for(i=0; i<m; i++)
{
for(i_=jb; i_<jb+n; i_++)
b.Set(ib+i,i_,a.Get(ia+i,i_+i1_));
}
}
//+------------------------------------------------------------------+
//| Performs generalized copy: B := Beta*B + Alpha*A. |
//| If Beta=0, then previous contents of B is simply ignored. If |
//| Alpha=0, then A is ignored and not referenced. If both Alpha and |
//| Beta are zero, B is filled by zeros. |
//| Input parameters: |
//| M - number of rows |
//| N - number of columns |
//| Alpha - coefficient |
//| A - source matrix, MxN submatrix is copied and transposed |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| Beta - coefficient |
//| B - destination matrix, must be large enough to store |
//| result |
//| IB - submatrix offset (row index) |
//| JB - submatrix offset (column index) |
//+------------------------------------------------------------------+
void CAblas::RMatrixGenCopy(int m,int n,double alpha,
CMatrixDouble &a,int ia,int ja,
double beta,CMatrixDouble &b,
int ib,int jb)
{
//--- check
if(m==0 || n==0)
return;
//--- create variables
int i=0;
int j=0;
//--- Zero-fill
if((double)(alpha)==0.0 && (double)(beta)==0.0)
{
for(i=0; i<m; i++)
for(j=0; j<n; j++)
b.Set(ib+i,jb+j,0);
return;
}
//--- Inplace multiply
if((double)(alpha)==0.0)
{
for(i=0; i<=m-1; i++)
for(j=0; j<n; j++)
b.Set(ib+i,jb+j,beta*b.Get(ib+i,jb+j));
return;
}
//--- Multiply and copy
if((double)(beta)==0.0)
{
for(i=0; i<=m-1; i++)
for(j=0; j<n; j++)
b.Set(ib+i,jb+j,alpha*a.Get(ia+i,ja+j));
return;
}
//--- Generic
for(i=0; i<=m-1; i++)
for(j=0; j<n; j++)
b.Set(ib+i,jb+j,alpha*a.Get(ia+i,ja+j)+beta*b.Get(ib+i,jb+j));
}
//+------------------------------------------------------------------+
//| Rank-1 correction: A := A + alpha*u*v' |
//| NOTE: this function expects A to be large enough to store result.|
//| No automatic preallocation happens for smaller arrays. No |
//| integrity checks is performed for sizes of A, u, v. |
//| INPUT PARAMETERS: |
//| M - number of rows |
//| N - number of columns |
//| A - target matrix, MxN submatrix is updated |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| Alpha - coefficient |
//| U - vector #1 |
//| IU - subvector offset |
//| V - vector #2 |
//| IV - subvector offset |
//+------------------------------------------------------------------+
void CAblas::RMatrixGer(int m,int n,CMatrixDouble &a,
int ia,int ja,double alpha,
CRowDouble &u,int iu,CRowDouble &v,
int iv)
{
//--- check
if(m==0 || n==0)
return;
//--- create variables
int i=0;
double s=0;
int i_=0;
int i1_=0;
//--- Generic code
for(i=0; i<m; i++)
{
s=alpha*u[iu+i];
i1_=(iv)-(ja);
for(i_=ja; i_<ja+n ; i_++)
a.Add(ia+i,i_,s*v[i_+i1_]);
}
}
//+------------------------------------------------------------------+
//| Rank-1 correction: A := A + u*v' |
//| INPUT PARAMETERS: |
//| M - number of rows |
//| N - number of columns |
//| A - target matrix, MxN submatrix is updated |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| U - vector #1 |
//| IU - subvector offset |
//| V - vector #2 |
//| IV - subvector offset |
//+------------------------------------------------------------------+
void CAblas::CMatrixRank1(const int m,const int n,CMatrixComplex &a,
const int ia,const int ja,const complex &u[],
const int iu,const complex &v[],const int iv)
{
CRowComplex U=u;
CRowComplex V=v;
CMatrixRank1(m,n,a,ia,ja,U,iu,V,iv);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::CMatrixRank1(const int m,const int n,CMatrixComplex &a,
const int ia,const int ja,const CRowComplex &u,
const int iu,const CRowComplex &v,const int iv)
{
//--- check
if(m==0 || n==0)
return;
//--- create variables
int i=0;
complex s=0;
int i_=0;
int i1_=0;
//--- Generic code
for(i=0; i<m; i++)
{
s=u[iu+i];
i1_=iv-ja;
for(i_=ja; i_<ja+n; i_++)
a.Set(ia+i,i_,a.Get(ia+i,i_)+s*v[i_+i1_]);
}
}
//+------------------------------------------------------------------+
//| IMPORTANT: this function is deprecated since ALGLIB 3.13. Use |
//| RMatrixGER() which is more generic version of this function. |
//| |
//| Rank-1 correction: A := A + u*v' |
//| INPUT PARAMETERS: |
//| M - number of rows |
//| N - number of columns |
//| A - target matrix, MxN submatrix is updated |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| U - vector #1 |
//| IU - subvector offset |
//| V - vector #2 |
//| IV - subvector offset |
//+------------------------------------------------------------------+
void CAblas::RMatrixRank1(const int m,const int n,CMatrixDouble &a,
const int ia,const int ja,const double &u[],
const int iu,const double &v[],const int iv)
{
CRowDouble U=u;
CRowDouble V=v;
RMatrixRank1(m,n,a,ia,ja,U,iu,V,iv);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::RMatrixRank1(const int m,const int n,CMatrixDouble &a,
const int ia,const int ja,const CRowDouble &u,
const int iu,const CRowDouble &v,const int iv)
{
//--- check
if(m==0 || n==0)
return;
//--- create variables
int i=0;
double s=0;
int i_=0;
int i1_=0;
//--- Generic code
for(i=0; i<m; i++)
{
s=u[iu+i];
i1_=iv-ja;
for(i_=ja; i_<ja+n; i_++)
a.Set(ia+i,i_,a.Get(ia+i,i_)+s*v[i_+i1_]);
}
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::RMatrixGemVect(int m,int n,double alpha,
CMatrixDouble &a,int ia,int ja,
int opa,CRowDouble &x,int ix,
double beta,CRowDouble &y,int iy)
{
//--- Quick exit for M=0, N=0 or Alpha=0.
//--- After this block we have M>0, N>0, Alpha<>0.
if(m<=0)
return;
if(n<=0 || alpha==0.0)
{
if((double)(beta)!=0.0)
CAblasF::RMulVX(m,beta,y,iy);
else
CAblasF::RSetVX(m,0.0,y,iy);
return;
}
if(ia+ja+ix+iy==0)
CAblasF::RGemV(m,n,alpha,a,opa,x,beta,y);
else
CAblasF::RGemVX(m,n,alpha,a,ia,ja,opa,x,ix,beta,y,iy);
}
//+------------------------------------------------------------------+
//| Matrix-vector product: y := op(A)*x |
//| INPUT PARAMETERS: |
//| M - number of rows of op(A) |
//| M>=0 |
//| N - number of columns of op(A) |
//| N>=0 |
//| A - target matrix |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| OpA - operation type: |
//| * OpA=0 => op(A) = A |
//| * OpA=1 => op(A) = A^T |
//| * OpA=2 => op(A) = A^H |
//| X - input vector |
//| IX - subvector offset |
//| IY - subvector offset |
//| OUTPUT PARAMETERS: |
//| Y - vector which stores result |
//| if M=0, then subroutine does nothing. |
//| if N=0, Y is filled by zeros. |
//+------------------------------------------------------------------+
void CAblas::CMatrixMVect(const int m,const int n,const CMatrixComplex &a,
const int ia,const int ja,const int opa,
const complex &x[],const int ix,complex &y[],
const int iy)
{
CRowComplex X=x;
CRowComplex Y=y;
CMatrixMVect(m,n,a,ia,ja,opa,X,ix,Y,iy);
Y.ToArray(y);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::CMatrixMVect(const int m,const int n,const CMatrixComplex &a,
const int ia,const int ja,const int opa,
const CRowComplex &x,const int ix,CRowComplex &y,
const int iy)
{
//--- check
if(m==0)
return;
//--- create variables
int i=0;
complex v=0;
int i_=0;
int i1_=0;
//--- check
if(n==0)
{
for(i=0; i<m; i++)
y.Set(iy+i,0.0);
//--- exit the function
return;
}
//--- Generic code
switch(opa)
{
case 0:
//--- y = A*x
for(i=0; i<m; i++)
{
i1_=ix-ja;
v=0.0;
for(i_=ja; i_<ja+n; i_++)
v+=a.Get(ia+i,i_)*x[i_+i1_];
//--- get y
y.Set(iy+i,v);
}
//--- exit the function
return;
break;
case 1:
//--- y = A^T*x
for(i=0; i<m; i++)
y.Set(iy+i,0.0);
for(i=0; i<n; i++)
{
v=x[ix+i];
i1_=ja-iy;
for(i_=iy; i_<iy+m; i_++)
y.Set(i_,y[i_]+v*a.Get(ia+i,i_+i1_));
}
//--- exit the function
return;
break;
case 2:
//--- y = A^H*x
for(i=0; i<m; i++)
y.Set(iy+i,0.0);
for(i=0; i<n; i++)
{
v=x[ix+i];
i1_=ja-iy;
for(i_=iy; i_<=iy+m-1; i_++)
y.Set(i_,y[i_]+v*CMath::Conj(a.Get(ia+i,i_+i1_)));
}
break;
}
}
//+------------------------------------------------------------------+
//| IMPORTANT: this function is deprecated since ALGLIB 3.13. Use |
//| RMatrixGEMV() which is more generic version of this function. |
//| |
//| Matrix-vector product: y := op(A)*x |
//| INPUT PARAMETERS: |
//| M - number of rows of op(A) |
//| N - number of columns of op(A) |
//| A - target matrix |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| OpA - operation type: |
//| * OpA=0 => op(A) = A |
//| * OpA=1 => op(A) = A^T |
//| X - input vector |
//| IX - subvector offset |
//| IY - subvector offset |
//| OUTPUT PARAMETERS: |
//| Y - vector which stores result |
//| if M=0, then subroutine does nothing. |
//| if N=0, Y is filled by zeros. |
//+------------------------------------------------------------------+
void CAblas::RMatrixMVect(const int m,const int n,const CMatrixDouble &a,
const int ia,const int ja,const int opa,
const double &x[],const int ix,double &y[],
const int iy)
{
CRowDouble X=x;
CRowDouble Y=y;
RMatrixMVect(m,n,a,ia,ja,opa,X,ix,Y,iy);
Y.ToArray(y);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::RMatrixMVect(const int m,const int n,const CMatrixDouble &a,
const int ia,const int ja,const int opa,
const CRowDouble &x,const int ix,CRowDouble &y,
const int iy)
{
//--- check
if(m==0)
return;
//--- create variables
int i=0;
double v=0;
int i_=0;
int i1_=0;
//--- check
if(n==0)
{
for(i=0; i<m; i++)
y.Set(iy+i,0.0);
//--- exit the function
return;
}
//--- Generic code
switch(opa)
{
case 0:
//--- y = A*x
for(i=0; i<m; i++)
{
i1_=ix-ja;
v=0.0;
for(i_=ja; i_<ja+n; i_++)
v+=a.Get(ia+i,i_)*x[i_+i1_];
y.Set(iy+i,v);
}
break;
//--- check
case 1:
//--- y = A^T*x
for(i=0; i<m; i++)
y.Set(iy+i,0);
for(i=0; i<n; i++)
{
v=x[ix+i];
i1_=ja-iy;
for(i_=iy; i_<iy+m; i_++)
y.Add(i_,v*a.Get(ia+i,i_+i1_));
}
break;
}
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAblas::RMatrixSymVect(int n,double alpha,CMatrixDouble &a,
int ia,int ja,bool IsUpper,CRowDouble &x,
int ix,double beta,CRowDouble &y,
int iy)
{
//--- check
if(n<=0)
return;
//--- create variables
int i=0;
int j=0;
double v=0;
double vr=0;
double vx=0;
//--- Quick exit for Alpha=0.
//--- After this block we have N>0, Alpha<>0.
if(beta!=0.0)
CAblasF::RMulV(n,beta,y);
else
CAblasF::RSetV(n,0,y);
if(alpha==0.0)
return;
//--- Generic code
if(IsUpper)
{
//--- Upper triangle of A is stored
for(i=0; i<n; i++)
{
//--- Process diagonal element
v=alpha*a.Get(ia+i,ja+i);
y.Add(iy+i,v*x[ix+i]);
//--- Process off-diagonal elements
vr=0.0;
vx=x[ix+i];
for(j=i+1; j<n; j++)
{
v=alpha*a.Get(ia+i,ja+j);
y.Add(iy+j,v*vx);
vr=vr+v*x[ix+j];
}
y.Add(iy+i,vr);
}
}
else
{
//--- Lower triangle of A is stored
for(i=0; i<n; i++)
{
//--- Process diagonal element
v=alpha*a.Get(ia+i,ja+i);
y.Set(iy+i,y[iy+i]+v*x[ix+i]);
//--- Process off-diagonal elements
vr=0.0;
vx=x[ix+i];
for(j=0; j<i; j++)
{
v=alpha*a.Get(ia+i,ja+j);
y.Set(iy+j,y[iy+j]+v*vx);
vr+=v*x[ix+j];
}
y.Set(iy+i,y[iy+i]+vr);
}
}
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
double CAblas::RMatrixSyvMVect(int n,CMatrixDouble &a,int ia,
int ja,bool IsUpper,CRowDouble &x,
int ix,CRowDouble &tmp)
{
//--- Quick exit for N=0
if(n<=0)
return(0);
//--- Generic code
RMatrixSymVect(n,1.0,a,ia,ja,IsUpper,x,ix,0.0,tmp,0);
double result=0;
for(int i=0; i<n; i++)
result+=x[ix+i]*tmp[i];
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| This subroutine solves linear system op(A)*x=b where: |
//| * A is NxN upper/lower triangular/unitriangular matrix |
//| * X and B are Nx1 vectors |
//|*"op" may be identity transformation or transposition |
//| Solution replaces X. |
//| IMPORTANT: * no overflow/underflow/denegeracy tests is performed.|
//| * no integrity checks for operand sizes, out-of-bounds|
//| accesses and so on is performed |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| A - matrix, actial matrix is stored in |
//| A[IA:IA+N-1,JA:JA+N-1] |
//| IA - submatrix offset |
//| JA - submatrix offset |
//| IsUpper - whether matrix is upper triangular |
//| IsUnit - whether matrix is unitriangular |
//| OpType - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| X - right part, actual vector is stored in X[IX:IX+N-1] |
//| IX - offset |
//| OUTPUT PARAMETERS: |
//| X - solution replaces elements X[IX:IX+N-1] |
//| (c) 2016 Reference BLAS level1 routine (LAPACK version 3.7.0) |
//| Reference BLAS is a software package provided by Univ. of |
//| Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver|
//| and NAG Ltd. |
//+------------------------------------------------------------------+
void CAblas::RMatrixTrsVect(int n,CMatrixDouble &a,int ia,
int ja,bool IsUpper,bool IsUnit,
int OpType,CRowDouble &x,int ix)
{
//--- Quick exit
if(n<=0)
return;
//--- create variables
int i=0;
int j=0;
double v=0;
//--- Generic code
switch(OpType)
{
case 0:
if(IsUpper)
{
for(i=n-1; i>=0; i--)
{
v=x[ix+i];
for(j=i+1; j<n; j++)
v-=a.Get(ia+i,ja+j)*x[ix+j];
if(!IsUnit)
v*=MathPow(a.Get(ia+i,ja+i),-1.0);
x.Set(ix+i,v);
}
}
else
{
for(i=0; i<n; i++)
{
v=x[ix+i];
for(j=0; j<i; j++)
v-=a.Get(ia+i,ja+j)*x[ix+j];
if(!IsUnit)
v*=MathPow(a.Get(ia+i,ja+i),-1.0);
x.Set(ix+i,v);
}
}
break;
case 1:
if(IsUpper)
{
for(i=0; i<n; i++)
{
v=x[ix+i];
if(!IsUnit)
{
v*=MathPow(a.Get(ia+i,ja+i),-1.0);
x.Set(ix+i,v);
}
if(v==0)
continue;
for(j=i+1; j<n; j++)
x.Set(ix+j,x[ix+j]-v*a.Get(ia+i,ja+j));
}
}
else
{
for(i=n-1; i>=0; i--)
{
v=x[ix+i];
if(!IsUnit)
{
v*=MathPow(a.Get(ia+i,ja+i),-1.0);
x.Set(ix+i,v);
}
if(v==0)
continue;
for(j=0; j<i; j++)
x.Set(ix+j,x[ix+j]-v*a.Get(ia+i,ja+j));
}
}
break;
default:
CAp::Assert(false,__FUNCTION__+": unexpected operation type");
return;
}
//--- exit the function
return;
}
//+------------------------------------------------------------------+
//| This subroutine calculates X*op(A^-1) where: |
//| * X is MxN general matrix |
//| * A is NxN upper/lower triangular/unitriangular matrix |
//|*"op" may be identity transformation, transposition, conjugate |
//| transposition |
//| Multiplication result replaces X. |
//| Cache-oblivious algorithm is used. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| M - matrix size, N>=0 |
//| A - matrix, actial matrix is stored in |
//| A[I1:I1+N-1,J1:J1+N-1] |
//| I1 - submatrix offset |
//| J1 - submatrix offset |
//| IsUpper - whether matrix is upper triangular |
//| IsUnit - whether matrix is unitriangular |
//| OpType - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| * 2 - conjugate transposition |
//| X - matrix, actial matrix is stored in |
//| X[I2:I2+M-1,J2:J2+N-1] |
//| I2 - submatrix offset |
//| J2 - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::CMatrixRightTrsM(const int m,const int n,CMatrixComplex &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixComplex &x,const int i2,const int j2)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(m,n)<=tsb?tsa:tsb);
complex One=1;
complex mOne=-1;
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
//--- Upper level parallelization:
//--- * decide whether it is feasible to activate multithreading
//--- * perform optionally parallelized splits on M
if(m>=2*tsb)
{
//--- Split X: X*A = (X1 X2)^T*A
CApServ::TiledSplit(m,tsb,s1,s2);
CMatrixRightTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixRightTrsM(s2,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
return;
}
//--- ALGLIB basecase code
if(MathMax(m,n)<=tsa)
{
CMatrixRightTrsM2(m,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
return;
}
//--- Recursive subdivision
if(m>=n)
{
//--- Split X: X*A = (X1 X2)^T*A
CApServ::TiledSplit(m,tscur,s1,s2);
CMatrixRightTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixRightTrsM(s2,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
}
else
{
//--- Split A:
//--- (A1 A12)
//--- X*op(A) = X*op( )
//--- ( A2)
//---
//--- Different variants depending on
//--- IsUpper/OpType combinations
//
CApServ::TiledSplit(n,tscur,s1,s2);
switch(IsUpper)
{
case true:
if(OpType==0)
{
//--- (A1 A12)-1
//--- X*A^-1 = (X1 X2)*( )
//--- ( A2)
CMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixGemm(m,s2,s1,mOne,x,i2,j2,0,a,i1,j1+s1,0,One,x,i2,j2+s1);
CMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
else
{
//--- (A1' )-1
//--- X*A^-1 = (X1 X2)*( )
//--- (A12' A2')
CMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
CMatrixGemm(m,s1,s2,mOne,x,i2,j2+s1,0,a,i1,j1+s1,OpType,One,x,i2,j2);
CMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
break;
case false:
if(OpType==0)
{
//--- (A1 )-1
//--- X*A^-1 = (X1 X2)*( )
//--- (A21 A2)
CMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
CMatrixGemm(m,s1,s2,mOne,x,i2,j2+s1,0,a,i1+s1,j1,0,One,x,i2,j2);
CMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
else
{
//--- (A1' A21')-1
//--- X*A^-1 = (X1 X2)*( )
//--- ( A2')
CMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixGemm(m,s2,s1,mOne,x,i2,j2,0,a,i1+s1,j1,OpType,One,x,i2,j2+s1);
CMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
break;
}
}
}
//+------------------------------------------------------------------+
//| This subroutine calculates op(A^-1)*X where: |
//| * X is MxN general matrix |
//| * A is MxM upper/lower triangular/unitriangular matrix |
//|*"op" may be identity transformation, transposition, conjugate |
//| transposition |
//| Multiplication result replaces X. |
//| Cache-oblivious algorithm is used. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| M - matrix size, N>=0 |
//| A - matrix, actial matrix is stored in |
//| A[I1:I1+M-1,J1:J1+M-1] |
//| I1 - submatrix offset |
//| J1 - submatrix offset |
//| IsUpper - whether matrix is upper triangular |
//| IsUnit - whether matrix is unitriangular |
//| OpType - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| * 2 - conjugate transposition |
//| C - matrix, actial matrix is stored in |
//| C[I2:I2+M-1,J2:J2+N-1] |
//| I2 - submatrix offset |
//| J2 - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::CMatrixLeftTrsM(const int m,const int n,CMatrixComplex &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixComplex &x,const int i2,const int j2)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(m,n)<=tsb?tsa:tsb);
complex One=1;
complex mOne=-1;
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
//--- Upper level parallelization:
//--- * decide whether it is feasible to activate multithreading
//--- * perform optionally parallelized splits on N
if(n>=2*tsb)
{
CApServ::TiledSplit(n,tscur,s1,s2);
CMatrixLeftTrsM(m,s2,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
CMatrixLeftTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
return;
}
//--- ALGLIB basecase code
if(MathMax(m,n)<=tsa)
{
CMatrixLeftTrsM2(m,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
return;
}
//--- Recursive subdivision
if(n>=m)
{
//--- Split X: op(A)^-1*X = op(A)^-1*(X1 X2)
CApServ::TiledSplit(n,tscur,s1,s2);
CMatrixLeftTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixLeftTrsM(m,s2,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
else
{
//--- Split A
CApServ::TiledSplit(m,tscur,s1,s2);
switch(IsUpper)
{
case true:
if(OpType==0)
{
//--- (A1 A12)-1 ( X1 )
//--- A^-1*X* = ( ) *( )
//--- ( A2) ( X2 )
CMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
CMatrixGemm(s1,n,s2,mOne,a,i1,j1+s1,0,x,i2+s1,j2,0,One,x,i2,j2);
CMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
else
{
//--- (A1' )-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- (A12' A2') ( X2 )
CMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixGemm(s2,n,s1,mOne,a,i1,j1+s1,OpType,x,i2,j2,0,One,x,i2+s1,j2);
CMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
}
break;
case false:
if(OpType==0)
{
//--- (A1 )-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- (A21 A2) ( X2 )
CMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
CMatrixGemm(s2,n,s1,mOne,a,i1+s1,j1,0,x,i2,j2,0,One,x,i2+s1,j2);
CMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
}
else
{
//--- (A1' A21')-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- ( A2') ( X2 )
CMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
CMatrixGemm(s1,n,s2,mOne,a,i1+s1,j1,OpType,x,i2+s1,j2,0,One,x,i2,j2);
CMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
break;
}
}
}
//+------------------------------------------------------------------+
//| This subroutine calculates X*op(A^-1) where: |
//| * X is MxN general matrix |
//| * A is NxN upper/lower triangular/unitriangular matrix |
//|*"op" may be identity transformation, transposition |
//| Multiplication result replaces X. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| M - matrix size, N>=0 |
//| A - matrix, actial matrix is stored in |
//| A[I1:I1+N-1,J1:J1+N-1] |
//| I1 - submatrix offset |
//| J1 - submatrix offset |
//| IsUpper - whether matrix is upper triangular |
//| IsUnit - whether matrix is unitriangular |
//| OpType - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| X - matrix, actial matrix is stored in |
//| X[I2:I2+M-1,J2:J2+N-1] |
//| I2 - submatrix offset |
//| J2 - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::RMatrixRightTrsM(const int m,const int n,CMatrixDouble &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixDouble &x,const int i2,const int j2)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(m,n)<=tsb?tsa:tsb);
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
//--- Upper level parallelization:
//--- * decide whether it is feasible to activate multithreading
//--- * perform optionally parallelized splits on M
if(m>=2*tsb)
{
//--- Split X: X*A = (X1 X2)^T*A
CApServ::TiledSplit(m,tsb,s1,s2);
RMatrixRightTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixRightTrsM(s2,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
return;
}
//--- Basecase ALGLIB code
if(MathMax(m,n)<=tsa)
{
RMatrixRightTrsM2(m,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
return;
}
//--- Recursive subdivision
if(m>=n)
{
//--- Split X: X*A = (X1 X2)^T*A
CApServ::TiledSplit(m,tscur,s1,s2);
RMatrixRightTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixRightTrsM(s2,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
}
else
{
//--- Split A:
//--- (A1 A12)
//--- X*op(A) = X*op( )
//--- ( A2)
//--- Different variants depending on
//--- IsUpper/OpType combinations
CApServ::TiledSplit(n,tscur,s1,s2);
switch(IsUpper)
{
case true:
if(OpType==0)
{
//--- (A1 A12)-1
//--- X*A^-1 = (X1 X2)*( )
//--- ( A2)
RMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixGemm(m,s2,s1,-1.0,x,i2,j2,0,a,i1,j1+s1,0,1.0,x,i2,j2+s1);
RMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
else
{
//--- (A1' )-1
//--- X*A^-1 = (X1 X2)*( )
//--- (A12' A2')
RMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
RMatrixGemm(m,s1,s2,-1.0,x,i2,j2+s1,0,a,i1,j1+s1,OpType,1.0,x,i2,j2);
RMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
break;
case false:
if(OpType==0)
{
//--- (A1 )-1
//--- X*A^-1 = (X1 X2)*( )
//--- (A21 A2)
RMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
RMatrixGemm(m,s1,s2,-1.0,x,i2,j2+s1,0,a,i1+s1,j1,0,1.0,x,i2,j2);
RMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
else
{
//--- (A1' A21')-1
//--- X*A^-1 = (X1 X2)*( )
//--- ( A2')
RMatrixRightTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixGemm(m,s2,s1,-1.0,x,i2,j2,0,a,i1+s1,j1,OpType,1.0,x,i2,j2+s1);
RMatrixRightTrsM(m,s2,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
break;
}
}
}
//+------------------------------------------------------------------+
//| This subroutine calculates op(A^-1)*X where: |
//| * X is MxN general matrix |
//| * A is MxM upper/lower triangular/unitriangular matrix |
//|*"op" may be identity transformation, transposition |
//| Multiplication result replaces X. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| M - matrix size, N>=0 |
//| A - matrix, actial matrix is stored in |
//| A[I1:I1+M-1,J1:J1+M-1] |
//| I1 - submatrix offset |
//| J1 - submatrix offset |
//| IsUpper - whether matrix is upper triangular |
//| IsUnit - whether matrix is unitriangular |
//| OpType - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| X - matrix, actial matrix is stored in |
//| X[I2:I2+M-1,J2:J2+N-1] |
//| I2 - submatrix offset |
//| J2 - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::RMatrixLeftTrsM(const int m,const int n,CMatrixDouble &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixDouble &x,const int i2,const int j2)
{
//--- create variables
int s1=0;
int s2=0;
int bs=AblasBlockSize();
//--- check
if(m<=bs && n<=bs)
{
//--- basic algorithm
RMatrixLeftTrsM2(m,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
//--- exit the function
return;
}
//--- check
if(n>=m)
{
//--- Split X: op(A)^-1*X = op(A)^-1*(X1 X2)
AblasSplitLength(x,n,s1,s2);
RMatrixLeftTrsM(m,s1,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixLeftTrsM(m,s2,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2+s1);
}
else
{
//--- Split A
AblasSplitLength(a,m,s1,s2);
//--- check
if(IsUpper && OpType==0)
{
//--- (A1 A12)-1 ( X1 )
//--- A^-1*X* = ( ) *( )
//--- ( A2) ( X2 )
RMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
RMatrixGemm(s1,n,s2,-1.0,a,i1,j1+s1,0,x,i2+s1,j2,0,1.0,x,i2,j2);
RMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
//--- exit the function
return;
}
//--- check
if(IsUpper && OpType!=0)
{
//--- (A1' )-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- (A12' A2') ( X2 )
RMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixGemm(s2,n,s1,-1.0,a,i1,j1+s1,OpType,x,i2,j2,0,1.0,x,i2+s1,j2);
RMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
//--- exit the function
return;
}
//--- check
if(!IsUpper && OpType==0)
{
//--- (A1 )-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- (A21 A2) ( X2 )
RMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
RMatrixGemm(s2,n,s1,-1.0,a,i1+s1,j1,0,x,i2,j2,0,1.0,x,i2+s1,j2);
RMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
//--- exit the function
return;
}
//--- check
if(!IsUpper && OpType!=0)
{
//--- (A1' A21')-1 ( X1 )
//--- A^-1*X = ( ) *( )
//--- ( A2') ( X2 )
RMatrixLeftTrsM(s2,n,a,i1+s1,j1+s1,IsUpper,IsUnit,OpType,x,i2+s1,j2);
RMatrixGemm(s1,n,s2,-1.0,a,i1+s1,j1,OpType,x,i2+s1,j2,0,1.0,x,i2,j2);
RMatrixLeftTrsM(s1,n,a,i1,j1,IsUpper,IsUnit,OpType,x,i2,j2);
}
}
}
//+------------------------------------------------------------------+
//| This subroutine calculates C=alpha*A*A^H+beta*C or |
//| C=alpha*A^H*A+beta*C where: |
//| * C is NxN Hermitian matrix given by its upper/lower triangle |
//| * A is NxK matrix when A*A^H is calculated, KxN matrix otherwise |
//| Additional info: |
//| * multiplication result replaces C. If Beta=0, C elements are not|
//| used in calculations (not multiplied by zero - just not |
//| referenced) |
//| * if Alpha=0, A is not used (not multiplied by zero - just not |
//| referenced) |
//| * if both Beta and Alpha are zero, C is filled by zeros. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| K - matrix size, K>=0 |
//| Alpha - coefficient |
//| A - matrix |
//| IA - submatrix offset (row index) |
//| JA - submatrix offset (column index) |
//| OpTypeA - multiplication type: |
//| * 0 - A*A^H is calculated |
//| * 2 - A^H*A is calculated |
//| Beta - coefficient |
//| C - preallocated input/output matrix |
//| IC - submatrix offset (row index) |
//| JC - submatrix offset (column index) |
//| IsUpper - whether upper or lower triangle of C is updated; |
//| this function updates only one half of C, leaving |
//| other half unchanged (not referenced at all). |
//+------------------------------------------------------------------+
void CAblas::CMatrixHerk(int n,int k,complex alpha,
CMatrixComplex &a,int ia,int ja,
int OpTypea,complex beta,
CMatrixComplex &c,int ic,int jc,
bool IsUpper)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(n,k)<=tsb?tsa:tsb);
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
//--- ALGLIB basecase code
if(MathMax(n,k)<=tsa)
{
CMatrixHerk2(n,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
return;
}
//--- Recursive division of the problem
if(k>=n)
{
//--- Split K
CApServ::TiledSplit(k,tscur,s1,s2);
if(OpTypea==0)
{
CMatrixHerk(n,s1,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(n,s2,alpha,a,ia,ja+s1,OpTypea,1.0,c,ic,jc,IsUpper);
}
else
{
CMatrixHerk(n,s1,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(n,s2,alpha,a,ia+s1,ja,OpTypea,1.0,c,ic,jc,IsUpper);
}
}
else
{
//--- Split N
CApServ::TiledSplit(n,tscur,s1,s2);
switch(IsUpper)
{
case true:
if(OpTypea==0)
{
CMatrixHerk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(s2,k,alpha,a,ia+s1,ja,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
CMatrixGemm(s1,s2,k,alpha,a,ia,ja,0,a,ia+s1,ja,2,beta,c,ic,jc+s1);
}
else
{
CMatrixHerk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(s2,k,alpha,a,ia,ja+s1,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
CMatrixGemm(s1,s2,k,alpha,a,ia,ja,2,a,ia,ja+s1,0,beta,c,ic,jc+s1);
}
break;
case false:
if(OpTypea==0)
{
CMatrixHerk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(s2,k,alpha,a,ia+s1,ja,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
CMatrixGemm(s2,s1,k,alpha,a,ia+s1,ja,0,a,ia,ja,2,beta,c,ic+s1,jc);
}
else
{
CMatrixHerk(s1,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
CMatrixHerk(s2,k,alpha,a,ia,ja+s1,OpTypea,beta,c,ic+s1,jc+s1,IsUpper);
CMatrixGemm(s2,s1,k,alpha,a,ia,ja+s1,2,a,ia,ja,0,beta,c,ic+s1,jc);
}
break;
}
}
}
//+------------------------------------------------------------------+
//| This subroutine is an older version of CMatrixHERK(), one with |
//| wrong name (it is HErmitian update, not SYmmetric). It is left |
//| here for backward compatibility. |
//| |
//| This subroutine calculates C=alpha*A*A^H+beta*C or |
//| C=alpha*A^H*A+beta*C where: |
//| * C is NxN Hermitian matrix given by its upper/lower triangle |
//| * A is NxK matrix when A*A^H is calculated, KxN matrix otherwise |
//| Additional info: |
//| * cache-oblivious algorithm is used. |
//| * multiplication result replaces C. If Beta=0, C elements are not|
//| used in calculations (not multiplied by zero - just not |
//| referenced) |
//| * if Alpha=0, A is not used (not multiplied by zero - just not |
//| referenced) |
//| * if both Beta and Alpha are zero, C is filled by zeros. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=0 |
//| K - matrix size, K>=0 |
//| Alpha - coefficient |
//| A - matrix |
//| IA - submatrix offset |
//| JA - submatrix offset |
//| OpTypeA - multiplication type: |
//| * 0 - A*A^H is calculated |
//| * 2 - A^H*A is calculated |
//| Beta - coefficient |
//| C - matrix |
//| IC - submatrix offset |
//| JC - submatrix offset |
//| IsUpper - whether C is upper triangular or lower triangular|
//+------------------------------------------------------------------+
void CAblas::CMatrixSyrk(const int n,const int k,const double alpha,
CMatrixComplex &a,const int ia,const int ja,
const int OpTypea,const double beta,CMatrixComplex &c,
const int ic,const int jc,const bool IsUpper)
{
CMatrixHerk(n,k,alpha,a,ia,ja,OpTypea,beta,c,ic,jc,IsUpper);
//--- exit the function
return;
}
//+------------------------------------------------------------------+
//| Performs one step of stable Gram-Schmidt process on vector X[] |
//| using set of orthonormal rows Q[]. |
//| INPUT PARAMETERS: |
//| Q - array[M,N], matrix with orthonormal rows |
//| M, N - rows/cols |
//| X - array[N], vector to process |
//| NeedQX - whether we need QX or not |
//| OUTPUT PARAMETERS: |
//| X - stores X - Q'*(Q*X) |
//| QX - if NeedQX is True, array[M] filled with elements of|
//| Q*X, reallocated if length is less than M. |
//| Ignored otherwise. |
//| NOTE: this function silently exits when M=0, doing nothing |
//+------------------------------------------------------------------+
void CAblas::RowWiseGramSchmidt(CMatrixDouble &q,int m,int n,
CRowDouble &x,CRowDouble &qx,
bool needqx)
{
//--- check
if(m==0)
return;
//--- check
if(needqx)
CApServ::RVectorSetLengthAtLeast(qx,m);
for(int i=0; i<m; i++)
{
double v=CAblasF::RDotVR(n,x,q,i);
CAblasF::RAddRV(n,-v,q,i,x);
if(needqx)
qx.Set(i,v);
}
}
//+------------------------------------------------------------------+
//| This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:|
//| * C is MxN general matrix |
//| * op1(A) is MxK matrix |
//| * op2(B) is KxN matrix |
//|*"op" may be identity transformation, transposition, conjugate |
//| transposition |
//| Additional info: |
//| * cache-oblivious algorithm is used. |
//| * multiplication result replaces C. If Beta=0, C elements are not|
//| used in calculations (not multiplied by zero - just not |
//| referenced) |
//| * if Alpha=0, A is not used (not multiplied by zero - just not |
//| referenced) |
//| * if both Beta and Alpha are zero, C is filled by zeros. |
//| INPUT PARAMETERS: |
//| N - matrix size, N>0 |
//| M - matrix size, N>0 |
//| K - matrix size, K>0 |
//| Alpha - coefficient |
//| A - matrix |
//| IA - submatrix offset |
//| JA - submatrix offset |
//| OpTypeA - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| * 2 - conjugate transposition |
//| B - matrix |
//| IB - submatrix offset |
//| JB - submatrix offset |
//| OpTypeB - transformation type: |
//| * 0 - no transformation |
//| * 1 - transposition |
//| * 2 - conjugate transposition |
//| Beta - coefficient |
//| C - matrix |
//| IC - submatrix offset |
//| JC - submatrix offset |
//+------------------------------------------------------------------+
void CAblas::CMatrixGemm(const int m,const int n,const int k,complex &alpha,
CMatrixComplex &a,const int ia,const int ja,
const int OpTypea,CMatrixComplex &b,const int ib,
const int jb,const int OpTypeb,complex &beta,
CMatrixComplex &c,const int ic,const int jc)
{
//--- create variables
complex Beta(1,0);
int s1=0;
int s2=0;
int bs=AblasComplexBlockSize();
//--- Check input sizes for correctness
if(!CAp::Assert((OpTypea==0 || OpTypea==1) || OpTypea==2,__FUNCTION__+": incorrect OpTypeA (must be 0 or 1 or 2)"))
return;
if(!CAp::Assert((OpTypeb==0 || OpTypeb==1) || OpTypeb==2,__FUNCTION__+": incorrect OpTypeB (must be 0 or 1 or 2)"))
return;
if(!CAp::Assert(ic+m<=c.Rows(),__FUNCTION__+": incorect size of output matrix C"))
return;
if(!CAp::Assert(jc+n<=c.Cols(),__FUNCTION__+": incorect size of output matrix C"))
return;
//--- Start actual work
CMatrixGemmRec(m,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
}
//+------------------------------------------------------------------+
//| Level 2 variant of CMatrixRightTRSM |
//+------------------------------------------------------------------+
void CAblas::CMatrixRightTrsM2(const int m,const int n,CMatrixComplex &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixComplex &x,const int i2,const int j2)
{
//--- check
if(n*m==0)
return;
//--- create variables
int i=0;
int j=0;
complex vc=0;
complex vd=0;
int i_=0;
int i1_=0;
//--- General case
if(IsUpper)
{
//--- Upper triangular matrix
switch(OpType)
{
case 0:
//--- X*A^(-1)
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(IsUnit)
vd=1;
else
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,x.Get(i2+i,j2+j)/vd);
//--- check
if(j<n-1)
{
vc=x.Get(i2+i,j2+j);
i1_=j1-j2;
for(i_=j2+j+1; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vc*a.Get(i1+j,i_+i1_));
}
}
}
break;
case 1:
//--- X*A^(-T)
for(i=0; i<m; i++)
{
for(j=n-1; j>=0; j--)
{
vc=0;
vd=1;
//--- check
if(j<n-1)
{
i1_=j1-j2;
vc=0.0;
for(i_=j2+j+1; i_<j2+n; i_++)
vc+=x.Get(i2+i,i_)*a.Get(i1+j,i_+i1_);
}
//--- check
if(!IsUnit)
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vc)/vd);
}
}
break;
case 2:
//--- X*A^(-H)
for(i=0; i<m; i++)
{
for(j=n-1; j>=0; j--)
{
vc=0;
vd=1;
//--- check
if(j<n-1)
{
i1_=j1-j2;
vc=0.0;
for(i_=j2+j+1; i_<j2+n; i_++)
vc+=x.Get(i2+i,i_)*CMath::Conj(a.Get(i1+j,i_+i1_));
}
//--- check
if(!IsUnit)
vd=CMath::Conj(a.Get(i1+j,j1+j));
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vc)/vd);
}
}
break;
}
}
else
{
//--- Lower triangular matrix
switch(OpType)
{
case 0:
//--- X*A^(-1)
for(i=0; i<m; i++)
{
for(j=n-1; j>=0; j--)
{
//--- check
if(IsUnit)
vd=1;
else
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,x.Get(i2+i,j2+j)/vd);
//--- check
if(j>0)
{
vc=x.Get(i2+i,j2+j);
i1_=j1-j2;
for(i_=j2; i_<j2+j; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vc*a.Get(i1+j,i_+i1_));
}
}
}
break;
case 1:
//--- X*A^(-T)
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
vc=0;
vd=1;
//--- check
if(j>0)
{
i1_=j1-j2;
vc=0.0;
for(i_=j2; i_<j2+j; i_++)
vc+=x.Get(i2+i,i_)*a.Get(i1+j,i_+i1_);
}
//--- check
if(!IsUnit)
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vc)/vd);
}
}
break;
case 2:
//--- X*A^(-H)
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
vc=0;
vd=1;
//--- check
if(j>0)
{
i1_=j1-j2;
vc=0.0;
for(i_=j2; i_<j2+j; i_++)
vc+=x.Get(i2+i,i_)*CMath::Conj(a.Get(i1+j,i_+i1_));
}
//--- check
if(!IsUnit)
vd=CMath::Conj(a.Get(i1+j,j1+j));
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vc)/vd);
}
}
break;
}
}
}
//+------------------------------------------------------------------+
//| Level-2 subroutine |
//+------------------------------------------------------------------+
void CAblas::CMatrixLeftTrsM2(const int m,const int n,CMatrixComplex &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixComplex &x,const int i2,const int j2)
{
//--- check
if(n*m==0)
return;
//--- create variables
int i=0;
int j=0;
complex vc=0;
complex vd=0;
int i_=0;
//--- General case
if(IsUpper)
{
//--- Upper triangular matrix
switch(OpType)
{
case 0:
//--- A^(-1)*X
for(i=m-1; i>=0; i--)
{
for(j=i+1; j<=m-1; j++)
{
vc=a.Get(i1+i,j1+j);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vc*x.Get(i2+j,i_));
}
//--- check
if(!IsUnit)
{
vd=1/a.Get(i1+i,j1+i);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
}
}
break;
case 1:
//--- A^(-T)*X
for(i=0; i<m; i++)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+i,j1+i);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i+1; j<=m-1; j++)
{
vc=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vc*x.Get(i2+i,i_));
}
}
break;
case 2:
//--- A^(-H)*X
for(i=0; i<m; i++)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/CMath::Conj(a.Get(i1+i,j1+i));
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i+1; j<=m-1; j++)
{
vc=CMath::Conj(a.Get(i1+i,j1+j));
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vc*x.Get(i2+i,i_));
}
}
break;
}
}
else
{
//--- Lower triangular matrix
switch(OpType)
{
case 0:
//--- A^(-1)*X
for(i=0; i<m; i++)
{
//--- change x
for(j=0; j<i; j++)
{
vc=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vc*x.Get(i2+j,i_));
}
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+j,j1+j);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
}
break;
case 1:
//--- A^(-T)*X
for(i=m-1; i>=0; i--)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+i,j1+i);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i-1; j>=0; j--)
{
vc=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vc*x.Get(i2+i,i_));
}
}
break;
case 2:
//--- A^(-H)*X
for(i=m-1; i>=0; i--)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/CMath::Conj(a.Get(i1+i,j1+i));
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i-1; j>=0; j--)
{
vc=CMath::Conj(a.Get(i1+i,j1+j));
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vc*x.Get(i2+i,i_));
}
}
break;
}
}
}
//+------------------------------------------------------------------+
//| Level 2 subroutine |
//+------------------------------------------------------------------+
void CAblas::RMatrixRightTrsM2(const int m,const int n,CMatrixDouble &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixDouble &x,const int i2,const int j2)
{
//--- check
if(n*m==0)
return;
//--- create variables
int i=0;
int j=0;
double vr=0;
double vd=0;
int i_=0;
int i1_=0;
//--- check
if(IsUpper)
{
//--- Upper triangular matrix
switch(OpType)
{
case 0:
//--- X*A^(-1)
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(IsUnit)
vd=1;
else
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,x.Get(i2+i,j2+j)/vd);
//--- check
if(j<n-1)
{
vr=x.Get(i2+i,j2+j);
i1_=j1-j2;
//--- change x
for(i_=j2+j+1; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vr*a.Get(i1+j,i_+i1_));
}
}
}
break;
case 1:
//--- X*A^(-T)
for(i=0; i<m; i++)
{
for(j=n-1; j>=0; j--)
{
vr=0;
vd=1;
//--- check
if(j<n-1)
{
i1_=j1-j2;
vr=0.0;
for(i_=j2+j+1; i_<j2+n; i_++)
vr+=x.Get(i2+i,i_)*a.Get(i1+j,i_+i1_);
}
//--- check
if(!IsUnit)
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vr)/vd);
}
}
break;
}
}
else
{
//--- Lower triangular matrix
switch(OpType)
{
case 0:
//--- X*A^(-1)
for(i=0; i<m; i++)
{
for(j=n-1; j>=0; j--)
{
//--- check
if(IsUnit)
vd=1;
else
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,x.Get(i2+i,j2+j)/vd);
//--- check
if(j>0)
{
vr=x.Get(i2+i,j2+j);
i1_=j1-j2;
//--- change x
for(i_=j2; i_<j2+j; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vr*a.Get(i1+j,i_+i1_));
}
}
}
break;
case 1:
//--- X*A^(-T)
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
vr=0;
vd=1;
//--- check
if(j>0)
{
i1_=j1-j2;
vr=0.0;
for(i_=j2; i_<j2+j; i_++)
vr+=x.Get(i2+i,i_)*a.Get(i1+j,i_+i1_);
}
//--- check
if(!IsUnit)
vd=a.Get(i1+j,j1+j);
//--- change x
x.Set(i2+i,j2+j,(x.Get(i2+i,j2+j)-vr)/vd);
}
}
break;
}
}
}
//+------------------------------------------------------------------+
//| Level 2 subroutine |
//+------------------------------------------------------------------+
void CAblas::RMatrixLeftTrsM2(const int m,const int n,CMatrixDouble &a,
const int i1,const int j1,const bool IsUpper,
const bool IsUnit,const int OpType,
CMatrixDouble &x,const int i2,const int j2)
{
//--- check
if(n*m==0)
return;
//--- create variables
int i=0;
int j=0;
double vr=0;
double vd=0;
int i_=0;
//--- check
if(IsUpper)
{
//--- Upper triangular matrix
switch(OpType)
{
case 0:
//--- A^(-1)*X
for(i=m-1; i>=0; i--)
{
for(j=i+1; j<m; j++)
{
vr=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vr*x.Get(i2+j,i_));
}
//--- check
if(!IsUnit)
{
vd=1/a.Get(i1+i,j1+i);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
}
}
break;
case 1:
//--- A^(-T)*X
for(i=0; i<m; i++)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+i,j1+i);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i+1; j<m; j++)
{
vr=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vr*x.Get(i2+i,i_));
}
}
break;
}
}
else
{
//--- Lower triangular matrix
switch(OpType)
{
case 0:
//--- A^(-1)*X
for(i=0; i<m; i++)
{
for(j=0; j<i; j++)
{
vr=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,x.Get(i2+i,i_)-vr*x.Get(i2+j,i_));
}
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+j,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
}
break;
case 1:
//--- A^(-T)*X
for(i=m-1; i>=0; i--)
{
//--- check
if(IsUnit)
vd=1;
else
vd=1/a.Get(i1+i,j1+i);
//--- change x
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+i,i_,vd*x.Get(i2+i,i_));
for(j=i-1; j>=0; j--)
{
vr=a.Get(i1+i,j1+j);
for(i_=j2; i_<j2+n; i_++)
x.Set(i2+j,i_,x.Get(i2+j,i_)-vr*x.Get(i2+i,i_));
}
}
break;
}
}
}
//+------------------------------------------------------------------+
//| Level 2 subroutine |
//+------------------------------------------------------------------+
void CAblas::CMatrixHerk2(int n,int k,complex alpha,
CMatrixComplex &a,int ia,int ja,
int OpTypea,complex beta,
CMatrixComplex &c,int ic,int jc,
bool IsUpper)
{
//--- Fast exit (nothing to be done)
if(((double)(alpha)==0.0 || k==0) && (double)(beta)==(double)(1))
return;
//--- create variables
int i=0;
int j=0;
int j1=0;
int j2=0;
complex v=0;
int i_=0;
int i1_=0;
//--- SYRK
if(OpTypea==0)
{
//--- C=alpha*A*A^H+beta*C
for(i=0; i<n; i++)
{
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
for(j=j1; j<=j2; j++)
{
if((double)(alpha)!=0.0 && k>0)
{
v=0.0;
for(i_=ja; i_<ja+k; i_++)
v+=a.Get(ia+i,i_)*CMath::Conj((complex)a.Get(ia+j,i_));
}
else
v=0;
if((double)(beta)==0.0)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,(beta*c.Get(ic+i,jc+j)+alpha*v));
}
}
}
else
{
//--- C=alpha*A^H*A+beta*C
for(i=0; i<n; i++)
{
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
if((double)(beta)==0.0)
{
for(j=j1; j<=j2; j++)
c.Set(ic+i,jc+j,0.0);
}
else
{
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Set(ic+i,i_,(beta*c.Get(ic+i,i_)));
}
}
if((double)(alpha)!=0.0 && k>0)
{
for(i=0; i<k; i++)
{
for(j=0; j<n; j++)
{
if(IsUpper)
{
j1=j;
j2=n-1;
}
else
{
j1=0;
j2=j;
}
v=alpha*CMath::Conj((complex)a.Get(ia+i,ja+j));
i1_=(ja+j1)-(jc+j1);
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Set(ic+j,i_,(c.Get(ic+j,i_)+v*a.Get(ia+i,i_+i1_)));
}
}
}
}
}
//+------------------------------------------------------------------+
//| Level 2 subroutine |
//+------------------------------------------------------------------+
void CAblas::CMatrixSyrk2(const int n,const int k,const complex alpha,
const CMatrixComplex &a,const int ia,const int ja,
const int OpTypea,const complex beta,CMatrixComplex &c,
const int ic,const int jc,const bool IsUpper)
{
//--- check
if((alpha==0 || k==0) && beta==1)
return;
//--- create variables
complex Zero(0,0);
int i=0;
int j=0;
int j1=0;
int j2=0;
complex v=0;
int i_=0;
int i1_=0;
//--- check
if(OpTypea==0)
{
//--- C = alpha*A*A^H+beta*C
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
//--- cycle
for(j=j1; j<=j2; j++)
{
//--- check
if(alpha!=0 && k>0)
{
v=0.0;
for(i_=ja; i_<=ja+k-1; i_++)
v+=a.Get(ia+i,i_)*CMath::Conj(a.Get(ia+j,i_));
}
else
v=0;
//--- check
if(beta==0)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
//--- exit the function
return;
}
else
{
//--- C = alpha*A^H*A+beta*C
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
//--- check
if(beta==0)
{
for(j=j1; j<=j2; j++)
c.Set(ic+i,jc+j,Zero);
}
else
{
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Set(ic+i,i_,beta*c.Get(ic+i,i_));
}
}
//--- cycle
for(i=0; i<k; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(IsUpper)
{
j1=j;
j2=n-1;
}
else
{
j1=0;
j2=j;
}
v=alpha*CMath::Conj(a.Get(ia+i,ja+j));
i1_=(ja+j1)-(jc+j1);
for(i_=jc+j1; i_<=jc+j2; i_++)
c.Set(ic+j,i_,c.Get(ic+j,i_)+v*a.Get(ia+i,i_+i1_));
}
}
}
}
//+------------------------------------------------------------------+
//| GEMM kernel |
//+------------------------------------------------------------------+
void CAblas::CMatrixGemmk(const int m,const int n,const int k,complex &alpha,
const CMatrixComplex &a,const int ia,const int ja,
const int OpTypea,const CMatrixComplex &b,const int ib,
const int jb,const int OpTypeb,complex &beta,
CMatrixComplex &c,const int ic,const int jc)
{
//--- check
if(m*n==0)
return;
//--- create variables
complex Zero(0,0);
int i=0;
int j=0;
complex v=0;
int i_=0;
int i1_=0;
//--- special case
if(k==0)
{
//--- check
if(beta!=Zero)
{
//--- get c
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j));
}
else
{
//--- get c
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,Zero);
}
//--- exit the function
return;
}
//--- General case
if(OpTypea==0)
{
if(OpTypeb==0)
{
//--- A*B
for(i=0; i<m; i++)
{
//--- check
if(beta!=Zero)
{
for(i_=jc; i_<=jc+n-1; i_++)
c.Set(ic+i,i_,beta*c.Get(ic+i,i_));
}
else
{
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,Zero);
}
//--- check
if(alpha!=Zero)
{
for(j=0; j<=k-1; j++)
{
v=alpha*a.Get(ia+i,ja+j);
i1_=(jb)-(jc);
for(i_=jc; i_<=jc+n-1; i_++)
c.Set(ic+i,i_,c.Get(ic+i,i_)+v*b.Get(ib+j,i_+i1_));
}
}
}
}
else
{
//--- A*B'
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(k==0 || alpha==Zero)
v=0;
else
{
//--- check
if(OpTypeb==1)
{
i1_=(jb)-(ja);
v=0.0;
for(i_=ja; i_<=ja+k-1; i_++)
v+=a.Get(ia+i,i_)*b.Get(ib+j,i_+i1_);
}
else
{
i1_=(jb)-(ja);
v=0.0;
for(i_=ja; i_<=ja+k-1; i_++)
v+=a.Get(ia+i,i_)*CMath::Conj(b.Get(ib+j,i_+i1_));
}
}
//--- check
if(beta==Zero)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
}
}
else
{
//--- check
if(OpTypeb==0)
{
//--- A'*B
if(beta==Zero)
{
for(i=0; i<m; i++)
for(j=0; j<n; j++)
c.Set(ic+i,jc+j,Zero);
}
else
{
for(i=0; i<m; i++)
for(i_=jc; i_<=jc+n-1; i_++)
c.Set(ic+i,i_,beta*c.Get(ic+i,i_));
}
//--- check
if(alpha!=Zero)
{
for(j=0; j<=k-1; j++)
for(i=0; i<m; i++)
{
//--- check
if(OpTypea==1)
v=alpha*a.Get(ia+j,ja+i);
else
v=alpha*CMath::Conj(a.Get(ia+j,ja+i));
i1_=(jb)-(jc);
for(i_=jc; i_<=jc+n-1; i_++)
c.Set(ic+i,i_,c.Get(ic+i,i_)+v*b.Get(ib+j,i_+i1_));
}
}
}
else
{
//--- A'*B'
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
{
//--- check
if(alpha==Zero)
v=0;
else
{
//--- check
if(OpTypea==1)
{
//--- check
if(OpTypeb==1)
{
i1_=(jb)-(ia);
v=0.0;
for(i_=ia; i_<=ia+k-1; i_++)
v+=a.Get(i_,ja+i)*b.Get(ib+j,i_+i1_);
}
else
{
i1_=(jb)-(ia);
v=0.0;
for(i_=ia; i_<=ia+k-1; i_++)
v+=a.Get(i_,ja+i)*CMath::Conj(b.Get(ib+j,i_+i1_));
}
}
else
{
//--- check
if(OpTypeb==1)
{
i1_=(jb)-(ia);
v=0.0;
for(i_=ia; i_<=ia+k-1; i_++)
v+=CMath::Conj(a.Get(i_,ja+i))*b.Get(ib+j,i_+i1_);
}
else
{
i1_=(jb)-(ia);
v=0.0;
for(i_=ia; i_<=ia+k-1; i_++)
v+=CMath::Conj(a.Get(i_,ja+i))*CMath::Conj(b.Get(ib+j,i_+i1_));
}
}
}
//--- check
if(beta==Zero)
c.Set(ic+i,jc+j,alpha*v);
else
c.Set(ic+i,jc+j,beta*c.Get(ic+i,jc+j)+alpha*v);
}
}
}
}
}
//+------------------------------------------------------------------+
//| This subroutine is an actual implementation of CMatrixGEMM. It |
//| does not perform some integrity checks performed in the driver |
//| function, and it does not activate multithreading framework |
//| (driver decides whether to activate workers or not). |
//+------------------------------------------------------------------+
void CAblas::CMatrixGemmRec(int m,int n,int k,complex alpha,
CMatrixComplex &a,int ia,int ja,
int OpTypea,CMatrixComplex &b,
int ib,int jb,int OpTypeb,
complex beta,CMatrixComplex &c,
int ic,int jc)
{
//--- create variables
int s1=0;
int s2=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=(MathMax(m,MathMax(n,k))<=tsb?tsa:tsb);
//--- check
if(!CAp::Assert(tscur>=1,__FUNCTION__+": integrity check failed"))
return;
if(MathMax(m,MathMax(n,k))<=tsa)
{
CAblasF::CMatrixGemmK(m,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
return;
}
//--- Recursive algorithm: parallel splitting on M/N
if(m>=n && m>=k)
{
//--- A*B = (A1 A2)^T*B
CApServ::TiledSplit(m,tscur,s1,s2);
CMatrixGemmRec(s1,n,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
if(OpTypea==0)
CMatrixGemmRec(s2,n,k,alpha,a,ia+s1,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic+s1,jc);
else
CMatrixGemmRec(s2,n,k,alpha,a,ia,ja+s1,OpTypea,b,ib,jb,OpTypeb,beta,c,ic+s1,jc);
return;
}
if(n>=m && n>=k)
{
//--- A*B = A*(B1 B2)
CApServ::TiledSplit(n,tscur,s1,s2);
if(OpTypeb==0)
{
CMatrixGemmRec(m,s1,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,s2,k,alpha,a,ia,ja,OpTypea,b,ib,jb+s1,OpTypeb,beta,c,ic,jc+s1);
}
else
{
CMatrixGemmRec(m,s1,k,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,s2,k,alpha,a,ia,ja,OpTypea,b,ib+s1,jb,OpTypeb,beta,c,ic,jc+s1);
}
return;
}
//--- Recursive algorithm: serial splitting on K
//--- A*B = (A1 A2)*(B1 B2)^T
CApServ::TiledSplit(k,tscur,s1,s2);
switch(OpTypea)
{
case 0:
if(OpTypeb==0)
{
CMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,n,s2,alpha,a,ia,ja+s1,OpTypea,b,ib+s1,jb,OpTypeb,1.0,c,ic,jc);
}
else
{
CMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,n,s2,alpha,a,ia,ja+s1,OpTypea,b,ib,jb+s1,OpTypeb,1.0,c,ic,jc);
}
break;
default:
if(OpTypeb==0)
{
CMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,n,s2,alpha,a,ia+s1,ja,OpTypea,b,ib+s1,jb,OpTypeb,1.0,c,ic,jc);
}
else
{
CMatrixGemmRec(m,n,s1,alpha,a,ia,ja,OpTypea,b,ib,jb,OpTypeb,beta,c,ic,jc);
CMatrixGemmRec(m,n,s2,alpha,a,ia+s1,ja,OpTypea,b,ib,jb+s1,OpTypeb,1.0,c,ic,jc);
}
break;
}
}
//+------------------------------------------------------------------+
//| Generation of an elementary reflection transformation |
//| The subroutine generates elementary reflection H of order N, so |
//| that, for a given X, the following equality holds true: |
//| |
//| ( X(1) ) ( Beta ) |
//| H * ( .. ) = ( 0 ) |
//| ( X(n) ) ( 0 ) |
//| where |
//| ( V(1) ) |
//| H = 1 - Tau * ( .. ) * ( V(1), ..., V(n) ) |
//| ( V(n) ) |
//| where the first component of vector V equals 1. |
//| Input parameters: |
//| X - vector. Array whose index ranges within [1..N]. |
//| N - reflection order. |
//| Output parameters: |
//| X - components from 2 to N are replaced with vector V. The |
//| first component is replaced with parameter Beta. |
//| Tau - scalar value Tau. If X is a null vector, Tau equals 0, |
//| otherwise 1 <= Tau <= 2. |
//| This subroutine is the modification of the DLARFG subroutines |
//| from the LAPACK library. |
//| MODIFICATIONS: |
//| 24.12.2005 sign(Alpha) was replaced with an analogous to the |
//| Fortran SIGN code. |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University |
//| September 30, 1994 |
//+------------------------------------------------------------------+
void CAblas::GenerateReflection(CRowDouble &x,
int n,
double &tau)
{
//--- create variables
int j=0;
double alpha=0;
double xnorm=0;
double v=0;
double beta=0;
double mx=0;
double s=0;
int i_=0;
tau=0;
//--- check
if(n<=1)
{
tau=0;
return;
}
//--- check
if(!CAp::Assert((int)x.Size()>n,__FUNCTION__+":N more then size of vector X"))
return;
//--- Scale if needed (to avoid overflow/underflow during
//--- intermediate calculations).
mx=0;
for(j=1; j<=n; j++)
mx=MathMax(MathAbs(x[j]),mx);
s=1;
if(mx!=0.0)
{
if(mx<=CMath::m_minrealnumber/CMath::m_machineepsilon)
{
s=CMath::m_minrealnumber/CMath::m_machineepsilon;
v=1/s;
for(i_=1; i_<=n; i_++)
x.Mul(i_,v);
mx*=v;
}
else
{
if(mx>=CMath::m_maxrealnumber*CMath::m_machineepsilon)
{
s=CMath::m_maxrealnumber*CMath::m_machineepsilon;
v=1/s;
for(i_=1; i_<=n; i_++)
x.Mul(i_,v);
mx*=v;
}
}
}
//--- XNORM = DNRM2( N-1, X, INCX )
alpha=x[1];
xnorm=0;
if(mx!=0.0)
{
for(j=2; j<=n; j++)
xnorm+=CMath::Sqr(x[j]/mx);
xnorm=MathSqrt(xnorm)*mx;
}
if(xnorm==0.0)
{
//--- H = I
tau=0;
x.Mul(1,s);
return;
}
//--- general case
mx=MathMax(MathAbs(alpha),MathAbs(xnorm));
beta=-(mx*MathSqrt(CMath::Sqr(alpha/mx)+CMath::Sqr(xnorm/mx)));
if(alpha<0.0)
beta=-beta;
tau=(beta-alpha)/beta;
v=1/(alpha-beta);
for(i_=2; i_<=n; i_++)
x.Mul(i_,v);
x.Set(1,beta);
//--- Scale back outputs
x.Mul(1,s);
}
//+------------------------------------------------------------------+
//| Application of an elementary reflection to a rectangular matrix |
//| of size MxN |
//| The algorithm pre-multiplies the matrix by an elementary |
//| reflection transformation which is given by column V and scalar |
//| Tau (see the description of the GenerateReflection procedure). |
//| Not the whole matrix but only a part of it is transformed (rows |
//| from M1 to M2, columns from N1 to N2). Only the elements of this |
//| submatrix are changed. |
//| Input parameters: |
//| C - matrix to be transformed. |
//| Tau - scalar defining the transformation. |
//| V - column defining the transformation. Array whose index |
//| ranges within [1..M2-M1+1]. |
//| M1, M2 - range of rows to be transformed. |
//| N1, N2 - range of columns to be transformed. |
//| WORK - working array whose indexes goes from N1 to N2. |
//| Output parameters: |
//| C - the result of multiplying the input matrix C by the |
//| transformation matrix which is given by Tau and V. |
//| If N1>N2 or M1>M2, C is not modified. |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University |
//| September 30, 1994 |
//+------------------------------------------------------------------+
void CAblas::ApplyReflectionFromTheLeft(CMatrixDouble &c,
double tau,
CRowDouble &v,
int m1,
int m2,
int n1,
int n2,
CRowDouble &work)
{
//--- check
if(((double)(tau)==0.0 || n1>n2) || m1>m2)
return;
CApServ::RVectorSetLengthAtLeast(work,n2-n1+1);
RMatrixGemVect(n2-n1+1,m2-m1+1,1.0,c,m1,n1,1,v,1,0.0,work,0);
RMatrixGer(m2-m1+1,n2-n1+1,c,m1,n1,-tau,v,1,work,0);
}
//+------------------------------------------------------------------+
//| Application of an elementary reflection to a rectangular matrix |
//| of size MxN |
//| The algorithm post-multiplies the matrix by an elementary |
//| reflection transformation which is given by column V and scalar |
//| Tau (see the description of the GenerateReflection procedure). |
//| Not the whole matrix but only a part of it is transformed (rows |
//| from M1 to M2, columns from N1 to N2). Only the elements of this |
//| submatrix are changed. |
//| Input parameters: |
//| C - matrix to be transformed. |
//| Tau - scalar defining the transformation. |
//| V - column defining the transformation. Array whose index |
//| ranges within [1..N2-N1+1]. |
//| M1, M2 - range of rows to be transformed. |
//| N1, N2 - range of columns to be transformed. |
//| WORK - working array whose indexes goes from M1 to M2. |
//| Output parameters: |
//| C - the result of multiplying the input matrix C by the |
//| transformation matrix which is given by Tau and V. |
//| If N1>N2 or M1>M2, C is not modified. |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University |
//| September 30, 1994 |
//+------------------------------------------------------------------+
void CAblas::ApplyReflectionFromTheRight(CMatrixDouble &c,
double tau,
CRowDouble &v,
int m1,
int m2,
int n1,
int n2,
CRowDouble &work)
{
//--- check
if(((double)(tau)==0.0 || n1>n2) || m1>m2)
return;
CApServ::RVectorSetLengthAtLeast(work,m2-m1+1);
RMatrixGemVect(m2-m1+1,n2-n1+1,1.0,c,m1,n1,0,v,1,0.0,work,0);
RMatrixGer(m2-m1+1,n2-n1+1,c,m1,n1,-tau,work,0,v,1);
}
//+------------------------------------------------------------------+
//| Orthogonal factorizations |
//+------------------------------------------------------------------+
class COrtFac
{
public:
//--- real matrix
static void RMatrixQR(CMatrixDouble &a,const int m,const int n,double &tau[]);
static void RMatrixQR(CMatrixDouble &a,const int m,const int n,CRowDouble &tau);
static void RMatrixLQ(CMatrixDouble &a,const int m,const int n,double &tau[]);
static void RMatrixLQ(CMatrixDouble &a,const int m,const int n,CRowDouble &tau);
static void RMatrixQRUnpackQ(CMatrixDouble &a,const int m,const int n,double &tau[],const int qcolumns,CMatrixDouble &q);
static void RMatrixQRUnpackQ(CMatrixDouble &a,const int m,const int n,CRowDouble &tau,const int qcolumns,CMatrixDouble &q);
static void RMatrixQRUnpackR(CMatrixDouble &a,const int m,const int n,CMatrixDouble &r);
static void RMatrixLQUnpackQ(CMatrixDouble &a,const int m,const int n,double &tau[],const int qrows,CMatrixDouble &q);
static void RMatrixLQUnpackQ(CMatrixDouble &a,const int m,const int n,CRowDouble &tau,const int qrows,CMatrixDouble &q);
static void RMatrixLQUnpackL(CMatrixDouble &a,const int m,const int n,CMatrixDouble &l);
static void RMatrixQRBaseCase(CMatrixDouble &a,const int m,const int n,CRowDouble &work,CRowDouble &t,CRowDouble &tau);
static void RMatrixLQBaseCase(CMatrixDouble &a,const int m,const int n,CRowDouble &work,CRowDouble&t,CRowDouble &tau);
static void RMatrixBD(CMatrixDouble &a,const int m,const int n,double &tauq[],double &taup[]);
static void RMatrixBD(CMatrixDouble &a,const int m,const int n,CRowDouble &tauq,CRowDouble &taup);
static void RMatrixBDUnpackQ(CMatrixDouble &qp,const int m,const int n,double &tauq[],const int qcolumns,CMatrixDouble &q);
static void RMatrixBDUnpackQ(CMatrixDouble &qp,const int m,const int n,CRowDouble &tauq,const int qcolumns,CMatrixDouble &q);
static void RMatrixBDMultiplyByQ(CMatrixDouble &qp,const int m,const int n,double &tauq[],CMatrixDouble &z,const int zrows,const int zcolumns,const bool fromtheright,const bool dotranspose);
static void RMatrixBDMultiplyByQ(CMatrixDouble &qp,const int m,const int n,CRowDouble &tauq,CMatrixDouble &z,const int zrows,const int zcolumns,const bool fromtheright,const bool dotranspose);
static void RMatrixBDUnpackPT(CMatrixDouble &qp,const int m,const int n,double &taup[],const int ptrows,CMatrixDouble &pt);
static void RMatrixBDUnpackPT(CMatrixDouble &qp,const int m,const int n,CRowDouble &taup,const int ptrows,CMatrixDouble &pt);
static void RMatrixBDMultiplyByP(CMatrixDouble &qp,const int m,const int n,double &taup[],CMatrixDouble &z,const int zrows,const int zcolumns,const bool fromtheright,const bool dotranspose);
static void RMatrixBDMultiplyByP(CMatrixDouble &qp,const int m,const int n,CRowDouble &taup,CMatrixDouble &z,const int zrows,const int zcolumns,const bool fromtheright,const bool dotranspose);
static void RMatrixBDUnpackDiagonals(CMatrixDouble &b,const int m,const int n,bool &IsUpper,double &d[],double &e[]);
static void RMatrixBDUnpackDiagonals(CMatrixDouble &b,const int m,const int n,bool &IsUpper,CRowDouble &d,CRowDouble &e);
static void RMatrixHessenberg(CMatrixDouble &a,const int n,double &tau[]);
static void RMatrixHessenberg(CMatrixDouble &a,const int n,CRowDouble &tau);
static void RMatrixHessenbergUnpackQ(CMatrixDouble &a,const int n,double &tau[],CMatrixDouble &q);
static void RMatrixHessenbergUnpackQ(CMatrixDouble &a,const int n,CRowDouble &tau,CMatrixDouble &q);
static void RMatrixHessenbergUnpackH(CMatrixDouble &a,const int n,CMatrixDouble &h);
static void SMatrixTD(CMatrixDouble &a,const int n,const bool IsUpper,double &tau[],double &d[],double &e[]);
static void SMatrixTD(CMatrixDouble &a,const int n,const bool IsUpper,CRowDouble &tau,CRowDouble &d,CRowDouble &e);
static void SMatrixTDUnpackQ(CMatrixDouble &a,const int n,const bool IsUpper,double &tau[],CMatrixDouble &q);
static void SMatrixTDUnpackQ(CMatrixDouble &a,const int n,const bool IsUpper,CRowDouble &tau,CMatrixDouble &q);
//--- complex matrix
static void CMatrixQR(CMatrixComplex &a,const int m,const int n,complex &tau[]);
static void CMatrixQR(CMatrixComplex &a,const int m,const int n,CRowComplex &tau);
static void CMatrixLQ(CMatrixComplex &a,const int m,const int n,complex &tau[]);
static void CMatrixLQ(CMatrixComplex &a,const int m,const int n,CRowComplex &tau);
static void CMatrixQRUnpackQ(CMatrixComplex &a,const int m,const int n,complex &tau[],const int qcolumns,CMatrixComplex &q);
static void CMatrixQRUnpackQ(CMatrixComplex &a,const int m,const int n,CRowComplex &tau,const int qcolumns,CMatrixComplex &q);
static void CMatrixQRUnpackR(CMatrixComplex &a,const int m,const int n,CMatrixComplex &r);
static void CMatrixLQUnpackQ(CMatrixComplex &a,const int m,const int n,complex &tau[],const int qrows,CMatrixComplex &q);
static void CMatrixLQUnpackQ(CMatrixComplex &a,const int m,const int n,CRowComplex &tau,const int qrows,CMatrixComplex &q);
static void CMatrixLQUnpackL(CMatrixComplex &a,const int m,const int n,CMatrixComplex &l);
static void HMatrixTD(CMatrixComplex &a,const int n,const bool IsUpper,complex &tau[],double &d[],double &e[]);
static void HMatrixTD(CMatrixComplex &a,const int n,const bool IsUpper,CRowComplex &tau,CRowDouble &d,CRowDouble &e);
static void HMatrixTDUnpackQ(CMatrixComplex &a,const int n,const bool IsUpper,complex &tau[],CMatrixComplex &q);
static void HMatrixTDUnpackQ(CMatrixComplex &a,const int n,const bool IsUpper,CRowComplex &tau,CMatrixComplex &q);
private:
static void CMatrixQRBaseCase(CMatrixComplex &a,const int m,const int n,CRowComplex &work,CRowComplex &t,CRowComplex &tau);
static void CMatrixLQBaseCase(CMatrixComplex &a,const int m,const int n,CRowComplex &work,CRowComplex &t,CRowComplex &tau);
static void RMatrixBlockReflector(CMatrixDouble &a,CRowDouble&tau,const bool columnwisea,const int lengtha,const int blocksize,CMatrixDouble &t,CRowDouble &work);
static void CMatrixBlockReflector(CMatrixComplex &a,CRowComplex &tau,const bool columnwisea,const int lengtha,const int blocksize,CMatrixComplex &t,CRowComplex &work);
};
//+------------------------------------------------------------------+
//| QR decomposition of a rectangular matrix of size MxN |
//| Input parameters: |
//| A - matrix A whose indexes range within [0..M-1, 0..N-1].|
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| Output parameters: |
//| A - matrices Q and R in compact form (see below). |
//| Tau - array of scalar factors which are used to form |
//| matrix Q. Array whose index ranges within |
//| [0.. Min(M-1,N-1)]. |
//| Matrix A is represented as A = QR, where Q is an orthogonal |
//| matrix of size MxM, R - upper triangular (or upper trapezoid) |
//| matrix of size M x N. |
//| The elements of matrix R are located on and above the main |
//| diagonal of matrix A. The elements which are located in Tau |
//| array and below the main diagonal of matrix A are used to form |
//| matrix Q as follows: |
//| Matrix Q is represented as a product of elementary reflections |
//| Q = H(0)*H(2)*...*H(k-1), |
//| where k = min(m,n), and each H(i) is in the form |
//| H(i) = 1 - tau * v * (v^T) |
//| where tau is a scalar stored in Tau[I]; v - real vector, |
//| so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in |
//| A(i+1:m-1,i). |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQR(CMatrixDouble &a,const int m,const int n,double &tau[])
{
CRowDouble Tau=tau;
RMatrixQR(a,m,n,Tau);
Tau.ToArray(tau);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQR(CMatrixDouble &a,const int m,const int n,CRowDouble &tau)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int minmn=MathMin(m,n);
int blockstart=0;
int blocksize=0;
int rowscount=0;
int i=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble work;
CRowDouble t;
CRowDouble taubuf;
//--- create matrix
CMatrixDouble tmpa;
CMatrixDouble tmpt;
CMatrixDouble tmpr;
//--- allocation
work=vector<double>::Zeros(MathMax(m,n)+1);
t=vector<double>::Zeros(MathMax(m,n)+1);
tau=vector<double>::Zeros(minmn);
taubuf=vector<double>::Zeros(minmn);
//--- allocation
int ts=CApServ::MatrixTileSizeB();
tmpa=matrix<double>::Zeros(m,ts);
tmpt=matrix<double>::Zeros(ts,2*ts);
tmpr=matrix<double>::Zeros(2*ts,n);
//--- Blocked code
while(blockstart!=minmn)
{
//--- Determine block size
blocksize=minmn-blockstart;
if(blocksize>ts)
blocksize=ts;
//--- change
rowscount=m-blockstart;
//--- QR decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::RMatrixCopy(rowscount,blocksize,a,blockstart,blockstart,tmpa,0,0);
RMatrixQRBaseCase(tmpa,rowscount,blocksize,work,t,taubuf);
CAblas::RMatrixCopy(rowscount,blocksize,tmpa,0,0,a,blockstart,blockstart);
i1_=-blockstart;
for(i_=blockstart; i_<=blockstart+blocksize-1; i_++)
tau.Set(i_,taubuf[i_+i1_]);
//--- check
if(blockstart+blocksize<n)
{
//--- Update the rest, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(n-blockstart-blocksize>=2*ts || rowscount>=4*ts)
{
//--- Prepare block reflector
RMatrixBlockReflector(tmpa,taubuf,true,rowscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q'.
//--- Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
//--- Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA'
CAblas::RMatrixGemm(blocksize,n-blockstart-blocksize,rowscount,1.0,tmpa,0,0,1,a,blockstart,blockstart+blocksize,0,0.0,tmpr,0,0);
CAblas::RMatrixGemm(blocksize,n-blockstart-blocksize,blocksize,1.0,tmpt,0,0,1,tmpr,0,0,0,0.0,tmpr,blocksize,0);
CAblas::RMatrixGemm(rowscount,n-blockstart-blocksize,blocksize,1.0,tmpa,0,0,0,tmpr,blocksize,0,0,1.0,a,blockstart,blockstart+blocksize);
}
else
{
//--- Level 2 algorithm
for(i=0; i<blocksize; i++)
{
i1_=i-1;
for(i_=2; i_<=rowscount-i; i_++)
t.Set(i_,tmpa.Get(i_+i1_,i));
t.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheLeft(a,taubuf[i],t,blockstart+i,m-1,blockstart+blocksize,n-1,work);
}
}
}
//--- change value
blockstart=blockstart+blocksize;
}
}
//+------------------------------------------------------------------+
//| LQ decomposition of a rectangular matrix of size MxN |
//| Input parameters: |
//| A - matrix A whose indexes range within [0..M-1, 0..N-1].|
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| Output parameters: |
//| A - matrices L and Q in compact form (see below) |
//| Tau - array of scalar factors which are used to form |
//| matrix Q. Array whose index ranges within |
//| [0..Min(M,N)-1]. |
//| Matrix A is represented as A = LQ, where Q is an orthogonal |
//| matrix of size MxM, L - lower triangular (or lower trapezoid) |
//| matrix of size M x N. |
//| The elements of matrix L are located on and below the main |
//| diagonal of matrix A. The elements which are located in Tau |
//| array and above the main diagonal of matrix A are used to form |
//| matrix Q as follows: |
//| Matrix Q is represented as a product of elementary reflections |
//| Q = H(k-1)*H(k-2)*...*H(1)*H(0), |
//| where k = min(m,n), and each H(i) is of the form |
//| H(i) = 1 - tau * v * (v^T) |
//| where tau is a scalar stored in Tau[I]; v - real vector, so that |
//| v(0:i-1)=0, v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1). |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQ(CMatrixDouble &a,const int m,const int n,double &tau[])
{
CRowDouble Tau=tau;
RMatrixLQ(a,m,n,Tau);
Tau.ToArray(tau);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQ(CMatrixDouble &a,const int m,const int n,CRowDouble &tau)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int minmn=MathMin(m,n);
int blockstart=0;
int blocksize=0;
int columnscount=0;
int i=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble work;
CRowDouble t;
CRowDouble taubuf;
//--- create matrix
CMatrixDouble tmpa;
CMatrixDouble tmpt;
CMatrixDouble tmpr;
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
tau.Resize(minmn);
taubuf.Resize(minmn);
//--- allocation
int ts=CApServ::MatrixTileSizeB();
tmpa.Resize(ts,n);
tmpt.Resize(ts,2*ts);
tmpr.Resize(m,2*ts);
//--- Blocked code
while(blockstart!=minmn)
{
//--- Determine block size
blocksize=minmn-blockstart;
if(blocksize>ts)
blocksize=ts;
//--- change
columnscount=n-blockstart;
//--- LQ decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::RMatrixCopy(blocksize,columnscount,a,blockstart,blockstart,tmpa,0,0);
RMatrixLQBaseCase(tmpa,blocksize,columnscount,work,t,taubuf);
CAblas::RMatrixCopy(blocksize,columnscount,tmpa,0,0,a,blockstart,blockstart);
i1_=-blockstart;
for(i_=blockstart; i_<=blockstart+blocksize-1; i_++)
tau.Set(i_,taubuf[i_+i1_]);
//--- Update the rest, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(blockstart+blocksize<=m-1)
{
//--- check
if(m-blockstart-blocksize>=2*CAblas::AblasBlockSize())
{
//--- prepare
RMatrixBlockReflector(tmpa,taubuf,false,columnscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q.
//--- Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA
CAblas::RMatrixGemm(m-blockstart-blocksize,blocksize,columnscount,1.0,a,blockstart+blocksize,blockstart,0,tmpa,0,0,1,0.0,tmpr,0,0);
CAblas::RMatrixGemm(m-blockstart-blocksize,blocksize,blocksize,1.0,tmpr,0,0,0,tmpt,0,0,0,0.0,tmpr,0,blocksize);
CAblas::RMatrixGemm(m-blockstart-blocksize,columnscount,blocksize,1.0,tmpr,0,blocksize,0,tmpa,0,0,0,1.0,a,blockstart+blocksize,blockstart);
}
else
{
//--- Level 2 algorithm
for(i=0; i<blocksize; i++)
{
i1_=i-1;
for(i_=2; i_<=columnscount-i; i_++)
t.Set(i_,tmpa.Get(i,i_+i1_));
t.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheRight(a,taubuf[i],t,blockstart+blocksize,m-1,blockstart+i,n-1,work);
}
}
}
//--- change value
blockstart=blockstart+blocksize;
}
}
//+------------------------------------------------------------------+
//| QR decomposition of a rectangular complex matrix of size MxN |
//| Input parameters: |
//| A - matrix A whose indexes range within [0..M-1, 0..N-1] |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| Output parameters: |
//| A - matrices Q and R in compact form |
//| Tau - array of scalar factors which are used to form |
//| matrix Q. Array whose indexes range within |
//| [0.. Min(M,N)-1] |
//| Matrix A is represented as A = QR, where Q is an orthogonal |
//| matrix of size MxM, R - upper triangular (or upper trapezoid) |
//| matrix of size MxN. |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| September 30, 1994 |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQR(CMatrixComplex &a,const int m,const int n,complex &tau[])
{
CRowComplex Tau=tau;
CMatrixQR(a,m,n,Tau);
Tau.ToArray(tau);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQR(CMatrixComplex &a,const int m,const int n,CRowComplex &tau)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create arrays
CRowComplex work;
CRowComplex t;
CRowComplex taubuf;
//--- create matrix
CMatrixComplex tmpa;
CMatrixComplex tmpt;
CMatrixComplex tmpr;
//--- create variables
int minmn=MathMin(m,n);;
int blockstart=0;
int blocksize=0;
int rowscount=0;
int i=0;
int i_=0;
int i1_=0;
complex One(1,0);
complex Alpha(1,0);
complex Beta(0,0);
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
tau.Resize(minmn);
taubuf.Resize(minmn);
//--- allocation
int ts=CApServ::MatrixTileSizeB()/2;
tmpa.Resize(m,ts);
tmpt.Resize(ts,ts);
tmpr.Resize(2*ts,n);
//--- Blocked code
while(blockstart!=minmn)
{
//--- Determine block size
blocksize=minmn-blockstart;
if(blocksize>ts)
blocksize=ts;
rowscount=m-blockstart;
//--- QR decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::CMatrixCopy(rowscount,blocksize,a,blockstart,blockstart,tmpa,0,0);
CMatrixQRBaseCase(tmpa,rowscount,blocksize,work,t,taubuf);
CAblas::CMatrixCopy(rowscount,blocksize,tmpa,0,0,a,blockstart,blockstart);
i1_=-blockstart;
for(i_=blockstart; i_<blockstart+blocksize; i_++)
tau.Set(i_,taubuf[i_+i1_]);
//--- Update the rest, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(blockstart+blocksize<=n-1)
{
//--- check
if(n-blockstart-blocksize>=2*CAblas::AblasComplexBlockSize())
{
//--- Prepare block reflector
CMatrixBlockReflector(tmpa,taubuf,true,rowscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q'.
//--- Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
//--- Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA'
CAblas::CMatrixGemm(blocksize,n-blockstart-blocksize,rowscount,Alpha,tmpa,0,0,2,a,blockstart,blockstart+blocksize,0,Beta,tmpr,0,0);
CAblas::CMatrixGemm(blocksize,n-blockstart-blocksize,blocksize,Alpha,tmpt,0,0,2,tmpr,0,0,0,Beta,tmpr,blocksize,0);
CAblas::CMatrixGemm(rowscount,n-blockstart-blocksize,blocksize,Alpha,tmpa,0,0,0,tmpr,blocksize,0,0,Alpha,a,blockstart,blockstart+blocksize);
}
else
{
//--- Level 2 algorithm
for(i=0; i<blocksize; i++)
{
i1_=i-1;
for(i_=1; i_<=rowscount-i; i_++)
t.Set(i_,tmpa.Get(i_+i1_,i));
t.Set(1,One);
//--- function call
complex conj=CMath::Conj(taubuf[i]);
CComplexReflections::ComplexApplyReflectionFromTheLeft(a,conj,t,blockstart+i,m-1,blockstart+blocksize,n-1,work);
}
}
}
//--- change value
blockstart=blockstart+blocksize;
}
}
//+------------------------------------------------------------------+
//| LQ decomposition of a rectangular complex matrix of size MxN |
//| Input parameters: |
//| A - matrix A whose indexes range within [0..M-1, 0..N-1] |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| Output parameters: |
//| A - matrices Q and L in compact form |
//| Tau - array of scalar factors which are used to form |
//| matrix Q. Array whose indexes range within |
//| [0.. Min(M,N)-1] |
//| Matrix A is represented as A = LQ, where Q is an orthogonal |
//| matrix of size MxM, L - lower triangular (or lower trapezoid) |
//| matrix of size MxN. |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| September 30, 1994 |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQ(CMatrixComplex &a,const int m,const int n,complex &tau[])
{
CRowComplex Tau=tau;
CMatrixLQ(a,m,n,Tau);
Tau.ToArray(tau);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQ(CMatrixComplex &a,const int m,const int n,CRowComplex &tau)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create arrays
CRowComplex work;
CRowComplex t;
CRowComplex taubuf;
//--- create matrix
CMatrixComplex tmpa;
CMatrixComplex tmpt;
CMatrixComplex tmpr;
//--- create variables
int minmn=MathMin(m,n);
int blockstart=0;
int blocksize=0;
int columnscount=0;
int i=0;
int i_=0;
int i1_=0;
complex One(1,0);
complex Alpha(1,0);
complex Beta(0,0);
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
tau.Resize(minmn);
taubuf.Resize(minmn);
//--- allocation
int ts=CApServ::MatrixTileSizeB()/2;
tmpa.Resize(ts,n);
tmpt.Resize(ts,ts);
tmpr.Resize(m,2*ts);
//--- Blocked code
while(blockstart!=minmn)
{
//--- Determine block size
blocksize=minmn-blockstart;
if(blocksize>CAblas::AblasComplexBlockSize())
blocksize=CAblas::AblasComplexBlockSize();
columnscount=n-blockstart;
//--- LQ decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::CMatrixCopy(blocksize,columnscount,a,blockstart,blockstart,tmpa,0,0);
CMatrixLQBaseCase(tmpa,blocksize,columnscount,work,t,taubuf);
CAblas::CMatrixCopy(blocksize,columnscount,tmpa,0,0,a,blockstart,blockstart);
i1_=-blockstart;
for(i_=blockstart; i_<=blockstart+blocksize-1; i_++)
tau.Set(i_,taubuf[i_+i1_]);
//--- Update the rest, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(blockstart+blocksize<=m-1)
{
//--- check
if(m-blockstart-blocksize>=2*ts)
{
//--- Prepare block reflector
CMatrixBlockReflector(tmpa,taubuf,false,columnscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q.
//--- Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA
CAblas::CMatrixGemm(m-blockstart-blocksize,blocksize,columnscount,Alpha,a,blockstart+blocksize,blockstart,0,tmpa,0,0,2,Beta,tmpr,0,0);
CAblas::CMatrixGemm(m-blockstart-blocksize,blocksize,blocksize,Alpha,tmpr,0,0,0,tmpt,0,0,0,Beta,tmpr,0,blocksize);
CAblas::CMatrixGemm(m-blockstart-blocksize,columnscount,blocksize,Alpha,tmpr,0,blocksize,0,tmpa,0,0,0,Alpha,a,blockstart+blocksize,blockstart);
}
else
{
//--- Level 2 algorithm
for(i=0; i<blocksize; i++)
{
i1_=i-1;
for(i_=1; i_<=columnscount-i; i_++)
t.Set(i_,CMath::Conj(tmpa.Get(i,i_+i1_)));
t.Set(1,One);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheRight(a,taubuf[i],t,blockstart+blocksize,m-1,blockstart+i,n-1,work);
}
}
}
//--- change value
blockstart=blockstart+blocksize;
}
}
//+------------------------------------------------------------------+
//| Partial unpacking of matrix Q from the QR decomposition of a |
//| matrix A |
//| Input parameters: |
//| A - matrices Q and R in compact form. |
//| Output of RMatrixQR subroutine. |
//| M - number of rows in given matrix A. M>=0. |
//| N - number of columns in given matrix A. N>=0. |
//| Tau - scalar factors which are used to form Q. |
//| Output of the RMatrixQR subroutine. |
//| QColumns - required number of columns of matrix Q. |
//| M>=QColumns>=0. |
//| Output parameters: |
//| Q - first QColumns columns of matrix Q. |
//| Array whose indexes range within |
//| [0..M-1, 0..QColumns-1]. |
//| If QColumns=0, the array remains unchanged. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQRUnpackQ(CMatrixDouble &a,const int m,const int n,
double &tau[],const int qcolumns,CMatrixDouble &q)
{
CRowDouble Tau=tau;
RMatrixQRUnpackQ(a,m,n,Tau,qcolumns,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQRUnpackQ(CMatrixDouble &a,const int m,const int n,
CRowDouble &tau,const int qcolumns,CMatrixDouble &q)
{
//--- check
if(!CAp::Assert(qcolumns<=m,__FUNCTION__+": QColumns>M!"))
return;
//--- check
if(m<=0 || n<=0 || qcolumns<=0)
return;
//--- create arrays
CRowDouble work;
CRowDouble t;
CRowDouble taubuf;
//--- create matrix
CMatrixDouble tmpa;
CMatrixDouble tmpt;
CMatrixDouble tmpr;
//--- create variables
int ts=CApServ::MatrixTileSizeB()/2;
int minmn=MathMin(m,n);
int refcnt=MathMin(minmn,qcolumns);
int blockstart=ts*(refcnt/ts);
int blocksize=refcnt-blockstart;
int rowscount=0;
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- identity matrix
q=matrix<double>::Identity(m,qcolumns);
//--- allocation
work=vector<double>::Zeros(MathMax(m,qcolumns)+1);
t=vector<double>::Zeros(MathMax(m,qcolumns)+1);
taubuf=vector<double>::Zeros(minmn);
//--- allocation
tmpa=matrix<double>::Zeros(m,ts);
tmpt=matrix<double>::Zeros(ts,2*ts);
tmpr=matrix<double>::Zeros(2*ts,qcolumns);
//--- Blocked code
while(blockstart>=0)
{
rowscount=m-blockstart;
if(blocksize>0)
{
//--- Copy current block
CAblas::RMatrixCopy(rowscount,blocksize,a,blockstart,blockstart,tmpa,0,0);
i1_=blockstart;
for(i_=0; i_<blocksize; i_++)
taubuf.Set(i_,tau[i_+i1_]);
//--- Update, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(qcolumns>=2*ts)
{
//--- Prepare block reflector
RMatrixBlockReflector(tmpa,taubuf,true,rowscount,blocksize,tmpt,work);
//--- Multiply matrix by Q.
//--- Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
CAblas::RMatrixGemm(blocksize,qcolumns,rowscount,1.0,tmpa,0,0,1,q,blockstart,0,0,0.0,tmpr,0,0);
CAblas::RMatrixGemm(blocksize,qcolumns,blocksize,1.0,tmpt,0,0,0,tmpr,0,0,0,0.0,tmpr,blocksize,0);
CAblas::RMatrixGemm(rowscount,qcolumns,blocksize,1.0,tmpa,0,0,0,tmpr,blocksize,0,0,1.0,q,blockstart,0);
}
else
{
//--- Level 2 algorithm
for(i=blocksize-1; i>=0; i--)
{
i1_=i-1;
for(i_=2; i_<=rowscount-i; i_++)
t.Set(i_,tmpa.Get(i_+i1_,i));
t.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheLeft(q,taubuf[i],t,blockstart+i,m-1,0,qcolumns-1,work);
}
}
}
//--- change value
blockstart-=ts;
blocksize=ts;
}
}
//+------------------------------------------------------------------+
//| Unpacking of matrix R from the QR decomposition of a matrix A |
//| Input parameters: |
//| A - matrices Q and R in compact form. |
//| Output of RMatrixQR subroutine. |
//| M - number of rows in given matrix A. M>=0. |
//| N - number of columns in given matrix A. N>=0. |
//| Output parameters: |
//| R - matrix R, array[0..M-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQRUnpackR(CMatrixDouble &a,const int m,const int n,CMatrixDouble &r)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int i=0;
int k=MathMin(m,n);
int i_=0;
//--- Prepare matrix
r=matrix<double>::Zeros(m,n);
//--- get result
r=a.TriU()+0;
}
//+------------------------------------------------------------------+
//| Partial unpacking of matrix Q from the LQ decomposition of a |
//| matrix A |
//| Input parameters: |
//| A - matrices L and Q in compact form. |
//| Output of RMatrixLQ subroutine. |
//| M - number of rows in given matrix A. M>=0. |
//| N - number of columns in given matrix A. N>=0. |
//| Tau - scalar factors which are used to form Q. |
//| Output of the RMatrixLQ subroutine. |
//| QRows - required number of rows in matrix Q. N>=QRows>=0.|
//| Output parameters: |
//| Q - first QRows rows of matrix Q. Array whose indexes|
//| range within [0..QRows-1, 0..N-1]. If QRows=0, |
//| the array remains unchanged. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQUnpackQ(CMatrixDouble &a,const int m,const int n,
double &tau[],const int qrows,CMatrixDouble &q)
{
CRowDouble Tau=tau;
RMatrixLQUnpackQ(a,m,n,Tau,qrows,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQUnpackQ(CMatrixDouble &a,const int m,const int n,
CRowDouble &tau,const int qrows,CMatrixDouble &q)
{
//--- check
if(!CAp::Assert(qrows<=n,__FUNCTION__+": QRows>N!"))
return;
//--- check
if(m<=0 || n<=0 || qrows<=0)
return;
//--- create arrays
CRowDouble work;
CRowDouble t;
CRowDouble taubuf;
//--- create matrix
CMatrixDouble tmpa;
CMatrixDouble tmpt;
CMatrixDouble tmpr;
//--- create variables
int ts=CApServ::MatrixTileSizeB();
int minmn=MathMin(m,n);
int refcnt=MathMin(minmn,qrows);
int blockstart=ts*(refcnt/ts);
int blocksize=refcnt-blockstart;
int columnscount=0;
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
taubuf.Resize(minmn);
//--- allocation
tmpa.Resize(ts,n);
tmpt.Resize(ts,2*ts);
tmpr.Resize(qrows,2*ts);
//--- identity matrix
q=matrix<double>::Identity(qrows,n);
//--- Blocked code
while(blockstart>=0)
{
columnscount=n-blockstart;
//--- Copy submatrix
CAblas::RMatrixCopy(blocksize,columnscount,a,blockstart,blockstart,tmpa,0,0);
CAblasF::RCopyVX(blocksize,tau,blockstart,taubuf,0);
//--- Update matrix, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(qrows>=2*ts)
{
//--- Prepare block reflector
RMatrixBlockReflector(tmpa,taubuf,false,columnscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q'.
//--- Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA
CAblas::RMatrixGemm(qrows,blocksize,columnscount,1.0,q,0,blockstart,0,tmpa,0,0,1,0.0,tmpr,0,0);
CAblas::RMatrixGemm(qrows,blocksize,blocksize,1.0,tmpr,0,0,0,tmpt,0,0,1,0.0,tmpr,0,blocksize);
CAblas::RMatrixGemm(qrows,columnscount,blocksize,1.0,tmpr,0,blocksize,0,tmpa,0,0,0,1.0,q,0,blockstart);
}
else
{
//--- Level 2 algorithm
for(i=blocksize-1; i>=0; i--)
{
i1_=i-1;
for(i_=2; i_<=columnscount-i; i_++)
t.Set(i_,tmpa.Get(i,i_+i1_));
t.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheRight(q,taubuf[i],t,0,qrows-1,blockstart+i,n-1,work);
}
}
//--- change value
blockstart=blockstart-ts;
blocksize=ts ;
}
}
//+------------------------------------------------------------------+
//| Unpacking of matrix L from the LQ decomposition of a matrix A |
//| Input parameters: |
//| A -matrices Q and L in compact form. |
//| Output of RMatrixLQ subroutine. |
//| M -number of rows in given matrix A. M>=0. |
//| N -number of columns in given matrix A. N>=0. |
//| Output parameters: |
//| L -matrix L, array[0..M-1,0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQUnpackL(CMatrixDouble &a,const int m,const int n,CMatrixDouble &l)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int i=0;
int k=0;
int i_=0;
//--- Prepare matrix
l=matrix<double>::Zeros(m,n);
//--- get result
for(i=0; i<m; i++)
{
k=MathMin(i,n-1);
for(i_=0; i_<=k; i_++)
l.Set(i,i_,a.Get(i,i_));
}
}
//+------------------------------------------------------------------+
//| Partial unpacking of matrix Q from QR decomposition of a complex |
//| matrix A. |
//| Input parameters: |
//| A - matrices Q and R in compact form. |
//| Output of CMatrixQR subroutine . |
//| M - number of rows in matrix A. M>=0. |
//| N - number of columns in matrix A. N>=0. |
//| Tau - scalar factors which are used to form Q. |
//| Output of CMatrixQR subroutine . |
//| QColumns - required number of columns in matrix Q. |
//| M>=QColumns>=0. |
//| Output parameters: |
//| Q - first QColumns columns of matrix Q. |
//| Array whose index ranges within [0..M-1, |
//| 0..QColumns-1]. |
//| If QColumns=0, array isn't changed. |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQRUnpackQ(CMatrixComplex &a,const int m,const int n,
complex &tau[],const int qcolumns,CMatrixComplex &q)
{
CRowComplex Tau=tau;
CMatrixQRUnpackQ(a,m,n,Tau,qcolumns,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQRUnpackQ(CMatrixComplex &a,const int m,const int n,
CRowComplex &tau,const int qcolumns,CMatrixComplex &q)
{
//--- check
if(!CAp::Assert(qcolumns<=m,__FUNCTION__+": QColumns>M!"))
return;
//--- check
if(m<=0 || n<=0)
return;
//--- create arrays
CRowComplex work;
CRowComplex t;
CRowComplex taubuf;
//--- create matrix
CMatrixComplex tmpa;
CMatrixComplex tmpt;
CMatrixComplex tmpr;
//--- create variables
int ts=CApServ::MatrixTileSizeB()/2;
int minmn=MathMin(m,n);
int refcnt=MathMin(minmn,qcolumns);
int blockstart=ts*(refcnt/ts);
int blocksize=refcnt-blockstart;
int rowscount=0;
int i=0;
int j=0;
int i_=0;
int i1_=0;
complex One(1,0);
complex Zero(0,0);
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
taubuf.Resize(minmn);
//--- allocation
tmpa.Resize(m,ts);
tmpt.Resize(ts,ts);
tmpr.Resize(2*ts,qcolumns);
//--- identity matrix
q=matrix<complex>::Identity(m,qcolumns);
//--- Blocked code
while(blockstart>=0)
{
rowscount=m-blockstart;
if(blocksize>0)
{
//--- QR decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::CMatrixCopy(rowscount,blocksize,a,blockstart,blockstart,tmpa,0,0);
i1_=blockstart;
for(i_=0; i_<blocksize; i_++)
taubuf.Set(i_,tau[i_+i1_]);
//--- Update matrix, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(qcolumns>=2*ts)
{
//--- Prepare block reflector
CMatrixBlockReflector(tmpa,taubuf,true,rowscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q.
//--- Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
CAblas::CMatrixGemm(blocksize,qcolumns,rowscount,One,tmpa,0,0,2,q,blockstart,0,0,Zero,tmpr,0,0);
CAblas::CMatrixGemm(blocksize,qcolumns,blocksize,One,tmpt,0,0,0,tmpr,0,0,0,Zero,tmpr,blocksize,0);
CAblas::CMatrixGemm(rowscount,qcolumns,blocksize,One,tmpa,0,0,0,tmpr,blocksize,0,0,One,q,blockstart,0);
}
else
{
//--- Level 2 algorithm
for(i=blocksize-1; i>=0; i--)
{
i1_=i-1;
for(i_=1; i_<=rowscount-i; i_++)
t.Set(i_,tmpa.Get(i_+i1_,i));
t.Set(1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheLeft(q,taubuf[i],t,blockstart+i,m-1,0,qcolumns-1,work);
}
}
}
//--- change value
blockstart=blockstart-ts;
blocksize=ts;
}
}
//+------------------------------------------------------------------+
//| Unpacking of matrix R from the QR decomposition of a matrix A |
//| Input parameters: |
//| A - matrices Q and R in compact form. |
//| Output of CMatrixQR subroutine. |
//| M - number of rows in given matrix A. M>=0. |
//| N - number of columns in given matrix A. N>=0. |
//| Output parameters: |
//| R - matrix R, array[0..M-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQRUnpackR(CMatrixComplex &a,const int m,const int n,CMatrixComplex &r)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int k=MathMin(m,n);
//--- Prepare matrix
r=matrix<complex>::Zeros(m,n);
//--- get result
for(int i=0; i<k; i++)
{
for(int i_=i; i_<n; i_++)
r.Set(i,i_,a.Get(i,i_));
}
}
//+------------------------------------------------------------------+
//| Partial unpacking of matrix Q from LQ decomposition of a complex |
//| matrix A. |
//| Input parameters: |
//| A - matrices Q and R in compact form. |
//| Output of CMatrixLQ subroutine. |
//| M - number of rows in matrix A. M>=0. |
//| N - number of columns in matrix A. N>=0. |
//| Tau - scalar factors which are used to form Q. |
//| Output of CMatrixLQ subroutine . |
//| QRows - required number of rows in matrix Q. |
//| N>=QColumns>=0. |
//| Output parameters: |
//| Q - first QRows rows of matrix Q. |
//| Array whose index ranges within [0..QRows-1, |
//| 0..N-1]. |
//| If QRows=0, array isn't changed. |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQUnpackQ(CMatrixComplex &a,const int m,const int n,
complex &tau[],const int qrows,CMatrixComplex &q)
{
CRowComplex Tau=tau;
CMatrixLQUnpackQ(a,m,n,Tau,qrows,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQUnpackQ(CMatrixComplex &a,const int m,const int n,
CRowComplex &tau,const int qrows,CMatrixComplex &q)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create arrays
CRowComplex work;
CRowComplex t;
CRowComplex taubuf;
//--- create matrix
CMatrixComplex tmpa;
CMatrixComplex tmpt;
CMatrixComplex tmpr;
//--- create variables
int minmn=MathMin(m,n);
int refcnt=MathMin(minmn,qrows);
int ts=CApServ::MatrixTileSizeB()/2;
int blockstart=ts*(refcnt/ts);
int blocksize=refcnt-blockstart;
int columnscount=0;
int i=0;
int j=0;
int i_=0;
int i1_=0;
complex One(1,0);
complex Zero(0,0);
//--- allocation
work.Resize(MathMax(m,n)+1);
t.Resize(MathMax(m,n)+1);
taubuf.Resize(minmn);
//--- allocation
tmpa.Resize(ts,n);
tmpt.Resize(ts,ts);
tmpr.Resize(qrows,2*ts);
//--- identity matrix
q=matrix<complex>::Identity(qrows,n);
//--- Blocked code
while(blockstart>=0)
{
columnscount=n-blockstart;
if(blocksize>0)
{
//--- LQ decomposition of submatrix.
//--- Matrix is copied to temporary storage to solve
//--- some TLB issues arising from non-contiguous memory
//--- access pattern.
CAblas::CMatrixCopy(blocksize,columnscount,a,blockstart,blockstart,tmpa,0,0);
i1_=blockstart;
for(i_=0; i_<blocksize; i_++)
taubuf.Set(i_,tau[i_+i1_]);
//--- Update matrix, choose between:
//--- a) Level 2 algorithm (when the rest of the matrix is small enough)
//--- b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
//--- representation for products of Householder transformations',
//--- by R. Schreiber and C. Van Loan.
if(qrows>=2*ts)
{
//--- Prepare block reflector
CMatrixBlockReflector(tmpa,taubuf,false,columnscount,blocksize,tmpt,work);
//--- Multiply the rest of A by Q'.
//--- Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA
CAblas::CMatrixGemm(qrows,blocksize,columnscount,One,q,0,blockstart,0,tmpa,0,0,2,Zero,tmpr,0,0);
CAblas::CMatrixGemm(qrows,blocksize,blocksize,One,tmpr,0,0,0,tmpt,0,0,2,Zero,tmpr,0,blocksize);
CAblas::CMatrixGemm(qrows,columnscount,blocksize,One,tmpr,0,blocksize,0,tmpa,0,0,0,One,q,0,blockstart);
}
else
{
//--- Level 2 algorithm
for(i=blocksize-1; i>=0; i--)
{
i1_=i-1;
for(i_=2; i_<=columnscount-i; i_++)
t.Set(i_,CMath::Conj(tmpa.Get(i,i_+i1_)));
t.Set(1,1.0);
//--- function call
complex conj=CMath::Conj(taubuf[i]);
CComplexReflections::ComplexApplyReflectionFromTheRight(q,conj,t,0,qrows-1,blockstart+i,n-1,work);
}
}
}
//--- change value
blockstart=blockstart-ts;
blocksize=ts;
}
}
//+------------------------------------------------------------------+
//| Unpacking of matrix L from the LQ decomposition of a matrix A |
//| Input parameters: |
//| A - matrices Q and L in compact form. |
//| Output of CMatrixLQ subroutine. |
//| M - number of rows in given matrix A. M>=0. |
//| N - number of columns in given matrix A. N>=0. |
//| Output parameters: |
//| L - matrix L, array[0..M-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQUnpackL(CMatrixComplex &a,const int m,const int n,CMatrixComplex &l)
{
//--- check
if(m<=0 || n<=0)
return;
//--- Prepare matrix
l=matrix<complex>::Zeros(m,n);
//--- get result
for(int i=0; i<m; i++)
{
int k=MathMin(i,n-1);
for(int i_=0; i_<=k; i_++)
l.Set(i,i_,a.Get(i,i_));
}
}
//+------------------------------------------------------------------+
//| Reduction of a rectangular matrix to bidiagonal form |
//| The algorithm reduces the rectangular matrix A to bidiagonal |
//| form by orthogonal transformations P and Q: A = Q*B*P. |
//| Input parameters: |
//| A - source matrix. array[0..M-1, 0..N-1] |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| Output parameters: |
//| A - matrices Q, B, P in compact form (see below). |
//| TauQ - scalar factors which are used to form matrix Q. |
//| TauP - scalar factors which are used to form matrix P. |
//| The main diagonal and one of the secondary diagonals of matrix A |
//| are replaced with bidiagonal matrix B. Other elements contain |
//| elementary reflections which form MxM matrix Q and NxN matrix P, |
//| respectively. |
//| If M>=N, B is the upper bidiagonal MxN matrix and is stored in |
//| the corresponding elements of matrix A. Matrix Q is represented |
//| as a product of elementary reflections Q = H(0)*H(1)*...*H(n-1), |
//| where H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in |
//| TauQ[i], and vector v has the following structure: v(0:i-1)=0, |
//| v(i)=1, v(i+1:m-1) is stored in elements A(i+1:m-1,i).Matrix P is|
//| as follows: P = G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. |
//| Tau is stored in TauP[i], u(0:i)=0, u(i+1)=1, u(i+2:n-1) is |
//| stored in elements A(i,i+2:n-1). |
//| If M<N, B is the lower bidiagonal MxN matrix and is stored in the|
//| corresponding elements of matrix A. Q = H(0)*H(1)*...*H(m-2), |
//| where H(i) = 1 - tau*v*v', tau is stored in TauQ, v(0:i)=0, |
//| v(i+1)=1, v(i+2:m-1) is stored in elements A(i+2:m-1,i). |
//| P = G(0)*G(1)*...*G(m-1), G(i) = 1-tau*u*u', tau is stored in |
//| TauP, u(0:i-1)=0, u(i)=1, u(i+1:n-1) is stored in A(i,i+1:n-1). |
//| EXAMPLE: |
//| m=6, n=5 (m > n): m=5, n=6 (m < n): |
//| ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) |
//| ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) |
//| ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) |
//| ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) |
//| ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) |
//| ( v1 v2 v3 v4 v5 ) |
//| Here vi and ui are vectors which form H(i) and G(i), and d and |
//| e - are the diagonal and off-diagonal elements of matrix B. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBD(CMatrixDouble &a,const int m,const int n,double &tauq[],double &taup[])
{
CRowDouble TauQ=tauq;
CRowDouble TauP=taup;
RMatrixBD(a,m,n,TauQ,TauP);
TauQ.ToArray(tauq);
TauP.ToArray(taup);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBD(CMatrixDouble &a,const int m,const int n,CRowDouble &tauq,CRowDouble &taup)
{
//--- check
if(n<=0 || m<=0)
return;
//--- create arrays
CRowDouble work;
CRowDouble t;
//--- create variables
int minmn=0;
int maxmn=MathMax(m,n);
int i=0;
double ltau=0;
int i_=0;
int i1_=0;
//--- allocation
work.Resize(maxmn+1);
t.Resize(maxmn+1);
//--- initialization
tauq=vector<double>::Zeros(MathMin(m,n));
taup=tauq;
//--- check
if(m>=n)
{
//--- Reduce to upper bidiagonal form
for(i=0; i<n; i++)
{
//--- Generate elementary reflector H(i) to annihilate A(i+1:m-1,i)
i1_=i-1;
for(i_=1; i_<=m-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CAblas::GenerateReflection(t,m-i,ltau);
tauq.Set(i,ltau);
i1_=1-i;
for(i_=i; i_<m; i_++)
a.Set(i_,i,t[i_+i1_]);
t.Set(1,1);
//--- Apply H(i) to A(i:m-1,i+1:n-1) from the left
CAblas::ApplyReflectionFromTheLeft(a,ltau,t,i,m-1,i+1,n-1,work);
//--- check
if(i<n-1)
{
//--- Generate elementary reflector G(i) to annihilate
//--- A(i,i+2:n-1)
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i,i_+i1_));
CAblas::GenerateReflection(t,n-1-i,ltau);
taup.Set(i,ltau);
i1_=-i;
for(i_=i+1; i_<n; i_++)
a.Set(i,i_,t[i_+i1_]);
t.Set(1,1);
//--- Apply G(i) to A(i+1:m-1,i+1:n-1) from the right
CAblas::ApplyReflectionFromTheRight(a,ltau,t,i+1,m-1,i+1,n-1,work);
}
else
taup.Set(i,0);
}
}
else
{
//--- Reduce to lower bidiagonal form
for(i=0; i<m; i++)
{
//--- Generate elementary reflector G(i) to annihilate A(i,i+1:n-1)
i1_=i-1;
for(i_=1; i_<=n-i; i_++)
t.Set(i_,a.Get(i,i_+i1_));
CAblas::GenerateReflection(t,n-i,ltau);
taup.Set(i,ltau);
i1_=1-i;
for(i_=i; i_<n; i_++)
a.Set(i,i_,t[i_+i1_]);
t.Set(1,1);
//--- Apply G(i) to A(i+1:m-1,i:n-1) from the right
CAblas::ApplyReflectionFromTheRight(a,ltau,t,i+1,m-1,i,n-1,work);
//--- check
if(i<m-1)
{
//--- Generate elementary reflector H(i) to annihilate
//--- A(i+2:m-1,i)
i1_=i;
for(i_=1; i_<m-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CAblas::GenerateReflection(t,m-1-i,ltau);
tauq.Set(i,ltau);
i1_=-i;
for(i_=i+1; i_<m; i_++)
a.Set(i_,i,t[i_+i1_]);
t.Set(1,1);
//--- Apply H(i) to A(i+1:m-1,i+1:n-1) from the left
CAblas::ApplyReflectionFromTheLeft(a,ltau,t,i+1,m-1,i+1,n-1,work);
}
else
tauq.Set(i,0);
}
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix Q which reduces a matrix to bidiagonal form. |
//| Input parameters: |
//| QP - matrices Q and P in compact form. |
//| Output of ToBidiagonal subroutine. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| TAUQ - scalar factors which are used to form Q. |
//| Output of ToBidiagonal subroutine. |
//| QColumns - required number of columns in matrix Q. |
//| M>=QColumns>=0. |
//| Output parameters: |
//| Q - first QColumns columns of matrix Q. |
//| Array[0..M-1, 0..QColumns-1] |
//| If QColumns=0, the array is not modified. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackQ(CMatrixDouble &qp,const int m,const int n,
double &tauq[],const int qcolumns,CMatrixDouble &q)
{
CRowDouble TauQ=tauq;
RMatrixBDUnpackQ(qp,m,n,TauQ,qcolumns,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackQ(CMatrixDouble &qp,const int m,const int n,
CRowDouble &tauq,const int qcolumns,CMatrixDouble &q)
{
//--- check
if(!CAp::Assert(qcolumns<=m,__FUNCTION__+": QColumns>M!"))
return;
//--- check
if(!CAp::Assert(qcolumns>=0,__FUNCTION__+": QColumns<0!"))
return;
//--- check
if(m==0 || n==0 || qcolumns==0)
return;
//--- identity matrix
q=matrix<double>::Identity(m,qcolumns);
//--- get result
RMatrixBDMultiplyByQ(qp,m,n,tauq,q,m,qcolumns,false,false);
}
//+------------------------------------------------------------------+
//| Multiplication by matrix Q which reduces matrix A to bidiagonal |
//| form. |
//| The algorithm allows pre- or post-multiply by Q or Q'. |
//| Input parameters: |
//| QP - matrices Q and P in compact form. |
//| Output of ToBidiagonal subroutine. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| TAUQ - scalar factors which are used to form Q. |
//| Output of ToBidiagonal subroutine. |
//| Z - multiplied matrix. |
//| array[0..ZRows-1,0..ZColumns-1] |
//| ZRows - number of rows in matrix Z. If FromTheRight= |
//| =False, ZRows=M, otherwise ZRows can be |
//| arbitrary. |
//| ZColumns - number of columns in matrix Z. If |
//| FromTheRight=True, ZColumns=M, otherwise |
//| ZColumns can be arbitrary. |
//| FromTheRight - pre- or post-multiply. |
//| DoTranspose - multiply by Q or Q'. |
//| Output parameters: |
//| Z - product of Z and Q. |
//| Array[0..ZRows-1,0..ZColumns-1] |
//| If ZRows=0 or ZColumns=0, the array is not |
//| modified. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDMultiplyByQ(CMatrixDouble &qp,const int m,const int n,
double &tauq[],CMatrixDouble &z,const int zrows,
const int zcolumns,const bool fromtheright,
const bool dotranspose)
{
CRowDouble TauQ=tauq;
RMatrixBDMultiplyByQ(qp,m,n,TauQ,z,zrows,zcolumns,fromtheright,dotranspose);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDMultiplyByQ(CMatrixDouble &qp,const int m,const int n,
CRowDouble &tauq,CMatrixDouble &z,const int zrows,
const int zcolumns,const bool fromtheright,
const bool dotranspose)
{
//--- check
if(m<=0 || n<=0 || zrows<=0 || zcolumns<=0)
return;
//--- check
if(!CAp::Assert((fromtheright && zcolumns==m) || (!fromtheright && zrows==m),__FUNCTION__+": incorrect Z size!"))
return;
//--- create variables
int mx=0;
int i_=0;
int i1_=0;
int i=0;
int i1=0;
int i2=0;
int istep=0;
//--- create arrays
CRowDouble v;
CRowDouble work;
CRowDouble dummy;
//--- initialization
mx=MathMax(m,n);
mx=MathMax(mx,zrows);
mx=MathMax(mx,zcolumns);
//--- allocation
v.Resize(mx+1);
work.Resize(mx+1);
//--- check
if(m>=n)
{
//--- setup
if(fromtheright)
{
i1=0;
i2=n-1;
istep=1;
}
else
{
i1=n-1;
i2=0;
istep=-1;
}
//--- check
if(dotranspose)
{
i=i1;
i1=i2;
i2=i;
istep=-istep;
}
//--- Process
i=i1;
do
{
i1_=i-1;
for(i_=2; i_<=m-i; i_++)
v.Set(i_,qp.Get(i_+i1_,i));
v.Set(1,1);
//--- check
if(fromtheright)
CAblas::ApplyReflectionFromTheRight(z,tauq[i],v,0,zrows-1,i,m-1,work);
else
CAblas::ApplyReflectionFromTheLeft(z,tauq[i],v,i,m-1,0,zcolumns-1,work);
i=i+istep;
}
while(i!=i2+istep);
}
else
{
//--- setup
if(fromtheright)
{
i1=0;
i2=m-2;
istep=1;
}
else
{
i1=m-2;
i2=0;
istep=-1;
}
//--- check
if(dotranspose)
{
i=i1;
i1=i2;
i2=i;
istep=-istep;
}
//--- Process
if(m-1>0)
{
i=i1;
do
{
i1_=i;
for(i_=2; i_<m-i; i_++)
v.Set(i_,qp.Get(i_+i1_,i));
v.Set(1,1);
//--- check
if(fromtheright)
CAblas::ApplyReflectionFromTheRight(z,tauq[i],v,0,zrows-1,i+1,m-1,work);
else
CAblas::ApplyReflectionFromTheLeft(z,tauq[i],v,i+1,m-1,0,zcolumns-1,work);
i=i+istep;
}
while(i!=i2+istep);
}
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix P which reduces matrix A to bidiagonal form. |
//| The subroutine returns transposed matrix P. |
//| Input parameters: |
//| QP - matrices Q and P in compact form. |
//| Output of ToBidiagonal subroutine. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| TAUP - scalar factors which are used to form P. |
//| Output of ToBidiagonal subroutine. |
//| PTRows - required number of rows of matrix P^T. |
//| N >= PTRows >= 0. |
//| Output parameters: |
//| PT - first PTRows columns of matrix P^T |
//| Array[0..PTRows-1, 0..N-1] |
//| If PTRows=0, the array is not modified. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackPT(CMatrixDouble &qp,const int m,const int n,
double &taup[],const int ptrows,CMatrixDouble &pt)
{
CRowDouble TauP=taup;
RMatrixBDUnpackPT(qp,m,n,TauP,ptrows,pt);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackPT(CMatrixDouble &qp,const int m,const int n,
CRowDouble &taup,const int ptrows,CMatrixDouble &pt)
{
//--- check
if(!CAp::Assert(ptrows<=n,__FUNCTION__+": PTRows>N!"))
return;
//--- check
if(!CAp::Assert(ptrows>=0,__FUNCTION__+": PTRows<0!"))
return;
//--- check
if(m==0 || n==0 || ptrows==0)
return;
//--- prepare
pt=matrix<double>::Identity(ptrows,n);
//--- get result
RMatrixBDMultiplyByP(qp,m,n,taup,pt,ptrows,n,true,true);
}
//+------------------------------------------------------------------+
//| Multiplication by matrix P which reduces matrix A to bidiagonal |
//| form. |
//| The algorithm allows pre- or post-multiply by P or P'. |
//| Input parameters: |
//| QP - matrices Q and P in compact form. |
//| Output of RMatrixBD subroutine. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| TAUP - scalar factors which are used to form P. |
//| Output of RMatrixBD subroutine. |
//| Z - multiplied matrix. |
//| Array whose indexes range within |
//| [0..ZRows-1,0..ZColumns-1]. |
//| ZRows - number of rows in matrix Z. If |
//| FromTheRight=False, ZRows=N, otherwise ZRows |
//| can be arbitrary. |
//| ZColumns - number of columns in matrix Z. If |
//| FromTheRight=True, ZColumns=N, otherwise |
//| ZColumns can be arbitrary. |
//| FromTheRight - pre- or post-multiply. |
//| DoTranspose - multiply by P or P'. |
//| Output parameters: |
//| Z - product of Z and P. |
//| Array whose indexes range within |
//| [0..ZRows-1,0..ZColumns-1]. If ZRows=0 or |
//| ZColumns=0, the array is not modified. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDMultiplyByP(CMatrixDouble &qp,const int m,const int n,
double &taup[],CMatrixDouble &z,const int zrows,
const int zcolumns,const bool fromtheright,
const bool dotranspose)
{
CRowDouble TauP=taup;
RMatrixBDMultiplyByP(qp,m,n,TauP,z,zrows,zcolumns,fromtheright,dotranspose);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDMultiplyByP(CMatrixDouble &qp,const int m,const int n,
CRowDouble &taup,CMatrixDouble &z,const int zrows,
const int zcolumns,const bool fromtheright,
const bool dotranspose)
{
//--- check
if(m<=0 || n<=0 || zrows<=0 || zcolumns<=0)
return;
//--- check
if(!CAp::Assert((fromtheright && zcolumns==n) || (!fromtheright && zrows==n),__FUNCTION__+": incorrect Z size!"))
return;
//--- create arrays
CRowDouble v;
CRowDouble work;
//--- create variables
int i=0;
int mx=0;
int i1=0;
int i2=0;
int istep=0;
int i_=0;
int i1_=0;
//--- initialization
mx=MathMax(m,n);
mx=MathMax(mx,zrows);
mx=MathMax(mx,zcolumns);
//--- allocation
v.Resize(mx+1);
work.Resize(mx+1);
//--- check
if(m>=n)
{
//--- setup
if(fromtheright)
{
i1=n-2;
i2=0;
istep=-1;
}
else
{
i1=0;
i2=n-2;
istep=1;
}
//--- check
if(!dotranspose)
{
i=i1;
i1=i2;
i2=i;
istep=-istep;
}
//--- Process
if(n-1>0)
{
i=i1;
do
{
i1_=i;
for(i_=2; i_<n-i; i_++)
v.Set(i_,qp.Get(i,i_+i1_));
v.Set(1,1);
//--- check
if(fromtheright)
CAblas::ApplyReflectionFromTheRight(z,taup[i],v,0,zrows-1,i+1,n-1,work);
else
CAblas::ApplyReflectionFromTheLeft(z,taup[i],v,i+1,n-1,0,zcolumns-1,work);
i=i+istep;
}
while(i!=i2+istep);
}
}
else
{
//--- setup
if(fromtheright)
{
i1=m-1;
i2=0;
istep=-1;
}
else
{
i1=0;
i2=m-1;
istep=1;
}
//--- check
if(!dotranspose)
{
i=i1;
i1=i2;
i2=i;
istep=-istep;
}
//--- Process
i=i1;
do
{
i1_=i-1;
for(i_=2; i_<=n-i; i_++)
v.Set(i_,qp.Get(i,i_+i1_));
v.Set(1,1);
//--- check
if(fromtheright)
CAblas::ApplyReflectionFromTheRight(z,taup[i],v,0,zrows-1,i,n-1,work);
else
CAblas::ApplyReflectionFromTheLeft(z,taup[i],v,i,n-1,0,zcolumns-1,work);
i=i+istep;
}
while(i!=i2+istep);
}
}
//+------------------------------------------------------------------+
//| Unpacking of the main and secondary diagonals of bidiagonal |
//| decomposition of matrix A. |
//| Input parameters: |
//| B - output of RMatrixBD subroutine. |
//| M - number of rows in matrix B. |
//| N - number of columns in matrix B. |
//| Output parameters: |
//| IsUpper - True, if the matrix is upper bidiagonal. |
//| otherwise IsUpper is False. |
//| D - the main diagonal. |
//| Array whose index ranges within [0..Min(M,N)-1]. |
//| E - the secondary diagonal (upper or lower, depending|
//| on the value of IsUpper). |
//| Array index ranges within [0..Min(M,N)-1], the |
//| last element is not used. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackDiagonals(CMatrixDouble &b,const int m,const int n,
bool &IsUpper,double &d[],double &e[])
{
CRowDouble D,E;
RMatrixBDUnpackDiagonals(b,m,n,IsUpper,D,E);
D.ToArray(d);
E.ToArray(e);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBDUnpackDiagonals(CMatrixDouble &b,const int m,const int n,
bool &IsUpper,CRowDouble &d,CRowDouble &e)
{
//--- check
if(m<=0 || n<=0)
return;
//--- create variables
int i=0;
//--- check
IsUpper=(m>=n);
d=b.Diag()+0;
//--- check
if(IsUpper)
e=b.Diag(1)+0;
else
e=b.Diag(-1)+0;
}
//+------------------------------------------------------------------+
//| Reduction of a square matrix to upper Hessenberg form: |
//| Q'*A*Q = H, where Q is an orthogonal matrix, H - Hessenberg |
//| matrix. |
//| Input parameters: |
//| A - matrix A with elements [0..N-1, 0..N-1] |
//| N - size of matrix A. |
//| Output parameters: |
//| A - matrices Q and P in compact form (see below). |
//| Tau - array of scalar factors which are used to form |
//| matrix Q. |
//| Array whose index ranges within [0..N-2] |
//| Matrix H is located on the main diagonal, on the lower secondary |
//| diagonal and above the main diagonal of matrix A. The elements |
//| which are used to form matrix Q are situated in array Tau and |
//| below the lower secondary diagonal of matrix A as follows: |
//| Matrix Q is represented as a product of elementary reflections |
//| Q = H(0)*H(2)*...*H(n-2), |
//| where each H(i) is given by |
//| H(i) = 1 - tau * v * (v^T) |
//| where tau is a scalar stored in Tau[I]; v - is a real vector, |
//| so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in |
//| A(i+2:n-1,i). |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void COrtFac::RMatrixHessenberg(CMatrixDouble &a,const int n,double &tau[])
{
CRowDouble Tau=tau;
RMatrixHessenberg(a,n,Tau);
Tau.ToArray(tau);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixHessenberg(CMatrixDouble &a,const int n,CRowDouble &tau)
{
//--- check
if(n<=1)
return;
//--- check
if(!CAp::Assert(n>=0,__FUNCTION__+": incorrect N!"))
return;
//--- create arrays
CRowDouble t;
CRowDouble work;
//--- create variables
int i=0;
double v=0;
int i_=0;
int i1_=0;
//--- allocation
tau.Resize(n-1);
t.Resize(n+1);
work.Resize(n);
//--- ALGLIB version
for(i=0; i<n-1; i++)
{
//--- Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CAblas::GenerateReflection(t,n-i-1,v);
i1_=-i;
for(i_=i+1; i_<n; i_++)
a.Set(i_,i,t[i_+i1_]);
tau.Set(i,v);
t.Set(1,1);
//--- Apply H(i) to A(1:ihi,i+1:ihi) from the right
CAblas::ApplyReflectionFromTheRight(a,v,t,0,n-1,i+1,n-1,work);
//--- Apply H(i) to A(i+1:ihi,i+1:n) from the left
CAblas::ApplyReflectionFromTheLeft(a,v,t,i+1,n-1,i+1,n-1,work);
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix Q which reduces matrix A to upper Hessenberg |
//| form |
//| Input parameters: |
//| A - output of RMatrixHessenberg subroutine. |
//| N - size of matrix A. |
//| Tau - scalar factors which are used to form Q. |
//| Output of RMatrixHessenberg subroutine. |
//| Output parameters: |
//| Q - matrix Q. |
//| Array whose indexes range within [0..N-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixHessenbergUnpackQ(CMatrixDouble &a,const int n,
double &tau[],CMatrixDouble &q)
{
//--- check
if(n==0)
return;
//--- create arrays
CRowDouble v;
CRowDouble work;
//--- create variables
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- allocation
v.Resize(n);
work.Resize(n);
//--- ALGLIB version: unpack Q
//--- identity matrix
q=matrix<double>::Identity(n,n);
//--- unpack Q
for(i=0; i<n-1; i++)
{
//--- Apply H(i)
i1_=i;
for(i_=1; i_<n-i; i_++)
v.Set(i_,a.Get(i_+i1_,i));
v.Set(1,1);
CAblas::ApplyReflectionFromTheRight(q,tau[i],v,0,n-1,i+1,n-1,work);
}
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::RMatrixHessenbergUnpackQ(CMatrixDouble &a,const int n,
CRowDouble &tau,CMatrixDouble &q)
{
//--- check
if(n==0)
return;
//--- create arrays
CRowDouble v;
CRowDouble work;
//--- create variables
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- allocation
v.Resize(n);
work.Resize(n);
//--- ALGLIB version: unpack Q
//--- identity matrix
q=matrix<double>::Identity(n,n);
//--- unpack Q
for(i=0; i<n-1; i++)
{
//--- Apply H(i)
i1_=i;
for(i_=1; i_<n-i; i_++)
v.Set(i_,a.Get(i_+i1_,i));
v.Set(1,1);
CAblas::ApplyReflectionFromTheRight(q,tau[i],v,0,n-1,i+1,n-1,work);
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix H (the result of matrix A reduction to upper |
//| Hessenberg form) |
//| Input parameters: |
//| A - output of RMatrixHessenberg subroutine. |
//| N - size of matrix A. |
//| Output parameters: |
//| H - matrix H. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::RMatrixHessenbergUnpackH(CMatrixDouble &a,const int n,CMatrixDouble &h)
{
//--- check
if(n==0)
return;
//--- create arrays
CRowDouble v;
CRowDouble work;
//--- create variables
int i=0;
int j=0;
int i_=0;
//--- allocation
h.Resize(n,n);
//--- get result
for(i=0; i<n; i++)
{
for(j=0; j<=i-2; j++)
h.Set(i,j,0);
j=(int)MathMax(0,i-1);
for(i_=j; i_<n; i_++)
h.Set(i,i_,a.Get(i,i_));
}
}
//+------------------------------------------------------------------+
//| Reduction of a symmetric matrix which is given by its higher or |
//| lower triangular part to a tridiagonal matrix using orthogonal |
//| similarity transformation: Q'*A*Q=T. |
//| Input parameters: |
//| A - matrix to be transformed |
//| array with elements [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - storage format. If IsUpper = True, then matrix A |
//| is given by its upper triangle, and the lower |
//| triangle is not used and not modified by the |
//| algorithm, and vice versa if IsUpper = False. |
//| Output parameters: |
//| A - matrices T and Q in compact form (see lower) |
//| Tau - array of factors which are forming matrices H(i) |
//| array with elements [0..N-2]. |
//| D - main diagonal of symmetric matrix T. |
//| array with elements [0..N-1]. |
//| E - secondary diagonal of symmetric matrix T. |
//| array with elements [0..N-2]. |
//| If IsUpper=True, the matrix Q is represented as a product of |
//| elementary reflectors |
//| Q = H(n-2) . . . H(2) H(0). |
//| Each H(i) has the form |
//| H(i) = I - tau * v * v' |
//| where tau is a real scalar, and v is a real vector with |
//| v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in |
//| A(0:i-1,i+1), and tau in TAU(i). |
//| If IsUpper=False, the matrix Q is represented as a product of |
//| elementary reflectors |
//| Q = H(0) H(2) . . . H(n-2). |
//| Each H(i) has the form |
//| H(i) = I - tau * v * v' |
//| where tau is a real scalar, and v is a real vector with |
//| v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in |
//| A(i+2:n-1,i), and tau in TAU(i). |
//| The contents of A on exit are illustrated by the following |
//| examples with n = 5: |
//| if UPLO = 'U': if UPLO = 'L': |
//| ( d e v1 v2 v3 ) ( d ) |
//| ( d e v2 v3 ) ( e d ) |
//| ( d e v3 ) ( v0 e d ) |
//| ( d e ) ( v0 v1 e d ) |
//| ( d ) ( v0 v1 v2 e d ) |
//| where d and e denote diagonal and off-diagonal elements of T, |
//| and vi denotes an element of the vector defining H(i). |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void COrtFac::SMatrixTD(CMatrixDouble &a,const int n,const bool IsUpper,
double &tau[],double &d[],double &e[])
{
CRowDouble Tau=tau;
CRowDouble D=d;
CRowDouble E=e;
SMatrixTD(a,n,IsUpper,Tau,D,E);
Tau.ToArray(tau);
D.ToArray(d);
E.ToArray(e);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::SMatrixTD(CMatrixDouble &a,const int n,const bool IsUpper,
CRowDouble &tau,CRowDouble &d,CRowDouble &e)
{
//--- check
if(n<=0)
return;
//--- create arrays
CRowDouble t;
CRowDouble t2;
CRowDouble t3;
//--- create variables
int i=0;
double alpha=0;
double taui=0;
double v=0;
int i_=0;
int i1_=0;
//--- allocation
t.Resize(n+1);
t2.Resize(n+1);
t3.Resize(n+1);
//--- check
if(n>1)
tau.Resize(n-1);
d.Resize(n);
//--- check
if(n>1)
e.Resize(n-1);
//---ALGLIB version
//--- check
if(IsUpper)
{
//--- Reduce the upper triangle of A
for(i=n-2; i>=0; i--)
{
//--- Generate elementary reflector H() = E - tau * v * v'
if(i>=1)
{
i1_=-2;
for(i_=2; i_<i+2; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
}
t.Set(1,a.Get(i,i+1));
CAblas::GenerateReflection(t,i+1,taui);
//--- check
if(i>=1)
{
i1_=2;
for(i_=0; i_<i; i_++)
a.Set(i_,i+1,t[i_+i1_]);
}
a.Set(i,i+1,t[1]);
e.Set(i,a.Get(i,i+1));
//--- check
if(taui!=0)
{
//--- Apply H from both sides to A
a.Set(i,i+1,1);
//--- Compute x := tau * A * v storing x in TAU
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
CSblas::SymmetricMatrixVectorMultiply(a,IsUpper,0,i,t,taui,t3);
i1_=1;
for(i_=0; i_<=i; i_++)
tau.Set(i_,t3[i_+i1_]);
//--- Compute w := x - 1/2 * tau * (x'*v) * v
v=0.0;
for(i_=0; i_<=i; i_++)
v+=tau[i_]*a.Get(i_,i+1);
alpha=-(0.5*taui*v);
for(i_=0; i_<=i; i_++)
tau.Set(i_,tau[i_]+alpha*a.Get(i_,i+1));
//--- Apply the transformation as a rank-2 update:
//--- A := A - v * w' - w * v'
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t3.Set(i_,tau[i_+i1_]);
CSblas::SymmetricRank2Update(a,IsUpper,0,i,t,t3,t2,-1);
a.Set(i,i+1,e[i]);
}
d.Set(i+1,a.Get(i+1,i+1));
tau.Set(i,taui);
}
d.Set(0,a.Get(0,0));
}
else
{
//--- Reduce the lower triangle of A
for(i=0; i<n-1; i++)
{
//--- Generate elementary reflector H = E - tau * v * v'
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CAblas::GenerateReflection(t,n-i-1,taui);
i1_=-i;
for(i_=i+1; i_<n; i_++)
a.Set(i_,i,t[i_+i1_]);
e.Set(i,a.Get(i+1,i));
if(taui!=0)
{
//--- Apply H from both sides to A
a.Set(i+1,i,1);
//--- Compute x := tau * A * v storing y in TAU
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CSblas::SymmetricMatrixVectorMultiply(a,IsUpper,i+1,n-1,t,taui,t2);
i1_=1-i;
for(i_=i; i_<n-1; i_++)
tau.Set(i_,t2[i_+i1_]);
//--- Compute w := x - 1/2 * tau * (x'*v) * v
i1_=1;
v=0.0;
for(i_=i; i_<=n-2; i_++)
v+=tau[i_]*a.Get(i_+i1_,i);
alpha=-(0.5*taui*v);
i1_=1;
for(i_=i; i_<n-1; i_++)
tau.Set(i_,tau[i_]+alpha*a.Get(i_+i1_,i));
//--- Apply the transformation as a rank-2 update:
//--- A := A - v * w' - w * v'
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
i1_=i-1;
for(i_=1; i_<n-i; i_++)
t2.Set(i_,tau[i_+i1_]);
CSblas::SymmetricRank2Update(a,IsUpper,i+1,n-1,t,t2,t3,-1);
a.Set(i+1,i,e[i]);
}
d.Set(i,a.Get(i,i));
tau.Set(i,taui);
}
d.Set(n-1,a.Get(n-1,n-1));
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix Q which reduces symmetric matrix to a |
//| tridiagonal form. |
//| Input parameters: |
//| A - the result of a SMatrixTD subroutine |
//| N - size of matrix A. |
//| IsUpper - storage format (a parameter of SMatrixTD |
//| subroutine) |
//| Tau - the result of a SMatrixTD subroutine |
//| Output parameters: |
//| Q - transformation matrix. |
//| array with elements [0..N-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::SMatrixTDUnpackQ(CMatrixDouble &a,const int n,const bool IsUpper,
double &tau[],CMatrixDouble &q)
{
CRowDouble Tau=tau;
SMatrixTDUnpackQ(a,n,IsUpper,Tau,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::SMatrixTDUnpackQ(CMatrixDouble &a,const int n,const bool IsUpper,
CRowDouble &tau,CMatrixDouble &q)
{
//--- check
if(n==0)
return;
//--- create arrays
CRowDouble v=vector<double>::Zeros(n+1);
CRowDouble work;
//--- create variables
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- allocation
work.Resize(n);
//--- identity matrix
q=matrix<double>::Identity(n,n);
//--- ALGLIB version: unpack Q
if(IsUpper)
{
for(i=0; i<n-1; i++)
{
//--- Apply H(i)
i1_=-1;
for(i_=1; i_<=i; i_++)
v.Set(i_,a.Get(i_+i1_,i+1));
v.Set(i+1,1);
//--- function call
CAblas::ApplyReflectionFromTheLeft(q,tau[i],v,0,i,0,n-1,work);
}
}
else
{
for(i=n-2; i>=0; i--)
{
//--- Apply H(i)
for(i_=1; i_<n-i; i_++)
v.Set(i_,a.Get(i_+i,i));
v.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheLeft(q,tau[i],v,i+1,n-1,0,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Reduction of a Hermitian matrix which is given by its higher or |
//| lower triangular part to a real tridiagonal matrix using unitary |
//| similarity transformation: Q'*A*Q = T. |
//| Input parameters: |
//| A - matrix to be transformed |
//| array with elements [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - storage format. If IsUpper = True, then matrix A |
//| is given by its upper triangle, and the lower |
//| triangle is not used and not modified by the |
//| algorithm, and vice versa if IsUpper = False. |
//| Output parameters: |
//| A - matrices T and Q in compact form (see lower) |
//| Tau - array of factors which are forming matrices H(i) |
//| array with elements [0..N-2]. |
//| D - main diagonal of real symmetric matrix T. |
//| array with elements [0..N-1]. |
//| E - secondary diagonal of real symmetric matrix T. |
//| array with elements [0..N-2]. |
//| If IsUpper=True, the matrix Q is represented as a product of |
//| elementary reflectors |
//| Q = H(n-2) . . . H(2) H(0). |
//| Each H(i) has the form |
//| H(i) = I - tau * v * v' |
//| where tau is a complex scalar, and v is a complex vector with |
//| v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in |
//| A(0:i-1,i+1), and tau in TAU(i). |
//| If IsUpper=False, the matrix Q is represented as a product of |
//| elementary reflectors |
//| Q = H(0) H(2) . . . H(n-2). |
//| Each H(i) has the form |
//| H(i) = I - tau * v * v' |
//| where tau is a complex scalar, and v is a complex vector with |
//| v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in |
//| A(i+2:n-1,i), and tau in TAU(i). |
//| The contents of A on exit are illustrated by the following |
//| examples with n = 5: |
//| if UPLO = 'U': if UPLO = 'L': |
//| ( d e v1 v2 v3 ) ( d ) |
//| ( d e v2 v3 ) ( e d ) |
//| ( d e v3 ) ( v0 e d ) |
//| ( d e ) ( v0 v1 e d ) |
//| ( d ) ( v0 v1 v2 e d ) |
//| where d and e denote diagonal and off-diagonal elements of T, and|
//| vi denotes an element of the vector defining H(i). |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void COrtFac::HMatrixTD(CMatrixComplex &a,const int n,const bool IsUpper,
complex &tau[],double &d[],double &e[])
{
CRowComplex Tau=tau;
CRowDouble D=d;
CRowDouble E=e;
HMatrixTD(a,n,IsUpper,Tau,D,E);
Tau.ToArray(tau);
D.ToArray(d);
E.ToArray(e);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::HMatrixTD(CMatrixComplex &a,const int n,const bool IsUpper,
CRowComplex &tau,CRowDouble &d,CRowDouble &e)
{
//--- check
if(n<=0)
return;
//--- create arrays
CRowComplex t;
CRowComplex t2;
CRowComplex t3;
//--- create variables
complex Half(0.5,0);
complex Zero(0,0);
complex _One(-1,0);
complex alpha=0;
complex taui=0;
complex v=0;
int i=0;
int i_=0;
int i1_=0;
for(i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(a.Get(i,i).imag==0))
return;
}
//--- allocation
if(n>1)
{
tau=vector<complex>::Full(n-1,0);
e=vector<double>::Zeros(n-1);
}
d=vector<double>::Zeros(n);
t=vector<complex>::Full(n,0);
t2=vector<complex>::Full(n,0);
t3=vector<complex>::Full(n,0);
//--- ALGLIB version
//--- check
if(IsUpper)
{
//--- Reduce the upper triangle of A
a.Set(n-1,n-1,a.Get(n-1,n-1).real);
for(i=n-2; i>=0; i--)
{
//--- Generate elementary reflector H = I+1 - tau * v * v'
alpha=a.Get(i,i+1);
t.Set(1,alpha);
//--- check
if(i>=1)
{
i1_=-2;
for(i_=2; i_<=i+1; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
}
//--- function call
CComplexReflections::ComplexGenerateReflection(t,i+1,taui);
//--- check
if(i>=1)
{
i1_=2;
for(i_=0; i_<i; i_++)
a.Set(i_,i+1,t[i_+i1_]);
}
//--- change values
alpha=t[1];
e.Set(i,alpha.real);
//--- check
if(taui!=Zero)
{
//--- Apply H(I+1) from both sides to A
a.Set(i,i+1,1.0);
//--- Compute x := tau * A * v storing x in TAU
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
CHblas::HermitianMatrixVectorMultiply(a,IsUpper,0,i,t,taui,t2);
i1_=1;
for(i_=0; i_<=i; i_++)
tau.Set(i_,t2[i_+i1_]);
//--- Compute w := x - 1/2 * tau * (x'*v) * v
v=0.0;
for(i_=0; i_<=i; i_++)
v+=CMath::Conj(tau[i_])*a.Get(i_,i+1);
//--- calculation
alpha=Half*taui*v;
for(i_=0; i_<=i; i_++)
tau.Set(i_,tau[i_]-alpha*a.Get(i_,i+1));
//--- Apply the transformation as a rank-2 update:
//--- A := A - v * w' - w * v'
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t.Set(i_,a.Get(i_+i1_,i+1));
i1_=-1;
for(i_=1; i_<=i+1; i_++)
t3.Set(i_,tau[i_+i1_]);
CHblas::HermitianRank2Update(a,IsUpper,0,i,t,t3,t2,_One);
}
else
a.Set(i,i,a.Get(i,i).real);
//--- change values
a.Set(i,i+1,e[i]);
d.Set(i+1,a.Get(i+1,i+1).real);
tau.Set(i,taui);
}
d.Set(0,a.Get(0,0).real);
}
else
{
//--- Reduce the lower triangle of A
a.Set(0,0,a.Get(0,0).real);
for(i=0; i<n-1; i++)
{
//--- Generate elementary reflector H = I - tau * v * v'
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
//--- function call
CComplexReflections::ComplexGenerateReflection(t,n-i-1,taui);
i1_=-i;
for(i_=i+1; i_<n; i_++)
a.Set(i_,i,t[i_+i1_]);
e.Set(i,a.Get(i+1,i).real);
//--- check
if(taui!=Zero)
{
//--- Apply H(i) from both sides to A(i+1:n,i+1:n)
a.Set(i+1,i,1.0);
//--- Compute x := tau * A * v storing y in TAU
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CHblas::HermitianMatrixVectorMultiply(a,IsUpper,i+1,n-1,t,taui,t2);
i1_=1-i;
for(i_=i; i_<n-1; i_++)
tau.Set(i_,t2[i_+i1_]);
//--- Compute w := x - 1/2 * tau * (x'*v) * v
i1_=1;
v=0.0;
for(i_=i; i_<n-1; i_++)
v+=CMath::Conj(tau[i_])*a.Get(i_+i1_,i);
//--- calculation
alpha=Half*taui*v;
i1_=1;
for(i_=i; i_<n-1; i_++)
tau.Set(i_,tau[i_]-alpha*a.Get(i_+i1_,i));
//--- Apply the transformation as a rank-2 update:
//--- A := A - v * w' - w * v'
i1_=i;
for(i_=1; i_<n-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
i1_=i-1;
for(i_=1; i_<n-i; i_++)
t2.Set(i_,tau[i_+i1_]);
CHblas::HermitianRank2Update(a,IsUpper,i+1,n-1,t,t2,t3,_One);
}
else
a.Set(i+1,i+1,a.Get(i+1,i+1).real);
//--- change values
a.Set(i+1,i,e[i]);
d.Set(i,a.Get(i,i).real);
tau.Set(i,taui);
}
d.Set(n-1,a.Get(n-1,n-1).real);
}
}
//+------------------------------------------------------------------+
//| Unpacking matrix Q which reduces a Hermitian matrix to a real |
//| tridiagonal form. |
//| Input parameters: |
//| A - the result of a HMatrixTD subroutine |
//| N - size of matrix A. |
//| IsUpper - storage format (a parameter of HMatrixTD |
//| subroutine) |
//| Tau - the result of a HMatrixTD subroutine |
//| Output parameters: |
//| Q - transformation matrix. |
//| array with elements [0..N-1, 0..N-1]. |
//+------------------------------------------------------------------+
void COrtFac::HMatrixTDUnpackQ(CMatrixComplex &a,const int n,const bool IsUpper,
complex &tau[],CMatrixComplex &q)
{
CRowComplex Tau=tau;
HMatrixTDUnpackQ(a,n,IsUpper,Tau,q);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void COrtFac::HMatrixTDUnpackQ(CMatrixComplex &a,const int n,const bool IsUpper,
CRowComplex &tau,CMatrixComplex &q)
{
//--- check
if(n==0)
return;
//--- create arrays
CRowComplex v;
CRowComplex work;
//--- create variables
int i=0;
int j=0;
int i_=0;
int i1_=0;
//--- allocation
v.Resize(n+1);
work.Resize(n+1);
//--- identity matrix
q=matrix<complex>::Identity(n,n);
//--- ALGLIB version
//--- unpack Q
if(IsUpper)
{
for(i=0; i<n-1; i++)
{
//--- Apply H(i)
i1_=-1;
for(i_=1; i_<=i; i_++)
v.Set(i_,a.Get(i_+i1_,i+1));
v.Set(i+1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheLeft(q,tau[i],v,0,i,0,n-1,work);
}
}
else
{
for(i=n-2; i>=0; i--)
{
//--- Apply H(i)
i1_=i;
for(i_=1; i_<n-i; i_++)
v.Set(i_,a.Get(i_+i1_,i));
v.Set(1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheLeft(q,tau[i],v,i+1,n-1,0,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Base case for real QR |
//+------------------------------------------------------------------+
void COrtFac::RMatrixQRBaseCase(CMatrixDouble &a,const int m,const int n,
CRowDouble &work,CRowDouble &t,CRowDouble &tau)
{
//--- create variables
int i=0;
int k=MathMin(m,n);
int minmn=MathMin(m,n);
double tmp=0;
int i_=0;
int i1_=0;
//--- calculations
for(i=0; i<k; i++)
{
//--- Generate elementary reflector H(i) to annihilate A(i+1:m,i)
i1_=i-1;
for(i_=1; i_<=m-i; i_++)
t.Set(i_,a.Get(i_+i1_,i));
CAblas::GenerateReflection(t,m-i,tmp);
tau.Set(i,tmp);
i1_=1-i;
for(i_=i; i_<m; i_++)
a.Set(i_,i,t[i_+i1_]);
t.Set(1,1);
//--- check
if(i<n)
{
//--- Apply H(i) to A(i:m-1,i+1:n-1) from the left
CAblas::ApplyReflectionFromTheLeft(a,tau[i],t,i,m-1,i+1,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Base case for real LQ |
//+------------------------------------------------------------------+
void COrtFac::RMatrixLQBaseCase(CMatrixDouble &a,const int m,const int n,
CRowDouble &work,CRowDouble &t,CRowDouble &tau)
{
//--- create variables
int i=0;
int k=MathMin(m,n);
int minmn=MathMin(m,n);
double tmp=0;
int i_=0;
int i1_=0;
//--- calculation
for(i=0; i<k; i++)
{
//--- Generate elementary reflector H(i) to annihilate A(i,i+1:n-1)
i1_=i-1;
for(i_=1; i_<=n-i; i_++)
t.Set(i_,a.Get(i,i_+i1_));
CAblas::GenerateReflection(t,n-i,tmp);
tau.Set(i,tmp);
i1_=1-i;
for(i_=i; i_<n; i_++)
a.Set(i,i_,t[i_+i1_]);
t.Set(1,1);
//--- check
if(i<n)
{
//--- Apply H(i) to A(i+1:m,i:n) from the right
CAblas::ApplyReflectionFromTheRight(a,tau[i],t,i+1,m-1,i,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Base case for complex QR |
//+------------------------------------------------------------------+
void COrtFac::CMatrixQRBaseCase(CMatrixComplex &a,const int m,const int n,
CRowComplex &work,CRowComplex &t,CRowComplex &tau)
{
//--- create variables
int i=0;
int k=MathMin(m,n);
int mmi=0;
int minmn=MathMin(m,n);
complex tmp=0;
int i_=0;
int i1_=0;
//--- check
if(minmn<=0)
return;
//--- calculation
for(i=0; i<k; i++)
{
//--- Generate elementary reflector H(i) to annihilate A(i+1:m,i)
mmi=m-i;
i1_=i-1;
for(i_=1; i_<=mmi; i_++)
t.Set(i_,a.Get(i_+i1_,i));
//--- function call
CComplexReflections::ComplexGenerateReflection(t,mmi,tmp);
tau.Set(i,tmp);
i1_=1-i;
for(i_=i; i_<m; i_++)
a.Set(i_,i,t[i_+i1_]);
t.Set(1,(complex)1);
//--- check
if(i<n-1)
{
//--- Apply H'(i) to A(i:m,i+1:n) from the left
complex tau_i=CMath::Conj(tau[i]);
CComplexReflections::ComplexApplyReflectionFromTheLeft(a,tau_i,t,i,m-1,i+1,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Base case for complex LQ |
//+------------------------------------------------------------------+
void COrtFac::CMatrixLQBaseCase(CMatrixComplex &a,const int m,const int n,
CRowComplex &work,CRowComplex &t,CRowComplex &tau)
{
//--- create variables
int i=0;
int minmn=MathMin(m,n);
complex tmp=0;
int i_=0;
int i1_=0;
//--- check
if(minmn<=0)
return;
//--- calculation
for(i=0; i<minmn; i++)
{
//--- Generate elementary reflector H(i)
//--- NOTE: ComplexGenerateReflection() generates left reflector,
//--- i.e. H which reduces x by applyiong from the left, but we
//--- need RIGHT reflector. So we replace H=E-tau*v*v' by H^H,
//--- which changes v to conj(v).
i1_=i-1;
for(i_=1; i_<=n-i; i_++)
t.Set(i_,CMath::Conj(a.Get(i,i_+i1_)));
CComplexReflections::ComplexGenerateReflection(t,n-i,tmp);
tau.Set(i,tmp);
i1_=1-i;
for(i_=i; i_<n; i_++)
a.Set(i,i_,CMath::Conj(t[i_+i1_]));
t.Set(1,1.0);
//--- check
if(i<m-1)
{
//--- Apply H'(i)
CComplexReflections::ComplexApplyReflectionFromTheRight(a,tau[i],t,i+1,m-1,i,n-1,work);
}
}
}
//+------------------------------------------------------------------+
//| Generate block reflector: |
//| * fill unused parts of reflectors matrix by zeros |
//| * fill diagonal of reflectors matrix by ones |
//| * generate triangular factor T |
//| PARAMETERS: |
//| A - either LengthA*BlockSize (if ColumnwiseA) or |
//| BlockSize*LengthA (if not ColumnwiseA) matrix|
//| of elementary reflectors. |
//| Modified on exit. |
//| Tau - scalar factors |
//| ColumnwiseA - reflectors are stored in rows or in columns |
//| LengthA - length of largest reflector |
//| BlockSize - number of reflectors |
//| T - array[BlockSize,2*BlockSize]. Left |
//| BlockSize*BlockSize submatrix stores |
//| triangular factor on exit. |
//| WORK - array[BlockSize] |
//+------------------------------------------------------------------+
void COrtFac::RMatrixBlockReflector(CMatrixDouble &a,CRowDouble &tau,
const bool columnwisea,const int lengtha,
const int blocksize,CMatrixDouble &t,CRowDouble &work)
{
//--- create variables
int i=0;
int j=0;
int k=0;
double v=0;
int i_=0;
int i1_=0;
//--- fill beginning of new column with zeros,
//--- load 1.0 in the first non-zero element
for(k=0; k<blocksize; k++)
{
//--- check
if(columnwisea)
{
for(i=0; i<k; i++)
a.Set(i,k,0);
}
else
{
for(i=0; i<k; i++)
a.Set(k,i,0);
}
a.Set(k,k,1);
}
//--- Calculate Gram matrix of A
for(i=0; i<blocksize; i++)
{
for(j=0; j<blocksize; j++)
t.Set(i,blocksize+j,0);
}
for(k=0; k<lengtha; k++)
{
for(j=1; j<blocksize; j++)
{
//--- check
if(columnwisea)
{
v=a.Get(k,j);
//--- check
if(v!=0)
{
i1_=-blocksize;
for(i_=blocksize; i_<blocksize+j; i_++)
t.Set(j,i_,(t.Get(j,i_)+v*a.Get(k,i_+i1_)));
}
}
else
{
v=a.Get(j,k);
//--- check
if(v!=0)
{
i1_=-blocksize;
for(i_=blocksize; i_<blocksize+j; i_++)
t.Set(j,i_,(t.Get(j,i_)+v*a.Get(i_+i1_,k)));
}
}
}
}
//--- Prepare Y (stored in TmpA) and T (stored in TmpT)
for(k=0; k<blocksize; k++)
{
//--- fill non-zero part of T, use pre-calculated Gram matrix
i1_=blocksize;
for(i_=0; i_<k; i_++)
work.Set(i_,t.Get(k,i_+i1_));
for(i=0; i<k; i++)
{
v=0.0;
for(i_=i; i_<k; i_++)
v+=t.Get(i,i_)*work[i_];
t.Set(i,k,-(tau[k]*v));
}
t.Set(k,k,-tau[k]);
//--- Rest of T is filled by zeros
for(i=k+1; i<blocksize; i++)
t.Set(i,k,0);
}
}
//+------------------------------------------------------------------+
//| Generate block reflector (complex): |
//| * fill unused parts of reflectors matrix by zeros |
//| * fill diagonal of reflectors matrix by ones |
//| * generate triangular factor T |
//+------------------------------------------------------------------+
void COrtFac::CMatrixBlockReflector(CMatrixComplex &a,CRowComplex &tau,
const bool columnwisea,const int lengtha,
const int blocksize,CMatrixComplex &t,CRowComplex &work)
{
//--- create variables
int i=0;
int k=0;
complex v=0;
int i_=0;
//--- Prepare Y (stored in TmpA) and T (stored in TmpT)
for(k=0; k<blocksize; k++)
{
//--- fill beginning of new column with zeros,
//--- load 1.0 in the first non-zero element
if(columnwisea)
{
for(i=0; i<k; i++)
a.Set(i,k,0.0);
}
else
{
for(i=0; i<k; i++)
a.Set(k,i,0.0);
}
a.Set(k,k,1.0);
//--- fill non-zero part of T
for(i=0; i<k; i++)
{
//--- check
if(columnwisea)
{
v=0.0;
for(i_=k; i_<lengtha; i_++)
v+=CMath::Conj(a.Get(i_,i))*a.Get(i_,k);
}
else
{
v=0.0;
for(i_=k; i_<lengtha; i_++)
v+=a.Get(i,i_)*CMath::Conj(a.Get(k,i_));
}
work.Set(i,v);
}
for(i=0; i<k; i++)
{
v=0.0;
for(i_=i; i_<k; i_++)
v+=t.Get(i,i_)*work[i_];
//--- change
t.Set(i,k,-tau[k]*v);
}
//--- change
t.Set(k,k,-tau[k]);
//--- Rest of T is filled by zeros
for(i=k+1; i<blocksize; i++)
t.Set(i,k,0.0);
}
}
//+------------------------------------------------------------------+
//| Sparse matrix structure. |
//| You should use ALGLIB functions to work with sparse matrix. Never|
//| try to access its fields directly! |
//| NOTES ON THE SPARSE STORAGE FORMATS |
//| Sparse matrices can be stored using several formats: |
//| * Hash-Table representation |
//| * Compressed Row Storage (CRS) |
//| * Skyline matrix storage (SKS) |
//| Each of the formats has benefits and drawbacks: |
//| * Hash-table is good for dynamic operations (insertion of new |
//| elements), but does not support linear algebra operations |
//| * CRS is good for operations like matrix-vector or matrix-matrix |
//| products, but its initialization is less convenient - you have |
//| to tell row sizes at the initialization, and you have to fill |
//| matrix only row by row, from left to right. |
//| * SKS is a special format which is used to store triangular |
//| factors from Cholesky factorization. It does not support |
//| dynamic modification, and support for linear algebra operations|
//| is very limited. |
//| Tables below outline information about these two formats: |
//| OPERATIONS WITH MATRIX HASH CRS SKS |
//| creation + + + |
//| SparseGet + + + |
//| SparseExists + + + |
//| SparseRewriteExisting + + + |
//| SparseSet + + + |
//| SparseAdd + |
//| SparseGetRow + + |
//| SparseGetCompressedRow + + |
//| sparse-dense linear algebra + + |
//+------------------------------------------------------------------+
struct CSparseMatrix
{
CRowDouble m_Vals;
CRowInt m_Idx;
CRowInt m_RIdx;
CRowInt m_DIdx;
CRowInt m_UIdx;
int m_MatrixType;
int m_M;
int m_N;
int m_NFree;
int m_NInitialized;
int m_TableSize;
CSparseMatrix(void) { Init(); }
~CSparseMatrix(void) {}
void Init(void);
void Copy(const CSparseMatrix &src);
//--- overloading
void operator=(const CSparseMatrix &src) { Copy(src); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparseMatrix::Init(void)
{
m_TableSize=0;
m_MatrixType=0;
m_M=0;
m_N=0;
m_NFree=0;
m_NInitialized=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparseMatrix::Copy(const CSparseMatrix &src)
{
m_Vals=src.m_Vals;
m_Idx=src.m_Idx;
m_RIdx=src.m_RIdx;
m_DIdx=src.m_DIdx;
m_UIdx=src.m_UIdx;
m_MatrixType=src.m_MatrixType;
m_M= src.m_M;
m_N=src.m_N;
m_NFree=src.m_NFree;
m_NInitialized=src.m_NInitialized;
m_TableSize=src.m_TableSize;
}
//+------------------------------------------------------------------+
//| Temporary buffers for sparse matrix operations. |
//| You should pass an instance of this structure to factorization |
//| functions. |
//| It allows to reuse memory during repeated sparse factorizations. |
//| You do not have to call some initialization function - simply |
//| passing an instance to factorization function is enough. |
//+------------------------------------------------------------------+
struct CSparseBuffers
{
int m_D[];
int m_U[];
CSparseMatrix m_S;
//--- Constructor
CSparseBuffers() {}
~CSparseBuffers() {}
void Init() {}
//--- Copy
void Copy(const CSparseBuffers &src);
void operator=(const CSparseBuffers &src) { Copy(src); }
};
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
void CSparseBuffers::Copy(const CSparseBuffers &src)
{
ArrayCopy(m_D,src.m_D);
ArrayCopy(m_U,src.m_U);
m_S=src.m_S;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
class CSparse
{
public:
static const double m_DesiredLoadFactor;
static const double m_MaxLoadFactor;
static const double m_GrowFactor;
static const int m_Additional;
static const int m_LinAlgSwitch;
//--- Init / Deinit
static void SparseInitDUIdx(CSparseMatrix &s);
static void SparseFree(CSparseMatrix &s);
//--- Sparse Create functions
static void SparseCreate(int m,int n,int k,CSparseMatrix &s);
static void SparseCreateBuf(int m,int n,int k,CSparseMatrix &s);
static void SparseCreateCRS(int m,int n,int &ner[],CSparseMatrix &s);
static void SparseCreateCRS(int m,int n,CRowInt &ner,CSparseMatrix &s);
static void SparseCreateCRSBuf(int m,int n,int &ner[],CSparseMatrix &s);
static void SparseCreateCRSBuf(int m,int n,CRowInt &ner,CSparseMatrix &s);
static void SparseCreateSKS(int m,int n,int &d[],int &u[],CSparseMatrix &s);
static void SparseCreateSKS(int m,int n,CRowInt &d,CRowInt &u,CSparseMatrix &s);
static void SparseCreateSKSBuf(int m,int n,int &d[],int &u[],CSparseMatrix &s);
static void SparseCreateSKSBuf(int m,int n,CRowInt &d,CRowInt &u,CSparseMatrix &s);
static void SparseCreateSKSBand(int m,int n,int bw,CSparseMatrix &s);
static void SparseCreateSKSBandBuf(int m,int n,int bw,CSparseMatrix &s);
static void SparseCreateCRSInplace(CSparseMatrix &s);
//--- Copy
static void SparseCopy(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyBuf(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseSwap(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyTransposeCRS(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyTransposeCRSBuf(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyToBuf(CSparseMatrix &s0,int fmt,CSparseMatrix &s1);
static void SparseCopyToHash(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyToHashBuf(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyToCRS(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyToCRSBuf(CSparseMatrix &s0,CSparseMatrix &s1);
//--- Modify
static void SparseAdd(CSparseMatrix &s,int i,int j,double v);
static void SparseSet(CSparseMatrix &s,int i,int j,double v);
static void SparseResizeMatrix(CSparseMatrix &s);
static bool SparseEnumerate(CSparseMatrix &s,int &t0,int &t1,int &i,int &j,double &v);
static bool SparseRewriteExisting(CSparseMatrix &s,int i,int j,double v);
static void SparseConvertTo(CSparseMatrix &s0,int fmt);
static void SparseConvertToHash(CSparseMatrix &s);
static void SparseConvertToCRS(CSparseMatrix &s);
static void SparseConvertToSKS(CSparseMatrix &s);
static void SparseCopyToSKS(CSparseMatrix &s0,CSparseMatrix &s1);
static void SparseCopyToSKSBuf(CSparseMatrix &s0,CSparseMatrix &s1);
//--- Data
static double SparseGet(CSparseMatrix &s,int i,int j);
static double SparseGetDiagonal(CSparseMatrix &s,int i);
static double SparseGetAverageLengthofChain(CSparseMatrix &s);
static void SparseGetRow(CSparseMatrix &s,int i,CRowDouble &irow);
static void SparseGetCompressedRow(CSparseMatrix &s,int i,CRowInt &ColIdx,CRowDouble &Vals,int &NZCnt);
static int SparseGetNRows(CSparseMatrix &s);
static int SparseGetNCols(CSparseMatrix &s);
static int SparseGetUpperCount(CSparseMatrix &s);
static int SparseGetLowerCount(CSparseMatrix &s);
//--- Check
static bool SparseExists(CSparseMatrix &s,int i,int j);
static int SparseGetMatrixType(CSparseMatrix &s);
static bool SparseIsHash(CSparseMatrix &s);
static bool SparseIsCRS(CSparseMatrix &s);
static bool SparseIsSKS(CSparseMatrix &s);
//--- Functions
static void SparseMV(CSparseMatrix &s,CRowDouble &x,CRowDouble &y);
static void SparseMV2(CSparseMatrix &s,CRowDouble &x,CRowDouble &y0,CRowDouble &y1);
static void SparseMTV(CSparseMatrix &s,CRowDouble &x,CRowDouble &y);
static void SparseGemV(CSparseMatrix &s,double alpha,int ops,CRowDouble &x,int ix,double beta,CRowDouble &y,int iy);
static void SparseSMV(CSparseMatrix &s,bool IsUpper,CRowDouble &x,CRowDouble &y);
static double SparseVSMV(CSparseMatrix &s,bool IsUpper,CRowDouble &x);
static void SparseMM(CSparseMatrix &s,CMatrixDouble &a,int k,CMatrixDouble &b);
static void SparseMM2(CSparseMatrix &s,CMatrixDouble &a,int k,CMatrixDouble &b0,CMatrixDouble &b1);
static void SparseMTM(CSparseMatrix &s,CMatrixDouble &a,int k,CMatrixDouble &b);
static void SparseSMM(CSparseMatrix &s,bool IsUpper,CMatrixDouble &a,int k,CMatrixDouble &b);
static void SparseTRMV(CSparseMatrix &s,bool IsUpper,bool IsUnit,int OpType,CRowDouble &x,CRowDouble &y);
static void SparseTRSV(CSparseMatrix &s,bool IsUpper,bool IsUnit,int OpType,CRowDouble &x);
static void SparseSymmPermTbl(CSparseMatrix &a,bool IsUpper,CRowInt &p,CSparseMatrix &b);
static void SparseSymmPermTblBuf(CSparseMatrix &a,bool IsUpper,CRowInt &p,CSparseMatrix &b);
static void SparseTransposeSKS(CSparseMatrix &s);
static void SparseTransposeCRS(CSparseMatrix &s);
//---Serializer
static void SparseAlloc(CSerializer &s,CSparseMatrix &a);
static void SparseSerialize(CSerializer &s,CSparseMatrix &a);
static void SparseUnserialize(CSerializer &s,CSparseMatrix &a);
static void SparseTrace(CSparseMatrix &m);
private:
static int Hash(int i,int j,int tabsize);
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
const double CSparse::m_DesiredLoadFactor=0.66;
const double CSparse::m_MaxLoadFactor=0.75;
const double CSparse::m_GrowFactor=2.00;
const int CSparse::m_Additional=10;
const int CSparse::m_LinAlgSwitch=16;
//+------------------------------------------------------------------+
//| This function creates sparse matrix in a Hash-Table format. |
//| This function creates Hast-Table matrix, which can be converted |
//| to CRS format after its initialization is over. Typical usage |
//| scenario for a sparse matrix is: |
//| 1. creation in a Hash-Table format |
//| 2. insertion of the matrix elements |
//| 3. conversion to the CRS representation |
//| 4. matrix is passed to some linear algebra algorithm |
//| Some information about different matrix formats can be found |
//| below, in the "NOTES" section. |
//| INPUT PARAMETERS: |
//| M - number of rows in a matrix, M>=1 |
//| N - number of columns in a matrix, N>=1 |
//| K - K>=0, expected number of non-zero elements in a |
//| matrix. K can be inexact approximation, can be less|
//| than actual number of elements (table will grow |
//| when needed) or even zero). |
//| It is important to understand that although hash-table may grow |
//| automatically, it's better to provide good estimate of data size.|
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table representation. All|
//| elements of the matrix are zero. |
//| NOTE 1 |
//| Hash-tables use memory inefficiently, and they have to keep some |
//| amount of the "spare memory" in order to have good performance. |
//| Hash table for matrix with K non-zero elements will need |
//| C*K*(8+2*sizeof(int)) bytes, where C is a small constant, about |
//| 1.5-2 in magnitude. |
//| CRS storage, from the other side, is more memory-efficient, and |
//| needs just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a |
//| number of rows in a matrix. |
//| When you convert from the Hash-Table to CRS representation, all |
//| unneeded memory will be freed. |
//| |
//| NOTE 2 |
//| Comments of SparseMatrix structure outline information about |
//| different sparse storage formats. We recommend you to read them |
//| before starting to use ALGLIB sparse matrices. |
//| |
//| NOTE 3 |
//| This function completely overwrites S with new sparse matrix. |
//| Previously allocated storage is NOT reused. If you want to reuse |
//| already allocated memory, call SparseCreateBuf function. |
//+------------------------------------------------------------------+
void CSparse::SparseCreate(int m,
int n,
int k,
CSparseMatrix &s)
{
SparseCreateBuf(m,n,k,s);
}
//+------------------------------------------------------------------+
//| This version of SparseCreate function creates sparse matrix in |
//| Hash-Table format, reusing previously allocated storage as much |
//| as possible.Read comments for SparseCreate() for more information|
//| INPUT PARAMETERS: |
//| M - number of rows in a matrix, M>=1 |
//| N - number of columns in a matrix, N>=1 |
//| K - K>=0, expected number of non-zero elements in a matrix|
//| K can be inexact approximation, can be less than |
//| actual number of elements (table will grow when needed|
//| or even zero). |
//| It is important to understand that although hash-table may grow |
//| automatically, it is better to provide good estimate of data size|
//| S - SparseMatrix structure which MAY contain some already |
//| allocated storage. |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table representation. All |
//| elements of the matrix are zero. Previously allocated |
//| storage is reused, if its size is compatible with |
//| expected number of non-zeros K. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateBuf(int m,
int n,
int k,
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(k>=0,__FUNCTION__+": K<0"))
return;
//--- create variables
int i=0;
//--- Hash-table size is max(existing_size,requested_size)
//--- NOTE: it is important to use ALL available memory for hash table
//--- because it is impossible to efficiently reallocate table
//--- without temporary storage. So, if we want table with up to
//--- 1.000.000 elements, we have to create such table from the
//--- very beginning. Otherwise, the very idea of memory reuse
//--- will be compromised.
s.m_TableSize=(int)MathRound(k/m_DesiredLoadFactor+m_Additional);
s.m_Vals=vector<double>::Zeros(s.m_TableSize);
s.m_TableSize=CAp::Len(s.m_Vals);
//--- Initialize other fields
s.m_MatrixType=0;
s.m_M=m;
s.m_N=n;
s.m_NFree=s.m_TableSize;
CApServ::IVectorSetLengthAtLeast(s.m_Idx,2*s.m_TableSize);
for(i=0; i<s.m_TableSize; i++)
s.m_Idx.Set(2*i,-1);
}
//+------------------------------------------------------------------+
//| This function creates sparse matrix in a CRS format (expert |
//| function for situations when you are running out of memory). |
//| This function creates CRS matrix. Typical usage scenario for a |
//| CRS matrix is: |
//| 1. creation (you have to tell number of non-zero elements at each|
//| row at this moment) |
//| 2. insertion of the matrix elements (row by row, from left to |
//| right) |
//| 3. matrix is passed to some linear algebra algorithm |
//| This function is a memory-efficient alternative to SparseCreate()|
//| but it is more complex because it requires you to know in advance|
//| how large your matrix is. Some information about different matrix|
//| formats can be found in comments on SparseMatrix structure. We |
//| recommend you to read them before starting to use ALGLIB sparse |
//| matrices.. |
//| INPUT PARAMETERS: |
//| M - number of rows in a matrix, M>=1 |
//| N - number of columns in a matrix, N>=1 |
//| NER - number of elements at each row, array[M], NER[I]>=0 |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS representation. |
//| You have to fill ALL non-zero elements by calling |
//| SparseSet() BEFORE you try to use this matrix. |
//| NOTE: this function completely overwrites S with new sparse |
//| matrix. Previously allocated storage is NOT reused. If you |
//| want to reuse already allocated memory, call |
//| SparseCreateCRSBuf function. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateCRS(int m,int n,CRowInt &ner,
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(CAp::Len(ner)>=m,__FUNCTION__+": Length(NER)<M"))
return;
for(int i=0; i<m; i++)
{
if(!CAp::Assert(ner[i]>=0,__FUNCTION__+": NER[] contains negative elements"))
return;
}
SparseCreateCRSBuf(m,n,ner,s);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparse::SparseCreateCRS(int m,int n,int &ner[],
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(CAp::Len(ner)>=m,__FUNCTION__+": Length(NER)<M"))
return;
for(int i=0; i<m; i++)
{
if(!CAp::Assert(ner[i]>=0,__FUNCTION__+": NER[] contains negative elements"))
return;
}
SparseCreateCRSBuf(m,n,ner,s);
}
//+------------------------------------------------------------------+
//| This function creates sparse matrix in a CRS format (expert |
//| function for situations when you are running out of memory). This|
//| version of CRS matrix creation function may reuse memory already |
//| allocated in S. |
//| This function creates CRS matrix. Typical usage scenario for a |
//| CRS matrix is: |
//| 1. creation (you have to tell number of non-zero elements at each|
//| row at this moment) |
//| 2. insertion of the matrix elements (row by row, from left to |
//| right) |
//| 3. matrix is passed to some linear algebra algorithm |
//| This function is a memory-efficient alternative to SparseCreate()|
//| but it is more complex because it requires you to know in advance|
//| how large your matrix is. Some information about different matrix|
//| formats can be found in comments on SparseMatrix structure. We |
//| recommend you to read them before starting to use ALGLIB sparse |
//| matrices.. |
//| INPUT PARAMETERS: |
//| M - number of rows in a matrix, M>=1 |
//| N - number of columns in a matrix, N>=1 |
//| NER - number of elements at each row, array[M], NER[I]>=0 |
//| S - sparse matrix structure with possibly preallocated |
//| memory. |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS representation. You have to |
//| fill ALL non-zero elements by calling SparseSet() |
//| BEFORE you try to use this matrix. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateCRSBuf(int m,
int n,
int &ner[],
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(CAp::Len(ner)>=m,__FUNCTION__+": Length(NER)<M"))
return;
//--- create variables
int noe=0;
s.m_MatrixType=1;
s.m_NInitialized=0;
s.m_M=m;
s.m_N=n;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,s.m_M+1);
s.m_RIdx.Set(0,0);
for(int i=0; i<s.m_M; i++)
{
//--- check
if(!CAp::Assert(ner[i]>=0,__FUNCTION__+": NER[] contains negative elements"))
return;
noe=noe+ner[i];
s.m_RIdx.Set(i+1,s.m_RIdx[i]+ner[i]);
}
CApServ::RVectorSetLengthAtLeast(s.m_Vals,noe);
CApServ::IVectorSetLengthAtLeast(s.m_Idx,noe);
if(noe==0)
SparseInitDUIdx(s);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparse::SparseCreateCRSBuf(int m,int n,CRowInt &ner,CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(CAp::Len(ner)>=m,__FUNCTION__+": Length(NER)<M"))
return;
//--- create variables
int noe=0;
s.m_MatrixType=1;
s.m_NInitialized=0;
s.m_M=m;
s.m_N=n;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,s.m_M+1);
s.m_RIdx.Set(0,0);
for(int i=0; i<s.m_M; i++)
{
//--- check
if(!CAp::Assert(ner[i]>=0,__FUNCTION__+": NER[] contains negative elements"))
return;
noe+=ner[i];
s.m_RIdx.Set(i+1,s.m_RIdx[i]+ner[i]);
}
s.m_Vals=vector<double>::Zeros(noe);
CApServ::IVectorSetLengthAtLeast(s.m_Idx,noe);
s.m_Idx.Fill(0);
if(noe==0)
SparseInitDUIdx(s);
}
//+------------------------------------------------------------------+
//| This function creates sparse matrix in a SKS format (skyline |
//| storage format). In most cases you do not need this function -CRS|
//| format better suits most use cases. |
//| INPUT PARAMETERS: |
//| M, N - number of rows(M) and columns(N) in a matrix: |
//| * M=N (as for now, ALGLIB supports only square SKS)|
//| * N>=1 |
//| * M>=1 |
//| D - "bottom" bandwidths, array[M],D[I]>=0. I-th element|
//| stores number of non-zeros at I-th row, below the |
//| diagonal (diagonal itself is not included) |
//| U - "top" bandwidths, array[N], U[I]>=0. I-th element |
//| stores number of non-zeros at I-th row, above the |
//| diagonal (diagonal itself is not included) |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in SKS representation. All |
//| elements are filled by zeros. You may use |
//| SparseSet() to change their values. |
//| NOTE: this function completely overwrites S with new sparse |
//| matrix. Previously allocated storage is NOT reused. If you |
//| want to reuse already allocated memory, call |
//| SparseCreateSKSBuf function. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKS(int m,int n,int &d[],int &u[],
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M<>N"))
return;
//--- check
if(!CAp::Assert(CAp::Len(d)>=m,__FUNCTION__+": Length(D)<M"))
return;
//--- check
if(!CAp::Assert(CAp::Len(u)>=n,__FUNCTION__+": Length(U)<N"))
return;
for(int i=0; i<m; i++)
{
//--- check
if(!CAp::Assert(d[i]>=0,__FUNCTION__+": D[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(d[i]<=i,__FUNCTION__+": D[I]>I for some I"))
return;
}
for(int i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(u[i]>=0,__FUNCTION__+": U[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(u[i]<=i,__FUNCTION__+": U[I]>I for some I"))
return;
}
SparseCreateSKSBuf(m,n,d,u,s);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKS(int m,int n,CRowInt &d,
CRowInt &u,CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M<>N"))
return;
//--- check
if(!CAp::Assert(CAp::Len(d)>=m,__FUNCTION__+": Length(D)<M"))
return;
//--- check
if(!CAp::Assert(CAp::Len(u)>=n,__FUNCTION__+": Length(U)<N"))
return;
for(int i=0; i<m; i++)
{
//--- check
if(!CAp::Assert(d[i]>=0,__FUNCTION__+": D[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(d[i]<=i,__FUNCTION__+": D[I]>I for some I"))
return;
}
for(int i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(u[i]>=0,__FUNCTION__+": U[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(u[i]<=i,__FUNCTION__+": U[I]>I for some I"))
return;
}
SparseCreateSKSBuf(m,n,d,u,s);
}
//+------------------------------------------------------------------+
//| This is "buffered" version of SparseCreateSKS() which reuses |
//| memory previously allocated in S (of course, memory is |
//| reallocated if needed). |
//| This function creates sparse matrix in a SKS format (skyline |
//| storage format). In most cases you do not need this function - |
//| CRS format better suits most use cases. |
//| INPUT PARAMETERS: |
//| M, N - number of rows(M) and columns (N) in a matrix: |
//| * M=N (as for now, ALGLIB supports only square SKS)|
//| * N>=1 |
//| * M>=1 |
//| D - "bottom" bandwidths, array[M], 0<=D[I]<=I. |
//| I-th element stores number of non-zeros at I-th row,|
//| below the diagonal (diagonal itself is not included)|
//| U - "top" bandwidths, array[N], 0<=U[I]<=I. I-th |
//| element stores number of non-zeros at I-th row,above|
//| the diagonal (diagonal itself is not included) |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in SKS representation. All |
//| elements are filled by zeros. You may use |
//| SparseSet() to change their values. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKSBuf(int m,int n,int &d[],int &u[],
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M<>N"))
return;
//--- check
if(!CAp::Assert(CAp::Len(d)>=m,__FUNCTION__+": Length(D)<M"))
return;
//--- check
if(!CAp::Assert(CAp::Len(u)>=n,__FUNCTION__+": Length(U)<N"))
return;
//--- create variables
int i=0;
int minmn=0;
int nz=0;
int mxd=0;
int mxu=0;
for(i=0; i<m; i++)
{
//--- check
if(!CAp::Assert(d[i]>=0,__FUNCTION__+": D[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(d[i]<=i,__FUNCTION__+": D[I]>I for some I"))
return;
}
for(i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(u[i]>=0,__FUNCTION__+": U[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(u[i]<=i,__FUNCTION__+": U[I]>I for some I"))
return;
}
minmn=MathMin(m,n);
s.m_MatrixType=2;
s.m_NInitialized=0;
s.m_M=m;
s.m_N=n;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,minmn+1);
s.m_RIdx.Set(0,0);
nz=0;
for(i=0; i<minmn; i++)
{
nz=nz+1+d[i]+u[i];
s.m_RIdx.Set(i+1,s.m_RIdx[i]+1+d[i]+u[i]);
}
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nz);
CAblasF::RSetV(nz,0,s.m_Vals);
CApServ::IVectorSetLengthAtLeast(s.m_DIdx,m+1);
mxd=0;
for(i=0; i<m; i++)
{
s.m_DIdx.Set(i,d[i]);
mxd=MathMax(mxd,d[i]);
}
s.m_DIdx.Set(m,mxd);
CApServ::IVectorSetLengthAtLeast(s.m_UIdx,n+1);
mxu=0;
for(i=0; i<n; i++)
{
s.m_UIdx.Set(i,u[i]);
mxu=MathMax(mxu,u[i]);
}
s.m_UIdx.Set(n,mxu);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKSBuf(int m,int n,CRowInt &d,CRowInt &u,
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M<>N"))
return;
//--- check
if(!CAp::Assert(CAp::Len(d)>=m,__FUNCTION__+": Length(D)<M"))
return;
//--- check
if(!CAp::Assert(CAp::Len(u)>=n,__FUNCTION__+": Length(U)<N"))
return;
//--- create variables
int i=0;
int minmn=0;
int nz=0;
int mxd=0;
int mxu=0;
for(i=0; i<m; i++)
{
//--- check
if(!CAp::Assert(d[i]>=0,__FUNCTION__+": D[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(d[i]<=i,__FUNCTION__+": D[I]>I for some I"))
return;
}
for(i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(u[i]>=0,__FUNCTION__+": U[] contains negative elements"))
return;
//--- check
if(!CAp::Assert(u[i]<=i,__FUNCTION__+": U[I]>I for some I"))
return;
}
minmn=MathMin(m,n);
s.m_MatrixType=2;
s.m_NInitialized=0;
s.m_M=m;
s.m_N=n;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,minmn+1);
s.m_RIdx.Set(0,0);
nz=0;
for(i=0; i<minmn; i++)
{
nz=nz+1+d[i]+u[i];
s.m_RIdx.Set(i+1,s.m_RIdx[i]+1+d[i]+u[i]);
}
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nz);
CAblasF::RSetV(nz,0,s.m_Vals);
CApServ::IVectorSetLengthAtLeast(s.m_DIdx,m+1);
mxd=0;
for(i=0; i<m; i++)
{
s.m_DIdx.Set(i,d[i]);
mxd=MathMax(mxd,d[i]);
}
s.m_DIdx.Set(m,mxd);
CApServ::IVectorSetLengthAtLeast(s.m_UIdx,n+1);
mxu=0;
for(i=0; i<n; i++)
{
s.m_UIdx.Set(i,u[i]);
mxu=MathMax(mxu,u[i]);
}
s.m_UIdx.Set(n,mxu);
}
//+------------------------------------------------------------------+
//| This function creates sparse matrix in a SKS format (skyline |
//| storage format). Unlike more general SparseCreateSKS(), this |
//| function creates sparse matrix with constant bandwidth. |
//| You may want to use this function instead of SparseCreateSKS() |
//| when your matrix has constant or nearly-constant bandwidth, and |
//| you want to simplify source code. |
//| INPUT PARAMETERS: |
//| M, N - number of rows(M) and columns (N) in a matrix: |
//| * M=N (as for now, ALGLIB supports only square SKS) |
//| * N>=1 |
//| * M>=1 |
//| BW - matrix bandwidth, BW>=0 |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in SKS representation. All elements |
//| are filled by zeros. You may use SparseSet() to change|
//| their values. |
//| NOTE: this function completely overwrites S with new sparse |
//| matrix. Previously allocated storage is NOT reused. If you |
//| want to reuse already allocated memory, call |
//| SparseCreateSKSBandBuf function. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKSBand(int m,int n,int bw,
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(bw>=0,__FUNCTION__+": BW<0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M!=N"))
return;
SparseCreateSKSBandBuf(m,n,bw,s);
}
//+------------------------------------------------------------------+
//| This is "buffered" version of SparseCreateSKSBand() which reuses |
//| memory previously allocated in S(of course, memory is reallocated|
//| if needed). |
//| You may want to use this function instead of SparseCreateSKSBuf()|
//| when your matrix has constant or nearly-constant bandwidth, and |
//| you want to simplify source code. |
//| INPUT PARAMETERS: |
//| M, N - number of rows(M) and columns (N) in a matrix: |
//| * M=N (as for now, ALGLIB supports only square SKS) |
//| * N>=1 |
//| * M>=1 |
//| BW - bandwidth, BW>=0 |
//| OUTPUT PARAMETERS: |
//| S - sparse M*N matrix in SKS representation. All elements |
//| are filled by zeros. You may use SparseSet() to change|
//| their values. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateSKSBandBuf(int m,int n,int bw,
CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": M!=N"))
return;
//--- check
if(!CAp::Assert(bw>=0,__FUNCTION__+": BW<0"))
return;
//--- create variables
int i=0;
int minmn=MathMin(m,n);
int nz=0;
int mxd=0;
int mxu=0;
int dui=0;
s.m_MatrixType=2;
s.m_NInitialized=0;
s.m_M=m;
s.m_N=n;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,minmn+1);
s.m_RIdx.Set(0,0.0);
for(i=0; i<minmn; i++)
{
dui=MathMin(i,bw);
nz=nz+1+2*dui;
s.m_RIdx.Set(i+1,s.m_RIdx[i]+1+2*dui);
}
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nz);
CAblasF::RSetV(nz,0.0,s.m_Vals);
CApServ::IVectorSetLengthAtLeast(s.m_DIdx,m+1);
for(i=0; i<m; i++)
{
dui=MathMin(i,bw);
s.m_DIdx.Set(i,dui);
mxd=MathMax(mxd,dui);
}
s.m_DIdx.Set(m,mxd);
CApServ::IVectorSetLengthAtLeast(s.m_UIdx,n+1);
for(i=0; i<n; i++)
{
dui=MathMin(i,bw);
s.m_UIdx.Set(i,dui);
mxu=MathMax(mxu,dui);
}
s.m_UIdx.Set(n,mxu);
}
//+------------------------------------------------------------------+
//| This function copies S0 to S1. |
//| This function completely deallocates memory owned by S1 before |
//| creating a copy of S0. If you want to reuse memory, use |
//| SparseCopyBuf. |
//| NOTE: this function does not verify its arguments, it just copies|
//| all fields of the structure. |
//+------------------------------------------------------------------+
void CSparse::SparseCopy(CSparseMatrix &s0,CSparseMatrix &s1)
{
SparseCopyBuf(s0,s1);
}
//+------------------------------------------------------------------+
//| This function copies S0 to S1. |
//| Memory already allocated in S1 is reused as much as possible. |
//| NOTE: this function does not verify its arguments, it just copies|
//| all fields of the structure. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyBuf(CSparseMatrix &s0,CSparseMatrix &s1)
{
//--- create variables
int l=0;
s1.m_MatrixType=s0.m_MatrixType;
s1.m_M=s0.m_M;
s1.m_N=s0.m_N;
s1.m_NFree=s0.m_NFree;
s1.m_NInitialized=s0.m_NInitialized;
s1.m_TableSize=s0.m_TableSize;
//--- Initialization for arrays
s1.m_Vals=s0.m_Vals;
l=CAp::Len(s0.m_RIdx);
CApServ::IVectorSetLengthAtLeast(s1.m_RIdx,l);
CAblasF::ICopyV(l,s0.m_RIdx,s1.m_RIdx);
l=CAp::Len(s0.m_Idx);
CApServ::IVectorSetLengthAtLeast(s1.m_Idx,l);
CAblasF::ICopyV(l,s0.m_Idx,s1.m_Idx);
//--- Initalization for CRS-parameters
l=CAp::Len(s0.m_UIdx);
CApServ::IVectorSetLengthAtLeast(s1.m_UIdx,l);
CAblasF::ICopyV(l,s0.m_UIdx,s1.m_UIdx);
l=CAp::Len(s0.m_DIdx);
CApServ::IVectorSetLengthAtLeast(s1.m_DIdx,l);
CAblasF::ICopyV(l,s0.m_DIdx,s1.m_DIdx);
}
//+------------------------------------------------------------------+
//| This function efficiently swaps contents of S0 and S1. |
//+------------------------------------------------------------------+
void CSparse::SparseSwap(CSparseMatrix &s0,CSparseMatrix &s1)
{
CApServ::Swap(s1.m_MatrixType,s0.m_MatrixType);
CApServ::Swap(s1.m_M,s0.m_M);
CApServ::Swap(s1.m_N,s0.m_N);
CApServ::Swap(s1.m_NFree,s0.m_NFree);
CApServ::Swap(s1.m_NInitialized,s0.m_NInitialized);
CApServ::Swap(s1.m_TableSize,s0.m_TableSize);
CAp::Swap(s1.m_Vals,s0.m_Vals);
CAp::Swap(s1.m_RIdx,s0.m_RIdx);
CAp::Swap(s1.m_Idx,s0.m_Idx);
CAp::Swap(s1.m_UIdx,s0.m_UIdx);
CAp::Swap(s1.m_DIdx,s0.m_DIdx);
}
//+------------------------------------------------------------------+
//| This function adds value to S[i,j] - element of the sparse matrix|
//| Matrix must be in a Hash-Table mode. |
//| In case S[i,j] already exists in the table, V i added to its |
//| value. In case S[i,j] is non-existent, it is inserted in the |
//| table. Table automatically grows when necessary. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table representation. |
//| Exception will be thrown for CRS matrix. |
//| I - row index of the element to modify, 0<=I<M |
//| J - column index of the element to modify, 0<=J<N |
//| V - value to add, must be finite number |
//| OUTPUT PARAMETERS: |
//| S - modified matrix |
//| NOTE 1: when S[i,j] is exactly zero after modification, it is |
//| deleted from the table. |
//+------------------------------------------------------------------+
void CSparse::SparseAdd(CSparseMatrix &s,int i,int j,double v)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==0,__FUNCTION__+": matrix must be in the Hash-Table mode to do this operation"))
return;
//--- check
if(!CAp::Assert(i>=0,__FUNCTION__+": I<0"))
return;
//--- check
if(!CAp::Assert(i<s.m_M,__FUNCTION__+": I>=M"))
return;
//--- check
if(!CAp::Assert(j>=0,__FUNCTION__+": J<0"))
return;
//--- check
if(!CAp::Assert(j<s.m_N,__FUNCTION__+": J>=N"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(v) || v==0.0,__FUNCTION__+": V is not finite number"))
return;
//--- create variables
int hashcode=0;
int tcode=-1;
int k=s.m_TableSize;
if((double)((1-m_MaxLoadFactor)*k)>=(double)(s.m_NFree))
{
SparseResizeMatrix(s);
k=s.m_TableSize;
}
hashcode=Hash(i,j,k);
while(true)
{
if(s.m_Idx[2*hashcode]==-1)
{
if(tcode!=-1)
hashcode=tcode;
s.m_Vals.Set(hashcode,v);
s.m_Idx.Set(2*hashcode,i);
s.m_Idx.Set(2*hashcode+1,j);
if(tcode==-1)
s.m_NFree--;
return;
}
else
{
if(s.m_Idx[2*hashcode]==i && s.m_Idx[2*hashcode+1]==j)
{
s.m_Vals.Set(hashcode,s.m_Vals[hashcode]+v);
if(s.m_Vals[hashcode]==0.0)
s.m_Idx.Set(2*hashcode,-2);
return;
}
//--- Is it deleted element?
if(tcode==-1 && s.m_Idx[2*hashcode]==-2)
tcode=hashcode;
//--- Next step
hashcode=(hashcode+1)%k;
}
}
}
//+------------------------------------------------------------------+
//| This function modifies S[i,j] - element of the sparse matrix. |
//| For Hash-based storage format: |
//| * this function can be called at any moment - during matrix |
//| initialization or later |
//| * new value can be zero or non-zero. In case new value of S[i,j] |
//| is zero, this element is deleted from the table. |
//| * this function has no effect when called with zero V for |
//| non-existent element. |
//| For CRS-bases storage format: |
//| * this function can be called ONLY DURING MATRIX INITIALIZATION |
//| * zero values are stored in the matrix similarly to non-zero ones|
//| * elements must be initialized in correct order - from top row |
//| to bottom, within row - from left to right. |
//| For SKS storage: |
//| * this function can be called at any moment - during matrix |
//| initialization or later |
//| * zero values are stored in the matrix similarly to non-zero ones|
//| * this function CAN NOT be called for non-existent (outside of |
//| the band specified during SKS matrix creation) elements. Say, |
//| if you created SKS matrix with bandwidth=2 and tried to call |
//| SparseSet(s,0,10,VAL), an exception will be generated. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table, SKS or CRS format. |
//| I - row index of the element to modify, 0<=I<M |
//| J - column index of the element to modify, 0<=J<N |
//| V - value to set, must be finite number, can be zero |
//| OUTPUT PARAMETERS: |
//| S - modified matrix |
//+------------------------------------------------------------------+
void CSparse::SparseSet(CSparseMatrix &s,int i,int j,double v)
{
//--- check
if(!CAp::Assert((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2,__FUNCTION__+": unsupported matrix storage format"))
return;
//--- check
if(!CAp::Assert(i>=0,__FUNCTION__+": I<0"))
return;
//--- check
if(!CAp::Assert(i<s.m_M,__FUNCTION__+": I>=M"))
return;
//--- check
if(!CAp::Assert(j>=0,__FUNCTION__+": J<0"))
return;
//--- check
if(!CAp::Assert(j<s.m_N,__FUNCTION__+": J>=N"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(v),__FUNCTION__+": V is not finite number"))
return;
//--- create variables
int hashcode=0;
int tcode=0;
int k=0;
bool b=false;
//--- Hash-table matrix
if(s.m_MatrixType==0)
{
tcode=-1;
k=s.m_TableSize;
if((double)((1-m_MaxLoadFactor)*k)>=(double)(s.m_NFree))
{
SparseResizeMatrix(s);
k=s.m_TableSize;
}
hashcode=Hash(i,j,k);
while(true)
{
if(s.m_Idx[2*hashcode]==-1)
{
if((double)(v)!=0.0)
{
if(tcode!=-1)
hashcode=tcode;
s.m_Vals.Set(hashcode,v);
s.m_Idx.Set(2*hashcode,i);
s.m_Idx.Set(2*hashcode+1,j);
if(tcode==-1)
s.m_NFree--;
}
return;
}
else
{
if(s.m_Idx[2*hashcode]==i && s.m_Idx[2*hashcode+1]==j)
{
if(v==0.0)
s.m_Idx.Set(2*hashcode,-2);
else
s.m_Vals.Set(hashcode,v);
return;
}
if(tcode==-1 && s.m_Idx[2*hashcode]==-2)
tcode=hashcode;
//--- Next step
hashcode=(hashcode+1)%k;
}
}
}
//--- CRS matrix
if(s.m_MatrixType==1)
{
//--- check
if(!CAp::Assert(s.m_RIdx[i]<=s.m_NInitialized,__FUNCTION__+": too few initialized elements at some row (you have promised more when called SparceCreateCRS)"))
return;
//--- check
if(!CAp::Assert(s.m_RIdx[i+1]>s.m_NInitialized,__FUNCTION__+": too many initialized elements at some row (you have promised less when called SparceCreateCRS)"))
return;
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[i] || s.m_Idx[s.m_NInitialized-1]<j,__FUNCTION__+": incorrect column order (you must fill every row from left to right)"))
return;
s.m_Vals.Set(s.m_NInitialized,v);
s.m_Idx.Set(s.m_NInitialized,j);
s.m_NInitialized++;
//--- If matrix has been created then
//--- initiale 'S.m_UIdx' and 'S.m_DIdx'
if(s.m_NInitialized==s.m_RIdx[s.m_M])
SparseInitDUIdx(s);
return;
}
//--- SKS matrix
if(s.m_MatrixType==2)
{
b=SparseRewriteExisting(s,i,j,v);
//--- check
CAp::Assert(b,__FUNCTION__+": an attempt to initialize out-of-band element of the SKS matrix");
return;
}
}
//+------------------------------------------------------------------+
//| This function returns S[i,j] - element of the sparse matrix. |
//| Matrix can be in any mode (Hash-Table, CRS, SKS), but this |
//| function is less efficient for CRS matrices. Hash-Table and SKS |
//| matrices can find element in O(1) time, while CRS matrices need |
//| O(log(RS)) time, where RS is an number of non-zero elements in a |
//| row. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix |
//| I - row index of the element to modify, 0<=I<M |
//| J - column index of the element to modify, 0<=J<N |
//| RESULT |
//| value of S[I,J] or zero (in case no element with such index is |
//| found) |
//+------------------------------------------------------------------+
double CSparse::SparseGet(CSparseMatrix &s,int i,int j)
{
//--- check
if(!CAp::Assert(i>=0,__FUNCTION__+": I<0"))
return(0);
//--- check
if(!CAp::Assert(i<s.m_M,__FUNCTION__+": I>=M"))
return(0);
//--- check
if(!CAp::Assert(j>=0,__FUNCTION__+": J<0"))
return(0);
//--- check
if(!CAp::Assert(j<s.m_N,__FUNCTION__+": J>=N"))
return(0);
//--- create variables
double result=0;
int hashcode=0;
int k=0;
int k0=0;
int k1=0;
switch(s.m_MatrixType)
{
case 0:
//--- Hash-based storage
result=0;
k=s.m_TableSize;
hashcode=Hash(i,j,k);
while(true)
{
if(s.m_Idx[2*hashcode]==-1)
return(result);
if(s.m_Idx[2*hashcode]==i && s.m_Idx[2*hashcode+1]==j)
{
result=s.m_Vals[hashcode];
break;
}
hashcode=(hashcode+1)%k;
}
break;
case 1:
//--- CRS
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return(-1);
k0=s.m_RIdx[i];
k1=s.m_RIdx[i+1]-1;
result=0;
while(k0<=k1)
{
k=(k0+k1)/2;
if(s.m_Idx[k]==j)
{
result=s.m_Vals[k];
break;
}
if(s.m_Idx[k]<j)
k0=k+1;
else
k1=k-1;
}
break;
case 2:
//--- SKS
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrix not supported"))
return(-1);
result=0;
if(i==j)
{
//--- Return diagonal element
result=s.m_Vals[s.m_RIdx[i]+s.m_DIdx[i]];
break;
}
if(j<i)
{
//--- Return subdiagonal element at I-th "skyline block"
k=s.m_DIdx[i];
if(i-j<=k)
result=s.m_Vals[s.m_RIdx[i]+k+j-i];
}
else
{
//--- Return superdiagonal element at J-th "skyline block"
k=s.m_UIdx[j];
if(j-i<=k)
result=s.m_Vals[s.m_RIdx[j+1]-(j-i)];
}
break;
default:
CAp::Assert(false,__FUNCTION__+": unexpected matrix type");
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function checks whether S[i,j] is present in the sparse |
//| matrix. It returns True even for elements that are numerically |
//| zero (but still have place allocated for them). |
//| The matrix can be in any mode (Hash-Table, CRS, SKS), but this |
//| function is less efficient for CRS matrices. Hash-Table and SKS |
//| matrices can find element in O(1) time, while CRS matrices need |
//| O(log(RS)) time, where RS is an number of non-zero elements in a |
//| row. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix |
//| I - row index of the element to modify, 0<=I<M |
//| J - column index of the element to modify, 0<=J<N |
//| RESULT |
//| whether S[I,J] is present in the data structure or not |
//+------------------------------------------------------------------+
bool CSparse::SparseExists(CSparseMatrix &s,int i,int j)
{
//--- check
if(!CAp::Assert(i>=0,__FUNCTION__+": I<0"))
return(false);
//--- check
if(!CAp::Assert(i<s.m_M,__FUNCTION__+": I>=M"))
return(false);
//--- check
if(!CAp::Assert(j>=0,__FUNCTION__+": J<0"))
return(false);
//--- check
if(!CAp::Assert(j<s.m_N,__FUNCTION__+": J>=N"))
return(false);
//--- create variables
bool result=false;
int hashcode=0;
int k=0;
int k0=0;
int k1=0;
switch(s.m_MatrixType)
{
case 0:
//--- Hash-based storage
k=s.m_TableSize;
hashcode=Hash(i,j,k);
while(true)
{
if(s.m_Idx[2*hashcode]==-1)
return(result);
if(s.m_Idx[2*hashcode]==i && s.m_Idx[2*hashcode+1]==j)
{
result=true;
break;
}
hashcode=(hashcode+1)%k;
}
break;
case 1:
//--- CRS
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return(false);
k0=s.m_RIdx[i];
k1=s.m_RIdx[i+1]-1;
while(k0<=k1)
{
k=(k0+k1)/2;
if(s.m_Idx[k]==j)
{
result=true;
break;
}
if(s.m_Idx[k]<j)
k0=k+1;
else
k1=k-1;
}
break;
case 2:
//--- SKS
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrix not supported"))
return(false);
if(i==j)
{
//--- Return diagonal element
result=true;
break;
}
if(j<i)
{
//--- Return subdiagonal element at I-th "skyline block"
if(i-j<=s.m_DIdx[i])
result=true;
}
else
{
//--- Return superdiagonal element at J-th "skyline block"
if(j-i<=s.m_UIdx[j])
result=true;
}
break;
default:
CAp::Assert(false,__FUNCTION__+": unexpected matrix type");
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function returns I-th diagonal element of the sparse matrix.|
//| Matrix can be in any mode (Hash-Table or CRS storage), but this |
//| function is most efficient for CRS matrices - it requires less |
//| than 50 CPU cycles to extract diagonal element. For Hash-Table |
//| matrices we still have O(1) query time, but function is many |
//| times slower. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table representation. |
//| Exception will be thrown for CRS matrix. |
//| I - index of the element to modify, 0<=I<min(M,N) |
//| RESULT |
//| value of S[I,I] or zero (in case no element with such index is |
//| found) |
//+------------------------------------------------------------------+
double CSparse::SparseGetDiagonal(CSparseMatrix &s,int i)
{
//--- check
if(!CAp::Assert(i>=0,__FUNCTION__+": I<0"))
return(0);
//--- check
if(!CAp::Assert(i<s.m_M,__FUNCTION__+": I>=M"))
return(0);
//--- check
if(!CAp::Assert(i<s.m_N,__FUNCTION__+": I>=N"))
return(0);
double result=0;
switch(s.m_MatrixType)
{
case 0:
result=SparseGet(s,i,i);
break;
case 1:
if(s.m_DIdx[i]!=s.m_UIdx[i])
result=s.m_Vals[s.m_DIdx[i]];
break;
case 2:
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrix not supported"))
return(0);
result=s.m_Vals[s.m_RIdx[i]+s.m_DIdx[i]];
break;
default:
if(!CAp::Assert(false,__FUNCTION__+": unexpected matrix type"))
return(0);
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function calculates matrix-vector product S*x. Matrix S must|
//| be stored in CRS or SKS format (exception will be thrown |
//| otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS or SKS format. |
//| X - array[N], input vector. For performance reasons we |
//| make only quick checks - we check that array size is |
//| at least N, but we do not check for NAN's or INF's. |
//| Y - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| Y - array[M], S*x |
//| NOTE: this function throws exception when called for |
//| non-CRS/SKS matrix. You must convert your matrix with |
//| SparseConvertToCRS/SKS() before using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMV(CSparseMatrix &s,CRowDouble &x,
CRowDouble &y)
{
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_N,__FUNCTION__+": length(X)<N"))
return;
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- create variables
double tval=0;
double v=0;
double vv=0;
int i=0;
int j=0;
int lt=0;
int rt=0;
int lt1=0;
int rt1=0;
int n=s.m_N;
int m=s.m_M;
int d=0;
int u=0;
int ri=0;
int ri1=0;
int i_=0;
int i1_=0;
CApServ::RVectorSetLengthAtLeast(y,s.m_M);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format.
//--- Perform integrity check.
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
//--- Our own implementation
for(i=0; i<m; i++)
{
tval=0;
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1]-1;
for(j=lt; j<=rt; j++)
tval+=x[s.m_Idx[j]]*s.m_Vals[j];
y.Set(i,tval);
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
v=s.m_Vals[ri+d]*x[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
v=v+vv;
}
y.Set(i,v);
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates matrix-vector product S^T*x. Matrix S |
//| must be stored in CRS or SKS format (exception will be thrown |
//| otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS or SKS format. |
//| X - array[M], input vector. For performance reasons we |
//| make only quick checks - we check that array size is |
//| at least M, but we do not check for NAN's or INF's. |
//| Y - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| Y - array[N], S^T*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMTV(CSparseMatrix &s,CRowDouble &x,
CRowDouble &y)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_M,__FUNCTION__+": Length(X)<M"))
return;
//--- create variables
int i=0;
int j=0;
int lt=0;
int rt=0;
int ct=0;
int lt1=0;
int rt1=0;
double v=0;
double vv=0;
int n=s.m_N;
int m=s.m_M;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int i_=0;
int i1_=0;
CApServ::RVectorSetLengthAtLeast(y,n);
CAblasF::RSetV(n,0,y);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- Perform integrity check.
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[m],"SparseMTV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
//--- Our own implementation
for(i=0; i<m; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
v=x[i];
for(j=lt; j<rt; j++)
{
ct=s.m_Idx[j];
y.Set(ct,y[ct]+v*s.m_Vals[j]);
}
}
break;
case 2:
//--- SKS format
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
v=s.m_Vals[ri+d]*x[i];
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
v=v+vv;
}
y.Set(i,v);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates generalized sparse matrix-vector product|
//| y := alpha*op(S)*x + beta*y |
//| Matrix S must be stored in CRS or SKS format (exception will be |
//| thrown otherwise). op(S) can be either S or S^T. |
//| NOTE: this function expects Y to be large enough to store result.|
//| No automatic preallocation happens for smaller arrays. |
//| INPUT PARAMETERS: |
//| S - sparse matrix in CRS or SKS format. |
//| Alpha - source coefficient |
//| OpS - operation type: |
//| * OpS=0 => op(S) = S |
//| * OpS=1 => op(S) = S^T |
//| X - input vector, must have at least Cols(op(S))+IX |
//| elements |
//| IX - subvector offset |
//| Beta - destination coefficient |
//| Y - preallocated output array, must have at least |
//| Rows(op(S))+IY elements |
//| IY - subvector offset |
//| OUTPUT PARAMETERS: |
//| Y - elements [IY...IY+Rows(op(S))-1] are replaced by |
//| result, other elements are not modified |
//| HANDLING OF SPECIAL CASES: |
//| * below M=Rows(op(S)) and N=Cols(op(S)). Although current |
//| ALGLIB version does not allow you to create zero-sized sparse|
//| matrices, internally ALGLIB can deal with such matrices. So, |
//| comments for M or N equal to zero are for internal use only. |
//| * if M=0, then subroutine does nothing. It does not even touch |
//| arrays. |
//| * if N=0 or Alpha=0.0, then: |
//| * if Beta=0, then Y is filled by zeros. S and X are not |
//| referenced at all. Initial values of Y are ignored (we do not|
//| multiply Y by zero, we just rewrite it by zeros) |
//| * if Beta<>0, then Y is replaced by Beta*Y |
//| * if M>0, N>0, Alpha<>0, but Beta=0, then Y is areplaced by |
//| alpha*op(S)*x initial state of Y is ignored (rewritten |
//| without initial multiplication by zeros). |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseGemV(CSparseMatrix &s,double alpha,int ops,
CRowDouble &x,int ix,double beta,
CRowDouble &y,int iy)
{
//--- check
if(!CAp::Assert(ops==0 || ops==1,__FUNCTION__+": incorrect OpS"))
return;
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- create variables
int opm=0;
int opn=0;
int rawm=0;
int rawn=0;
int i=0;
int j=0;
double tval=0;
int lt=0;
int rt=0;
int ct=0;
int d=0;
int u=0;
int ri=0;
int ri1=0;
double v=0;
double vv=0;
int lt1=0;
int rt1=0;
int i_=0;
int i1_=0;
if(ops==0)
{
opm=s.m_M;
opn=s.m_N;
}
else
{
opm=s.m_N;
opn=s.m_M;
}
//--- Quick exit strategies
if(opm==0)
return;
//--- check
if(!CAp::Assert(opm>=0 && opn>=0,__FUNCTION__+": op(S) has negative size"))
return;
//--- check
if(!CAp::Assert(opn==0 || CAp::Len(x)+ix>=opn,__FUNCTION__+": X is too short"))
return;
//--- check
if(!CAp::Assert(opm==0 || CAp::Len(y)+iy>=opm,__FUNCTION__+": X is too short"))
return;
rawm=s.m_M;
rawn=s.m_N;
if(beta!=0.0)
{
for(i=0; i<opm; i++)
y.Mul(iy+i,beta);
}
else
for(i=0; i<opm; i++)
y.Set(iy+i,0);
if(opn==0 || alpha==0.0)
return;
//--- Now we have OpM>=1, OpN>=1, Alpha<>0
if(ops==0)
{
//--- Compute generalized product y := alpha*S*x + beta*y
//--- (with "beta*y" part already computed).
switch(s.m_MatrixType)
{
case 1:
//--- CRS format.
//--- Perform integrity check.
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
//--- ALGLIB implementation
for(i=0; i<rawm; i++)
{
tval=0;
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1]-1;
for(j=lt; j<=rt; j++)
tval=tval+x[s.m_Idx[j]+ix]*s.m_Vals[j];
y.Set(i+iy,alpha*tval+y[i+iy]);
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<rawn; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
v=s.m_Vals[ri+d]*x[i+ix];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d+ix;
rt1=i-1+ix;
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
v=v+vv;
}
y.Set(i+iy,alpha*v+y[i+iy]);
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u+iy;
rt1=i-1+iy;
v=alpha*x[i+ix];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
}
break;
}
}
else
{
//--- Compute generalized product y := alpha*S^T*x + beta*y
//--- (with "beta*y" part already computed).
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- Perform integrity check.
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
//--- ALGLIB implementation
for(i=0; i<rawm; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
v=alpha*x[i+ix];
for(j=lt; j<rt; j++)
{
ct=s.m_Idx[j]+iy;
y.Set(ct,y[ct]+v*s.m_Vals[j]);
}
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<rawn; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d+iy;
rt1=i-1+iy;
v=alpha*x[i+ix];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
v=alpha*s.m_Vals[ri+d]*x[i+ix];
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u+ix;
rt1=i-1+ix;
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
v=v+alpha*vv;
}
y.Set(i+iy,v+y[i+iy]);
}
break;
}
}
}
//+------------------------------------------------------------------+
//| This function simultaneously calculates two matrix-vector |
//| products: |
//| S*x and S^T*x. |
//| S must be square (non-rectangular) matrix stored in CRS or SKS |
//| format (exception will be thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse N*N matrix in CRS or SKS format. |
//| X - array[N], input vector. For performance reasons we |
//| make only quick checks - we check that array size is |
//| at least N, but we do not check for NAN's or INF's. |
//| Y0 - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| Y1 - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| Y0 - array[N], S*x |
//| Y1 - array[N], S^T*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMV2(CSparseMatrix &s,CRowDouble &x,
CRowDouble &y0,CRowDouble &y1)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- create variables
int l=CAp::Len(x);
double tval=0;
int i=0;
int j=0;
double vx=0;
double vs=0;
double v=0;
double vv=0;
double vd0=0;
double vd1=0;
int vi=0;
int j0=0;
int j1=0;
int n=0;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int lt=0;
int rt=0;
int lt1=0;
int rt1=0;
int i_=0;
int i1_=0;
//--- check
if(!CAp::Assert(l>=s.m_N,__FUNCTION__+": Length(X)<N"))
return;
n=s.m_N;
CApServ::RVectorSetLengthAtLeast(y0,l);
CApServ::RVectorSetLengthAtLeast(y1,l);
y0.Fill(0.0);
y1.Fill(0);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
for(i=0; i<s.m_M; i++)
{
tval=0;
vx=x[i];
j0=s.m_RIdx[i];
j1=s.m_RIdx[i+1]-1;
for(j=j0; j<=j1; j++)
{
vi=s.m_Idx[j];
vs=s.m_Vals[j];
tval=tval+x[vi]*vs;
y1.Set(vi,y1[vi]+vx*vs);
}
y0.Set(i,tval);
}
break;
case 2:
//--- SKS format
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
vd0=s.m_Vals[ri+d]*x[i];
vd1=vd0;
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y1.Set(i_,y1[i_]+v*s.m_Vals[i_+i1_]);
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
vd0=vd0+vv;
}
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y0.Set(i_,y0[i_]+v*s.m_Vals[i_+i1_]);
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
vd1=vd1+vv;
}
y0.Set(i,vd0);
y1.Set(i,vd1);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates matrix-vector product S*x, when S is |
//| symmetric matrix. Matrix S must be stored in CRS or SKS format |
//| (exception will be thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*M matrix in CRS or SKS format. |
//| IsUpper - whether upper or lower triangle of S is given: |
//| * if upper triangle is given, only S[i,j] for j>=i |
//| are used, and lower triangle is ignored (it can be |
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only S[i,j] for j<=i |
//| are used, and upper triangle is ignored. |
//| X - array[N], input vector. For performance reasons we |
//| make only quick checks - we check that array size is|
//| at least N, but we do not check for NAN's or INF's. |
//| Y - output buffer, possibly preallocated.In case buffer|
//| size is too small to store result, this buffer is|
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| Y - array[M], S*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseSMV(CSparseMatrix &s,bool IsUpper,
CRowDouble &x,CRowDouble &y)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_N,__FUNCTION__+": length(X)<N"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square matrix"))
return;
//--- create variables
int n=s.m_N;
int i=0;
int j=0;
int id=0;
int lt=0;
int rt=0;
double v=0;
double vv=0;
double vy=0;
double vx=0;
double vd=0;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int lt1=0;
int rt1=0;
int i_=0;
int i1_=0;
CApServ::RVectorSetLengthAtLeast(y,n);
y.Fill(0);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
for(i=0; i<n; i++)
{
if(s.m_DIdx[i]!=s.m_UIdx[i])
y.Set(i,y[i]+s.m_Vals[s.m_DIdx[i]]*x[s.m_Idx[s.m_DIdx[i]]]);
if(IsUpper)
{
lt=s.m_UIdx[i];
rt=s.m_RIdx[i+1];
vy=0;
vx=x[i];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v=s.m_Vals[j];
vy=vy+x[id]*v;
y.Set(id,y[id]+vx*v);
}
y.Set(i,y[i]+vy);
}
else
{
lt=s.m_RIdx[i];
rt=s.m_DIdx[i];
vy=0;
vx=x[i];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v=s.m_Vals[j];
vy=vy+x[id]*v;
y.Set(id,y[id]+vx*v);
}
y.Set(i,y[i]+vy);
}
}
break;
case 2:
//--- SKS format
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
vd=s.m_Vals[ri+d]*x[i];
if(d>0 && !IsUpper)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
vd=vd+vv;
}
if(u>0 && IsUpper)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
i1_=(lt1)-(lt);
vv=0.0;
for(i_=lt; i_<=rt; i_++)
vv+=s.m_Vals[i_]*x[i_+i1_];
vd=vd+vv;
}
y.Set(i,vd);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates vector-matrix-vector product x'*S*x, |
//| where S is symmetric matrix. Matrix S must be stored in CRS or |
//| SKS format (exception will be thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*M matrix in CRS or SKS format. |
//| IsUpper - whether upper or lower triangle of S is given: |
//| * if upper triangle is given, only S[i,j] for j>=i |
//| are used, and lower triangle is ignored (it can be |
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only S[i,j] for j<=i |
//| are used, and upper triangle is ignored. |
//| X - array[N], input vector. For performance reasons we |
//| make only quick checks - we check that array size is|
//| at least N, but we do not check for NAN's or INF's. |
//| RESULT |
//| x'*S*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
double CSparse::SparseVSMV(CSparseMatrix &s,bool IsUpper,
CRowDouble &x)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return(0);
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_N,__FUNCTION__+": length(X)<N"))
return(0);
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square matrix"))
return(0);
//--- create variables
double result=0.0;
int n=s.m_N;
int i=0;
int j=0;
int k=0;
int id=0;
int lt=0;
int rt=0;
double v=0;
double v0=0;
double v1=0;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int lt1=0;
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
break;
for(i=0; i<n; i++)
{
if(s.m_DIdx[i]!=s.m_UIdx[i])
{
v=x[s.m_Idx[s.m_DIdx[i]]];
result=result+v*s.m_Vals[s.m_DIdx[i]]*v;
}
if(IsUpper)
{
lt=s.m_UIdx[i];
rt=s.m_RIdx[i+1];
}
else
{
lt=s.m_RIdx[i];
rt=s.m_DIdx[i];
}
v0=x[i];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v1=x[id];
v=s.m_Vals[j];
result=result+2*v0*v1*v;
}
}
break;
case 2:
//--- SKS format
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
v=x[i];
result=result+v*s.m_Vals[ri+d]*v;
if(d>0 && !IsUpper)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
k=d-1;
v0=x[i];
v=0.0;
for(j=0; j<=k; j++)
v=v+x[lt1+j]*s.m_Vals[lt+j];
result=result+2*v0*v;
}
if(u>0 && IsUpper)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
k=u-1;
v0=x[i];
v=0.0;
for(j=0; j<=k; j++)
v=v+x[lt1+j]*s.m_Vals[lt+j];
result=result+2*v0*v;
}
}
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function calculates matrix-matrix product S*A. Matrix S must|
//| be stored in CRS or SKS format (exception will be thrown |
//| otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS or SKS format. |
//| A - array[N,K], input dense matrix. For performance |
//| reasons we make only quick checks - we check that |
//| array size is at least N, but we do not check for |
//| NAN's or INF's. |
//| K - number of columns of matrix (A). |
//| B - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| B - array[M,K], S*A |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMM(CSparseMatrix &s,CMatrixDouble &a,
int k,CMatrixDouble &b)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(a.Rows()>=s.m_N,__FUNCTION__+": Rows(A)<N"))
return;
//--- check
if(!CAp::Assert(k>0,__FUNCTION__+": K<=0"))
return;
//--- create variables
double tval=0;
double v=0;
int id=0;
int i=0;
int j=0;
int k0=0;
int k1=k-1;
int lt=0;
int rt=0;
int m=s.m_M;
int n=s.m_N;
int ri=0;
int ri1=0;
int lt1=0;
int rt1=0;
int d=0;
int u=0;
double vd=0;
int i_=0;
b=matrix<double>::Zeros(m,k);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[m],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
if(k<m_LinAlgSwitch)
{
for(i=0; i<m; i++)
{
for(j=0; j<k; j++)
{
tval=0;
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(k0=lt; k0<rt; k0++)
tval=tval+s.m_Vals[k0]*a.Get(s.m_Idx[k0],j);
b.Set(i,j,tval);
}
}
}
else
{
for(i=0; i<m; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v=s.m_Vals[j];
for(i_=0; i_<k; i_++)
b.Set(i,i_,(b.Get(i,i_)+v*a.Get(id,i_)));
}
}
}
break;
case 2:
//--- SKS format
if(!CAp::Assert(m==n,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
if(k<m_LinAlgSwitch)
for(k0=0; k0<=k1; k0++)
b.Set(i,k0,b.Get(i,k0)+v*a.Get(j,k0));
else
//--- Use vector operation
for(i_=0; i_<k; i_++)
b.Set(i,i_,b.Get(i,i_)+v*a.Get(j,i_));
}
}
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
if(k<m_LinAlgSwitch)
for(k0=0; k0<=k1; k0++)
b.Set(j,k0,b.Get(j,k0)+v*a.Get(i,k0));
else
//--- Use vector operation
for(i_=0; i_<k; i_++)
b.Set(j,i_,b.Get(j,i_)+v*a.Get(i,i_));
}
}
vd=s.m_Vals[ri+d];
for(i_=0; i_<k; i_++)
b.Set(i,i_,b.Get(i,i_)+vd*a.Get(i,i_));
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates matrix-matrix product S^T*A. Matrix S |
//| must be stored in CRS or SKS format (exception will be thrown |
//| otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS or SKS format. |
//| A - array[M,K], input dense matrix. For performance |
//| reasons we make only quick checks - we check that |
//| array size is at least M, but we do not check for |
//| NAN's or INF's. |
//| K - number of columns of matrix (A). |
//| B - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| B - array[N,K], S^T*A |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMTM(CSparseMatrix &s,CMatrixDouble &a,
int k,CMatrixDouble &b)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(a.Rows()>=s.m_M,__FUNCTION__+": Rows(A)<M"))
return;
//--- check
if(!CAp::Assert(k>0,__FUNCTION__+": K<=0"))
return;
//--- create variables
int i=0;
int j=0;
int k0=0;
int k1=k-1;
int lt=0;
int rt=0;
int ct=0;
double v=0;
int m=s.m_M;
int n=s.m_N;
int ri=0;
int ri1=0;
int lt1=0;
int rt1=0;
int d=0;
int u=0;
int i_=0;
b=matrix<double>::Zeros(n,k);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[m],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
if(k<m_LinAlgSwitch)
{
for(i=0; i<m; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(k0=lt; k0<rt; k0++)
{
v=s.m_Vals[k0];
ct=s.m_Idx[k0];
CAblasF::RAddRR(k,v,a,i,b,ct);
}
}
}
else
{
for(i=0; i<m; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(j=lt; j<rt; j++)
{
v=s.m_Vals[j];
ct=s.m_Idx[j];
CAblasF::RAddRR(k,v,a,i,b,ct);
}
}
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(m==n,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,i,b,j);
}
}
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,j,b,i);
}
}
v=s.m_Vals[ri+d];
CAblasF::RAddRR(k,v,a,i,b,i);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function simultaneously calculates two matrix-matrix |
//| products: |
//| S*A and S^T*A. |
//| S must be square (non-rectangular) matrix stored in CRS or SKS |
//| format (exception will be thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse N*N matrix in CRS or SKS format. |
//| A - array[N,K], input dense matrix. For performance |
//| reasons we make only quick checks - we check that |
//| array size is at least N, but we do not check for |
//| NAN's or INF's. |
//| K - number of columns of matrix (A). |
//| B0 - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| B1 - output buffer, possibly preallocated. In case buffer |
//| size is too small to store result, this buffer is |
//| automatically resized. |
//| OUTPUT PARAMETERS: |
//| B0 - array[N,K], S*A |
//| B1 - array[N,K], S^T*A |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseMM2(CSparseMatrix &s,CMatrixDouble &a,
int k,CMatrixDouble &b0,CMatrixDouble &b1)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- check
if(!CAp::Assert(a.Rows()>=s.m_N,__FUNCTION__+": Rows(A)<N"))
return;
//--- check
if(!CAp::Assert(k>0,__FUNCTION__+": K<=0"))
return;
//--- create variables
int i=0;
int j=0;
int k0=0;
int lt=0;
int rt=0;
int ct=0;
double v=0;
double tval=0;
int n=s.m_N;
int k1=k-1;
int ri=0;
int ri1=0;
int lt1=0;
int rt1=0;
int d=0;
int u=0;
int i_=0;
b1=matrix<double>::Zeros(n,k);
b0=b1;
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
//---
if(k<m_LinAlgSwitch)
{
for(i=0; i<n; i++)
{
for(j=0; j<k; j++)
{
tval=0;
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
v=a.Get(i,j);
for(k0=lt; k0<rt; k0++)
{
ct=s.m_Idx[k0];
b1.Set(ct,j,(b1.Get(ct,j)+s.m_Vals[k0]*v));
tval=tval+s.m_Vals[k0]*a.Get(ct,j);
}
b0.Set(i,j,tval);
}
}
}
else
{
for(i=0; i<n; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(j=lt; j<rt; j++)
{
v=s.m_Vals[j];
ct=s.m_Idx[j];
CAblasF::RAddRR(k,v,a,ct,b0,i);
CAblasF::RAddRR(k,v,a,i,b1,ct);
}
}
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,"SparseMM2: non-square SKS matrices are not supported"))
return;
//---
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,j,b0,i);
CAblasF::RAddRR(k,v,a,i,b1,j);
}
}
if(u>0)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,i,b0,j);
CAblasF::RAddRR(k,v,a,j,b1,i);
}
}
v=s.m_Vals[ri+d];
CAblasF::RAddRR(k,v,a,i,b0,i);
CAblasF::RAddRR(k,v,a,i,b1,i);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates matrix-matrix product S*A, when S is |
//| symmetric matrix. Matrix S must be stored in CRS or SKS format |
//| (exception will be thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse M*M matrix in CRS or SKS format. |
//| IsUpper - whether upper or lower triangle of S is given: |
//| * if upper triangle is given, only S[i,j] for j>=i |
//| are used, and lower triangle is ignored (it can be |
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only S[i,j] for j<=i |
//| are used, and upper triangle is ignored. |
//| A - array[N,K], input dense matrix. For performance |
//| reasons we make only quick checks - we check that |
//| array size is at least N, but we do not check for |
//| NAN's or INF's. |
//| K - number of columns of matrix (A). |
//| B - output buffer, possibly preallocated. In case |
//| buffer size is too small to store result, this |
//| buffer is automatically resized. |
//| OUTPUT PARAMETERS: |
//| B - array[M,K], S*A |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseSMM(CSparseMatrix &s,bool IsUpper,
CMatrixDouble &a,int k,
CMatrixDouble &b)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(a.Rows()>=s.m_N,__FUNCTION__+": Rows(X)<N"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- create variables
int i=0;
int j=0;
int k0=k-1;
int id=0;
int k1=0;
int lt=0;
int rt=0;
double v=0;
double vb=0;
double va=0;
int n=s.m_N;
int ri=0;
int ri1=0;
int lt1=0;
int rt1=0;
int d=0;
int u=0;
int i_=0;
b=matrix<double>::Zeros(n,k);
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
if(k>m_LinAlgSwitch)
{
for(i=0; i<n; i++)
{
for(j=0; j<k; j++)
{
if(s.m_DIdx[i]!=s.m_UIdx[i])
{
id=s.m_DIdx[i];
b.Set(i,j,(b.Get(i,j)+s.m_Vals[id]*a.Get(s.m_Idx[id],j)));
}
if(IsUpper)
{
lt=s.m_UIdx[i];
rt=s.m_RIdx[i+1];
vb=0;
va=a.Get(i,j);
for(k0=lt; k0<rt; k0++)
{
id=s.m_Idx[k0];
v=s.m_Vals[k0];
vb=vb+a.Get(id,j)*v;
b.Set(id,j,(b.Get(id,j)+va*v));
}
b.Set(i,j,(b.Get(i,j)+vb));
}
else
{
lt=s.m_RIdx[i];
rt=s.m_DIdx[i];
vb=0;
va=a.Get(i,j);
for(k0=lt; k0<rt; k0++)
{
id=s.m_Idx[k0];
v=s.m_Vals[k0];
vb=vb+a.Get(id,j)*v;
b.Set(id,j,(b.Get(id,j)+va*v));
}
b.Set(i,j,(b.Get(i,j)+vb));
}
}
}
}
else
{
for(i=0; i<n; i++)
{
if(s.m_DIdx[i]!=s.m_UIdx[i])
{
id=s.m_DIdx[i];
v=s.m_Vals[id];
CAblasF::RAddRR(k,v,a,s.m_Idx[id],b,i);
}
if(IsUpper)
{
lt=s.m_UIdx[i];
rt=s.m_RIdx[i+1];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v=s.m_Vals[j];
CAblasF::RAddRR(k,v,a,id,b,i);
CAblasF::RAddRR(k,v,a,i,b,id);
}
}
else
{
lt=s.m_RIdx[i];
rt=s.m_DIdx[i];
for(j=lt; j<rt; j++)
{
id=s.m_Idx[j];
v=s.m_Vals[j];
CAblasF::RAddRR(k,v,a,id,b,i);
CAblasF::RAddRR(k,v,a,i,b,id);
}
}
}
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(d>0 && !IsUpper)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,j,b,i);
CAblasF::RAddRR(k,v,a,i,b,j);
}
}
if(u>0 && IsUpper)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
for(j=lt1; j<=rt1; j++)
{
v=s.m_Vals[lt+(j-lt1)];
CAblasF::RAddRR(k,v,a,i,b,j);
CAblasF::RAddRR(k,v,a,j,b,i);
}
}
v=s.m_Vals[ri+d];
CAblasF::RAddRR(k,v,a,i,b,i);
}
break;
}
}
//+------------------------------------------------------------------+
//| This function calculates matrix-vector product op(S)*x, when x is|
//| vector, S is symmetric triangular matrix, op(S) is transposition |
//| or no operation. |
//| Matrix S must be stored in CRS or SKS format (exception will be |
//| thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse square matrix in CRS or SKS format. |
//| IsUpper - whether upper or lower triangle of S is used: |
//| * if upper triangle is given, only S[i,j] for j>=i|
//| are used, and lower triangle is ignored (it can be|
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only S[i,j] for j<=i|
//| are used, and upper triangle is ignored. |
//| IsUnit - unit or non-unit diagonal: |
//| * if True, diagonal elements of triangular matrix are |
//| considered equal to 1.0. Actual elements stored in|
//| S are not referenced at all. |
//| * if False, diagonal stored in S is used |
//| OpType - operation type: |
//| * if 0, S*x is calculated |
//| * if 1, (S^T)*x is calculated (transposition) |
//| X - array[N] which stores input vector. For performance|
//| reasons we make only quick checks - we check that |
//| array size is at least N, but we do not check for |
//| NAN's or INF's. |
//| Y - possibly preallocated input buffer. Automatically |
//| resized if its size is too small. |
//| OUTPUT PARAMETERS: |
//| Y - array[N], op(S)*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseTRMV(CSparseMatrix &s,bool IsUpper,
bool IsUnit,int OpType,CRowDouble &x,
CRowDouble &y)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(OpType==0 || OpType==1,__FUNCTION__+": incorrect operation type (must be 0 or 1)"))
return;
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_N,__FUNCTION__+": Length(X)<N"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- create variables
int n=s.m_N;
int i=0;
int j=0;
int k=0;
int j0=0;
int j1=0;
double v=0;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int lt=0;
int rt=0;
int lt1=0;
int rt1=0;
int i_=0;
int i1_=0;
if(IsUnit)
{
//--- Set initial value of y to x
y=x;
y.Resize(n);
}
else
{
//--- Set initial value of y to 0
y=vector<double>::Zeros(n);
}
switch(s.m_MatrixType)
{
case 1:
//--- CRS format
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
for(i=0; i<n; i++)
{
//--- Depending on IsUpper/IsUnit, select range of indexes to process
if(IsUpper)
{
if(IsUnit || s.m_DIdx[i]==s.m_UIdx[i])
j0=s.m_UIdx[i];
else
j0=s.m_DIdx[i];
j1=s.m_RIdx[i+1]-1;
}
else
{
j0=s.m_RIdx[i];
if(IsUnit || s.m_DIdx[i]==s.m_UIdx[i])
j1=s.m_DIdx[i]-1;
else
j1=s.m_DIdx[i];
}
//--- Depending on OpType, process subset of I-th row of input matrix
if(OpType==0)
{
v=0.0;
for(j=j0; j<=j1; j++)
v=v+s.m_Vals[j]*x[s.m_Idx[j]];
y.Set(i,y[i]+v);
}
else
{
v=x[i];
for(j=j0; j<=j1; j++)
{
k=s.m_Idx[j];
y.Set(k,y[k]+v*s.m_Vals[j]);
}
}
}
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
for(i=0; i<n; i++)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(!IsUnit)
y.Set(i,y[i]+s.m_Vals[ri+d]*x[i]);
if(d>0 && !IsUpper)
{
lt=ri;
rt=ri+d-1;
lt1=i-d;
rt1=i-1;
if(OpType==0)
{
i1_=(lt1)-(lt);
v=0.0;
for(i_=lt; i_<=rt; i_++)
v+=s.m_Vals[i_]*x[i_+i1_];
y.Set(i,y[i]+v);
}
else
{
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
}
if(u>0 && IsUpper)
{
lt=ri1-u;
rt=ri1-1;
lt1=i-u;
rt1=i-1;
if(OpType==0)
{
v=x[i];
i1_=(lt)-(lt1);
for(i_=lt1; i_<=rt1; i_++)
y.Set(i_,y[i_]+v*s.m_Vals[i_+i1_]);
}
else
{
i1_=(lt1)-(lt);
v=0.0;
for(i_=lt; i_<=rt; i_++)
v+=s.m_Vals[i_]*x[i_+i1_];
y.Set(i,y[i]+v);
}
}
}
break;
}
}
//+------------------------------------------------------------------+
//| This function solves linear system op(S)*y=x where x is vector, S|
//| is symmetric triangular matrix, op(S) is transposition or no |
//| operation. |
//| Matrix S must be stored in CRS or SKS format (exception will be |
//| thrown otherwise). |
//| INPUT PARAMETERS: |
//| S - sparse square matrix in CRS or SKS format. |
//| IsUpper - whether upper or lower triangle of S is used: |
//| * if upper triangle is given, only S[i,j] for j>=i are|
//| used, and lower triangle is ignored (it can be |
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only S[i,j] for j<=i are|
//| used, and upper triangle is ignored. |
//| IsUnit - unit or non-unit diagonal: |
//| * if True, diagonal elements of triangular matrix are |
//| considered equal to 1.0. Actual elements stored in S|
//| are not referenced at all. |
//| * if False, diagonal stored in S is used. It is your |
//| responsibility to make sure that diagonal is non-zero|
//| OpType - operation type: |
//| * if 0, S*x is calculated |
//| * if 1, (S^T)*x is calculated (transposition) |
//| X - array[N] which stores input vector. For performance|
//| reasons we make only quick checks - we check that |
//| array size is at least N, but we do not check for |
//| NAN's or INF's. |
//| OUTPUT PARAMETERS: |
//| X - array[N], inv(op(S))*x |
//| NOTE: this function throws exception when called for non-CRS/SKS |
//| matrix. |
//| You must convert your matrix with SparseConvertToCRS/SKS() before|
//| using this function. |
//| NOTE: no assertion or tests are done during algorithm operation. |
//| It is your responsibility to provide invertible matrix to |
//| algorithm. |
//+------------------------------------------------------------------+
void CSparse::SparseTRSV(CSparseMatrix &s,bool IsUpper,
bool IsUnit,int OpType,
CRowDouble &x)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS/SKS)"))
return;
//--- check
if(!CAp::Assert(OpType==0 || OpType==1,__FUNCTION__+": incorrect operation type (must be 0 or 1)"))
return;
//--- check
if(!CAp::Assert(CAp::Len(x)>=s.m_N,__FUNCTION__+": Length(X)<N"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- create variables
int n=s.m_N;
int fst=0;
int lst=0;
int stp=0;
int i=0;
int j=0;
int k=0;
double v=0;
double vd=0;
double v0=0;
int j0=0;
int j1=0;
int ri=0;
int ri1=0;
int d=0;
int u=0;
int lt=0;
int lt1=0;
switch(s.m_MatrixType)
{
case 1:
//--- CRS format.
//--- Several branches for different combinations of IsUpper and OpType
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return;
if(OpType==0)
{
//--- No transposition.
//--- S*x=y with upper or lower triangular S.
v0=0;
if(IsUpper)
{
fst=n-1;
lst=0;
stp=-1;
}
else
{
fst=0;
lst=n-1;
stp=1;
}
i=fst;
while((stp>0 && i<=lst) || (stp<0 && i>=lst))
{
//--- Select range of indexes to process
if(IsUpper)
{
j0=s.m_UIdx[i];
j1=s.m_RIdx[i+1]-1;
}
else
{
j0=s.m_RIdx[i];
j1=s.m_DIdx[i]-1;
}
//--- Calculate X[I]
v=0.0;
for(j=j0; j<=j1; j++)
v+=s.m_Vals[j]*x[s.m_Idx[j]];
if(!IsUnit)
{
if(s.m_DIdx[i]==s.m_UIdx[i])
vd=0;
else
vd=s.m_Vals[s.m_DIdx[i]];
}
else
vd=1.0;
v=(x[i]-v)/vd;
x.Set(i,v);
v0=0.25*v0+v;
//--- Next I
i+=stp;
}
//--- check
if(!CAp::Assert(CMath::IsFinite(v0),__FUNCTION__+": overflow or division by exact zero"))
return;
break;
}
if(OpType==1)
{
//--- Transposition.
//--- (S^T)*x=y with upper or lower triangular S.
if(IsUpper)
{
fst=0;
lst=n-1;
stp=1;
}
else
{
fst=n-1;
lst=0;
stp=-1;
}
i=fst;
v0=0;
while((stp>0 && i<=lst) || (stp<0 && i>=lst))
{
v=x[i];
if(v!=0.0)
{
//--- X[i] already stores A[i,i]*Y[i], the only thing left
//--- is to divide by diagonal element.
if(!IsUnit)
{
if(s.m_DIdx[i]==s.m_UIdx[i])
vd=0;
else
vd=s.m_Vals[s.m_DIdx[i]];
}
else
vd=1.0;
v=(vd!=0?v/vd:0);
x.Set(i,v);
v0=0.25*v0+v;
//--- For upper triangular case:
//--- subtract X[i]*Ai from X[i+1:N-1]
//--- For lower triangular case:
//--- subtract X[i]*Ai from X[0:i-1]
//--- (here Ai is I-th row of original, untransposed A).
if(IsUpper)
{
j0=s.m_UIdx[i];
j1=s.m_RIdx[i+1]-1;
}
else
{
j0=s.m_RIdx[i];
j1=s.m_DIdx[i]-1;
}
for(j=j0; j<=j1; j++)
{
k=s.m_Idx[j];
x.Set(k,x[k]-s.m_Vals[j]*v);
}
}
//--- Next I
i=i+stp;
}
//--- check
if(!CAp::Assert(CMath::IsFinite(v0),__FUNCTION__+": overflow or division by exact zero"))
return;
break;
}
//--- check
if(!CAp::Assert(false,__FUNCTION__+": internal error"))
return;
break;
case 2:
//--- SKS format
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
if((OpType==0 && !IsUpper) || (OpType==1 && IsUpper))
{
//--- Lower triangular op(S) (matrix itself can be upper triangular).
v0=0;
for(i=0; i<n; i++)
{
//--- Select range of indexes to process
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
if(IsUpper)
{
lt=i-u;
lt1=ri1-u;
k=u-1;
}
else
{
lt=i-d;
lt1=ri;
k=d-1;
}
//--- Calculate X[I]
v=0.0;
for(j=0; j<=k; j++)
v=v+s.m_Vals[lt1+j]*x[lt+j];
if(IsUnit)
vd=1;
else
vd=s.m_Vals[ri+d];
v=(x[i]-v)/vd;
x.Set(i,v);
v0=0.25*v0+v;
}
//--- check
if(!CAp::Assert(CMath::IsFinite(v0),__FUNCTION__+": overflow or division by exact zero"))
return;
break;
}
if((OpType==1 && !IsUpper) || (OpType==0 && IsUpper))
{
//--- Upper triangular op(S) (matrix itself can be lower triangular).
v0=0;
for(i=n-1; i>=0; i--)
{
ri=s.m_RIdx[i];
ri1=s.m_RIdx[i+1];
d=s.m_DIdx[i];
u=s.m_UIdx[i];
//--- X[i] already stores A[i,i]*Y[i], the only thing left
//--- is to divide by diagonal element.
if(IsUnit)
vd=1;
else
vd=s.m_Vals[ri+d];
v=x[i]/vd;
x.Set(i,v);
v0=0.25*v0+v;
//--- Subtract product of X[i] and I-th column of "effective" A from
//--- unprocessed variables.
v=x[i];
if(IsUpper)
{
lt=i-u;
lt1=ri1-u;
k=u-1;
}
else
{
lt=i-d;
lt1=ri;
k=d-1;
}
for(j=0; j<=k; j++)
x.Set(lt+j,x[lt+j]-v*s.m_Vals[lt1+j]);
}
//--- check
if(!CAp::Assert(CMath::IsFinite(v0),__FUNCTION__+": overflow or division by exact zero"))
return;
break;
}
//--- check
if(!CAp::Assert(false,__FUNCTION__+": internal error"))
return;
break;
default:
//--- check
if(!CAp::Assert(false,__FUNCTION__+": internal error"))
return;
break;
}
}
//+------------------------------------------------------------------+
//| This function applies permutation given by permutation table P |
//| (as opposed to product form of permutation) to sparse symmetric |
//| matrix A, given by either upper or lower triangle: B := P*A*P'|
//| This function allocates completely new instance of B. Use |
//| buffered version SparseSymmPermTblBuf() if you want to reuse |
//| already allocated structure. |
//| INPUT PARAMETERS: |
//| A - sparse square matrix in CRS format. |
//| IsUpper - whether upper or lower triangle of A is used: |
//| * if upper triangle is given, only A[i,j] for j>=i|
//| are used, and lower triangle is ignored (it can be|
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only A[i,j] for j<=i|
//| are used, and upper triangle is ignored. |
//| P - array[N] which stores permutation table; P[I]=J |
//| means that I-th row/column of matrix A is moved to |
//| J-th position. For performance reasons we do NOT |
//| check that P[] is a correct permutation (that there|
//| is no repetitions, just that all its elements are |
//| in [0,N) range. |
//| OUTPUT PARAMETERS: |
//| B - permuted matrix. Permutation is applied to A from |
//| the both sides, only upper or lower triangle |
//| (depending on IsUpper) is stored. |
//| NOTE: this function throws exception when called for non-CRS |
//| matrix. You must convert your matrix with SparseConvertToCRS() |
//| before using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseSymmPermTbl(CSparseMatrix &a,bool IsUpper,
CRowInt &p,CSparseMatrix &b)
{
SparseSymmPermTblBuf(a,IsUpper,p,b);
}
//+------------------------------------------------------------------+
//| This function is a buffered version of SparseSymmPermTbl() that |
//| reuses previously allocated storage in B as much as possible. |
//| This function applies permutation given by permutation table P |
//| (as opposed to product form of permutation) to sparse symmetric |
//| matrix A, given by either upper or lower triangle: B := P*A*P'. |
//| INPUT PARAMETERS: |
//| A - sparse square matrix in CRS format. |
//| IsUpper - whether upper or lower triangle of A is used: |
//| * if upper triangle is given, only A[i,j] for j>=i|
//| are used, and lower triangle is ignored (it can be|
//| empty - these elements are not referenced at all). |
//| * if lower triangle is given, only A[i,j] for j<=i|
//| are used, and upper triangle is ignored. |
//| P - array[N] which stores permutation table; P[I]=J |
//| means that I-th row/column of matrix A is moved to |
//| J-th position. For performance reasons we do NOT |
//| check that P[] is a correct permutation (that there|
//| is no repetitions, just that all its elements are |
//| in [0,N) range. |
//| B - sparse matrix object that will hold output. |
//| Previously allocated memory will be reused as much |
//| as possible. |
//| OUTPUT PARAMETERS: |
//| B - permuted matrix. Permutation is applied to A from |
//| the both sides, only upper or lower triangle |
//| (depending on IsUpper) is stored. |
//| NOTE: this function throws exception when called for non-CRS |
//| matrix. You must convert your matrix with SparseConvertToCRS() |
//| before using this function. |
//+------------------------------------------------------------------+
void CSparse::SparseSymmPermTblBuf(CSparseMatrix &a,bool IsUpper,
CRowInt &p,CSparseMatrix &b)
{
//--- check
if(!CAp::Assert(a.m_MatrixType==1,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS)"))
return;
//--- check
if(!CAp::Assert(CAp::Len(p)>=a.m_N,__FUNCTION__+": Length(P)<N"))
return;
//--- check
if(!CAp::Assert(a.m_M==a.m_N,__FUNCTION__+": matrix is non-square"))
return;
//--- check
bool bflag=true;
for(int i=0; i<a.m_N; i++)
bflag=(bflag && p[i]>=0) && p[i]<a.m_N;
if(!CAp::Assert(bflag,__FUNCTION__+": P[] contains values outside of [0,N) range"))
return;
//--- create variables
int i=0;
int j=0;
int jj=0;
int j0=0;
int j1=0;
int k0=0;
int k1=0;
int kk=0;
int n=a.m_N;
int dst=0;
//--- check
if(!CAp::Assert(a.m_NInitialized==a.m_RIdx[n],__FUNCTION__+": integrity check failed"))
return;
//--- Prepare output
b.m_MatrixType=1;
b.m_N=n;
b.m_M=n;
CApServ::IVectorSetLengthAtLeast(b.m_DIdx,n);
CApServ::IVectorSetLengthAtLeast(b.m_UIdx,n);
//--- Determine row sizes (temporary stored in DIdx) and ranges
CAblasF::ISetV(n,0,b.m_DIdx);
for(i=0; i<n; i++)
{
if(IsUpper)
{
j0=a.m_DIdx[i];
j1=a.m_RIdx[i+1]-1;
k0=p[i];
for(jj=j0; jj<=j1; jj++)
{
k1=p[a.m_Idx[jj]];
if(k1<k0)
b.m_DIdx.Set(k1,b.m_DIdx[k1]+1);
else
b.m_DIdx.Set(k0,b.m_DIdx[k0]+1);
}
}
else
{
j0=a.m_RIdx[i];
j1=a.m_UIdx[i]-1;
k0=p[i];
for(jj=j0; jj<=j1; jj++)
{
k1=p[a.m_Idx[jj]];
if(k1>k0)
b.m_DIdx.Set(k1,b.m_DIdx[k1]+1);
else
b.m_DIdx.Set(k0,b.m_DIdx[k0]+1);
}
}
}
CApServ::IVectorSetLengthAtLeast(b.m_RIdx,n+1);
b.m_RIdx.Set(0,0);
for(i=0; i<n; i++)
b.m_RIdx.Set(i+1,b.m_RIdx[i]+b.m_DIdx[i]);
b.m_NInitialized=b.m_RIdx[n];
CApServ::IVectorSetLengthAtLeast(b.m_Idx,b.m_NInitialized);
CApServ::RVectorSetLengthAtLeast(b.m_Vals,b.m_NInitialized);
//--- Process matrix
CAblasF::ICopyV(n,b.m_RIdx,b.m_UIdx);
for(i=0; i<n; i++)
{
if(IsUpper)
{
j0=a.m_DIdx[i];
j1=a.m_RIdx[i+1]-1;
for(jj=j0; jj<=j1; jj++)
{
j=a.m_Idx[jj];
k0=p[i];
k1=p[j];
if(k1<k0)
{
kk=k0;
k0=k1;
k1=kk;
}
dst=b.m_UIdx[k0];
b.m_Idx.Set(dst,k1);
b.m_Vals.Set(dst,a.m_Vals[jj]);
b.m_UIdx.Set(k0,dst+1);
}
}
else
{
j0=a.m_RIdx[i];
j1=a.m_UIdx[i]-1;
for(jj=j0; jj<=j1; jj++)
{
j=a.m_Idx[jj];
k0=p[i];
k1=p[j];
if(k1>k0)
{
kk=k0;
k0=k1;
k1=kk;
}
dst=b.m_UIdx[k0];
b.m_Idx.Set(dst,k1);
b.m_Vals.Set(dst,a.m_Vals[jj]);
b.m_UIdx.Set(k0,dst+1);
}
}
}
//--- Finalize matrix
for(i=0; i<n; i++)
CTSort::TagSortMiddleIR(b.m_Idx,b.m_Vals,b.m_RIdx[i],b.m_RIdx[i+1]-b.m_RIdx[i]);
SparseInitDUIdx(b);
}
//+------------------------------------------------------------------+
//| This procedure resizes Hash-Table matrix. It can be called when |
//| you have deleted too many elements from the matrix, and you want |
//| to free unneeded memory. |
//+------------------------------------------------------------------+
void CSparse::SparseResizeMatrix(CSparseMatrix &s)
{
//--- create variables
int k=0;
int k1=0;
int i=0;
CRowDouble tvals;
CRowInt tidx;
//--- check
if(!CAp::Assert(s.m_MatrixType==0,__FUNCTION__+": incorrect matrix type"))
return;
//--- Initialization for length and number of non-null elementd
k=s.m_TableSize;
k1=0;
//--- Calculating number of non-null elements
for(i=0; i<k; i++)
{
if(s.m_Idx[2*i]>=0)
k1=k1+1;
}
//--- Initialization value for free space
s.m_TableSize=(int)MathRound(k1/m_DesiredLoadFactor*m_GrowFactor+m_Additional);
s.m_NFree=s.m_TableSize-k1;
tvals.Resize(s.m_TableSize);
tidx.Resize(2*s.m_TableSize);
CAp::Swap(s.m_Vals,tvals);
CAp::Swap(s.m_Idx,tidx);
for(i=0; i<s.m_TableSize; i++)
s.m_Idx.Set(2*i,-1);
for(i=0; i<k; i++)
if(tidx[2*i]>=0)
SparseSet(s,tidx[2*i],tidx[2*i+1],tvals[i]);
}
//+------------------------------------------------------------------+
//| Procedure for initialization 'S.m_DIdx' and 'S.m_UIdx' |
//+------------------------------------------------------------------+
void CSparse::SparseInitDUIdx(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1,__FUNCTION__+": internal error,incorrect matrix type"))
return;
//--- create variables
int i=0;
int j=0;
int k=0;
int lt=0;
int rt=0;
CApServ::IVectorSetLengthAtLeast(s.m_DIdx,s.m_M);
CApServ::IVectorSetLengthAtLeast(s.m_UIdx,s.m_M);
s.m_UIdx.Fill(-1,0,s.m_M);
s.m_DIdx.Fill(-1,0,s.m_M);
for(i=0; i<s.m_M; i++)
{
lt=s.m_RIdx[i];
rt=s.m_RIdx[i+1];
for(j=lt; j<rt; j++)
{
k=s.m_Idx[j];
if(k==i)
s.m_DIdx.Set(i,j);
else
if(k>i && s.m_UIdx[i]==-1)
{
s.m_UIdx.Set(i,j);
break;
}
}
if(s.m_UIdx[i]==-1)
s.m_UIdx.Set(i,s.m_RIdx[i+1]);
if(s.m_DIdx[i]==-1)
s.m_DIdx.Set(i,s.m_UIdx[i]);
}
}
//+------------------------------------------------------------------+
//| This function return average length of chain at hash-table. |
//+------------------------------------------------------------------+
double CSparse::SparseGetAverageLengthofChain(CSparseMatrix &s)
{
//--- If matrix represent in CRS then return zero and exit
if(s.m_MatrixType!=0)
return(0);
//--- create variables
double result=0;
int nchains=0;
int talc=0;
int l=s.m_TableSize;
int i=0;
int ind0=0;
int ind1=0;
int hashcode=0;
for(i=0; i<l; i++)
{
ind0=2*i;
if(s.m_Idx[ind0]!=-1)
{
nchains=nchains+1;
hashcode=Hash(s.m_Idx[ind0],s.m_Idx[ind0+1],l);
while(true)
{
talc=talc+1;
ind1=2*hashcode;
if(s.m_Idx[ind0]==s.m_Idx[ind1] && s.m_Idx[ind0+1]==s.m_Idx[ind1+1])
break;
hashcode=(hashcode+1)%l;
}
}
}
if(nchains==0)
result=0;
else
result=(double)talc/(double)nchains;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| This function is used to enumerate all elements of the sparse |
//| matrix. Before first call user initializes T0 and T1 counters by |
//| zero. These counters are used to remember current position in a |
//| matrix; after each call they are updated by the function. |
//| Subsequent calls to this function return non-zero elements of the|
//| sparse matrix, one by one. If you enumerate CRS matrix, matrix is|
//| traversed from left to right, from top to bottom. In case you |
//| enumerate matrix stored as Hash table, elements are returned in |
//| random order. |
//| EXAMPLE |
//| > T0=0 |
//| > T1=0 |
//| > while SparseEnumerate(S,T0,T1,I,J,V) do |
//| > ....do something with I,J,V |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in Hash-Table or CRS representation.|
//| T0 - internal counter |
//| T1 - internal counter |
//| OUTPUT PARAMETERS: |
//| T0 - new value of the internal counter |
//| T1 - new value of the internal counter |
//| I - row index of non-zero element, 0<=I<M. |
//| J - column index of non-zero element, 0<=J<N |
//| V - value of the T-th element |
//| RESULT |
//| True in case of success (next non-zero element was retrieved) |
//| False in case all non-zero elements were enumerated |
//| NOTE: you may call SparseRewriteExisting() during enumeration, |
//| but it is THE ONLY matrix modification function you can |
//| call!!! Other matrix modification functions should not be |
//| called during enumeration! |
//+------------------------------------------------------------------+
bool CSparse::SparseEnumerate(CSparseMatrix &s,int &t0,int &t1,
int &i,int &j,double &v)
{
//--- create variables
bool result=false;
int sz=0;
int i0=0;
i=0;
j=0;
v=0;
if(t0<0 || (s.m_MatrixType!=0 && t1<0))
{
//--- Incorrect T0/T1, terminate enumeration
return(result);
}
switch(s.m_MatrixType)
{
case 0:
//--- Hash-table matrix
sz=s.m_TableSize;
for(i0=t0; i0<sz; i0++)
{
if(s.m_Idx[2*i0]==-1 || s.m_Idx[2*i0]==-2)
continue;
i=s.m_Idx[2*i0];
j=s.m_Idx[2*i0+1];
v=s.m_Vals[i0];
t0=i0+1;
result=true;
return(result);
}
t0=0;
t1=0;
result=false;
break;
case 1:
//--- CRS matrix
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return (false);
if(t0>=s.m_NInitialized)
{
t0=0;
t1=0;
result=false;
break;
}
while(t0>s.m_RIdx[t1+1]-1 && t1<s.m_M)
t1=t1+1;
i=t1;
j=s.m_Idx[t0];
v=s.m_Vals[t0];
t0=t0+1;
result=true;
break;
case 2:
//--- SKS matrix:
//--- * T0 stores current offset in Vals[] array
//--- * T1 stores index of the diagonal block
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return(false);
if(t0>=s.m_RIdx[s.m_M])
{
t0=0;
t1=0;
result=false;
break;
}
while(t0>s.m_RIdx[t1+1]-1 && t1<s.m_M)
t1=t1+1;
i0=t0-s.m_RIdx[t1];
if(i0<s.m_DIdx[t1]+1)
{
//--- subdiagonal or diagonal element, row index is T1.
i=t1;
j=t1-s.m_DIdx[t1]+i0;
}
else
{
//--- superdiagonal element, column index is T1.
i=t1-(s.m_RIdx[t1+1]-t0);
j=t1;
}
v=s.m_Vals[t0];
t0=t0+1;
result=true;
break;
default:
CAp::Assert(false,__FUNCTION__+": unexpected matrix type");
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function rewrites existing (non-zero) element. It returns |
//| True if element exists or False, when it is called for |
//| non-existing (zero) element. |
//| This function works with any kind of the matrix. |
//| The purpose of this function is to provide convenient thread-safe|
//| way to modify sparse matrix. Such modification (already existing |
//| element is rewritten) is guaranteed to be thread-safe without any|
//| synchronization, as long as different threads modify different |
//| elements. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in any kind of representation (Hash,|
//| SKS, CRS). |
//| I - row index of non-zero element to modify, 0<=I<M |
//| J - column index of non-zero element to modify, 0<=J<N |
//| V - value to rewrite, must be finite number |
//| OUTPUT PARAMETERS: |
//| S - modified matrix |
//| RESULT |
//| True in case when element exists |
//| False in case when element doesn't exist or it is zero |
//+------------------------------------------------------------------+
bool CSparse::SparseRewriteExisting(CSparseMatrix &s,int i,
int j,double v)
{
//--- check
if(!CAp::Assert(0<=i && i<s.m_M,__FUNCTION__+": invalid argument I(either I<0 or I>=S.M)"))
return(false);
//--- check
if(!CAp::Assert(0<=j && j<s.m_N,__FUNCTION__+": invalid argument J(either J<0 or J>=S.N)"))
return(false);
//--- check
if(!CAp::Assert(CMath::IsFinite(v),__FUNCTION__+": invalid argument V(either V is infinite or V is NaN)"))
return(false);
//--- create variables
bool result=false;
int hashcode=0;
int k=0;
int k0=0;
int k1=0;
switch(s.m_MatrixType)
{
case 0:
//--- Hash-table matrix
k=s.m_TableSize;
hashcode=Hash(i,j,k);
while(true)
{
if(s.m_Idx[2*hashcode]==-1)
return(result);
if(s.m_Idx[2*hashcode]==i && s.m_Idx[2*hashcode+1]==j)
{
s.m_Vals.Set(hashcode,v);
result=true;
break;
}
hashcode=(hashcode+1)%k;
}
break;
case 1:
//--- CRS matrix
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return(false);
k0=s.m_RIdx[i];
k1=s.m_RIdx[i+1]-1;
while(k0<=k1)
{
k=(k0+k1)/2;
if(s.m_Idx[k]==j)
{
s.m_Vals.Set(k,v);
result=true;
break;
}
if(s.m_Idx[k]<j)
k0=k+1;
else
k1=k-1;
}
break;
case 2:
//--- SKS
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrix not supported"))
return(false);
if(i==j)
{
//--- Rewrite diagonal element
result=true;
s.m_Vals.Set(s.m_RIdx[i]+s.m_DIdx[i],v);
break;
}
if(j<i)
{
//--- Return subdiagonal element at I-th "skyline block"
k=s.m_DIdx[i];
if(i-j<=k)
{
s.m_Vals.Set(s.m_RIdx[i]+k+j-i,v);
result=true;
}
}
else
{
//--- Return superdiagonal element at J-th "skyline block"
k=s.m_UIdx[j];
if(j-i<=k)
{
s.m_Vals.Set(s.m_RIdx[j+1]-(j-i),v);
result=true;
}
}
break;
default:
CAp::Assert(false,__FUNCTION__+": unexpected matrix type");
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function returns I-th row of the sparse matrix. Matrix must |
//| be stored in CRS or SKS format. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS format |
//| I - row index, 0<=I<M |
//| IRow - output buffer, can be preallocated. In case buffer|
//| size is too small to store I-th row, it is|
//| automatically reallocated. |
//| OUTPUT PARAMETERS: |
//| IRow - array[M], I-th row. |
//| NOTE: this function has O(N) running time, where N is a column |
//| count. It allocates and fills N-element array, even although|
//| most of its elemets are zero. |
//| NOTE: If you have O(non-zeros-per-row) time and memory |
//| requirements, use SparseGetCompressedRow() function. It |
//| returns data in compressed format. |
//| NOTE: when incorrect I (outside of [0,M-1]) or matrix (non |
//| CRS/SKS) is passed, this function throws exception. |
//+------------------------------------------------------------------+
void CSparse::SparseGetRow(CSparseMatrix &s,int i,
CRowDouble &irow)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": S must be CRS/SKS-based matrix"))
return;
//--- check
if(!CAp::Assert(i>=0 && i<s.m_M,__FUNCTION__+": I<0 or I>=M"))
return;
//--- create variables
int i0=0;
int j0=0;
int j1=0;
int j=0;
int upperprofile=0;
//--- Prepare output buffer
irow=vector<double>::Zeros(s.m_N);
//--- Output
switch(s.m_MatrixType)
{
case 1:
for(i0=s.m_RIdx[i]; i0<=s.m_RIdx[i+1]-1; i0++)
irow.Set(s.m_Idx[i0],s.m_Vals[i0]);
break;
case 2:
//--- Copy subdiagonal and diagonal parts
//--- check
if(!CAp::Assert(s.m_N==s.m_M,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
j0=i-s.m_DIdx[i];
i0=-j0+s.m_RIdx[i];
for(j=j0; j<=i; j++)
irow.Set(j,s.m_Vals[j+i0]);
//--- Copy superdiagonal part
upperprofile=s.m_UIdx[s.m_N];
j0=i+1;
j1=MathMin(s.m_N-1,i+upperprofile);
for(j=j0; j<=j1; j++)
if(j-i<=s.m_UIdx[j])
irow.Set(j,s.m_Vals[s.m_RIdx[j+1]-(j-i)]);
break;
}
}
//+------------------------------------------------------------------+
//| This function returns I-th row of the sparse matrix IN COMPRESSED|
//| FORMAT - only non-zero elements are returned (with their indexes)|
//| Matrix must be stored in CRS or SKS format. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in CRS format |
//| I - row index, 0<=I<M |
//| ColIdx - output buffer for column indexes, can be |
//| preallocated. In case buffer size is too small to |
//| store I-th row, it is automatically reallocated. |
//| Vals - output buffer for values, can be preallocated. In |
//| case buffer size is too small to store I-th row, it|
//| is automatically reallocated. |
//| OUTPUT PARAMETERS: |
//| ColIdx - column indexes of non-zero elements, sorted by |
//| ascending. Symbolically non-zero elements are |
//| counted (i.e. if you allocated place for element, |
//| but it has zero numerical value - it is counted). |
//| Vals - values. Vals[K] stores value of matrix element with|
//| indexes (I,ColIdx[K]). Symbolically non-zero |
//| elements are counted (i.e. if you allocated place |
//| for element, but it has zero numerical value - it |
//| is counted). |
//| NZCnt - number of symbolically non-zero elements per row. |
//| NOTE: when incorrect I (outside of [0,M-1]) or matrix (non |
//| CRS/SKS) is passed, this function throws exception. |
//| NOTE: this function may allocate additional, unnecessary place |
//| for ColIdx and Vals arrays. It is dictated by performance |
//| reasons - on SKS matrices it is faster to allocate space at |
//| the beginning with some "extra"-space, than performing two |
//| passes over matrix - first time to calculate exact space |
//| required for data, second time - to store data itself. |
//+------------------------------------------------------------------+
void CSparse::SparseGetCompressedRow(CSparseMatrix &s,int i,
CRowInt &ColIdx,
CRowDouble &Vals,int &NZCnt)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1 || s.m_MatrixType==2,__FUNCTION__+": S must be CRS/SKS-based matrix"))
return;
//--- check
if(!CAp::Assert(i>=0 && i<s.m_M,__FUNCTION__+": I<0 or I>=M"))
return;
//--- create variables
int k=0;
int k0=0;
int j=0;
int j0=0;
int j1=0;
int i0=0;
int upperprofile=0;
//--- Initialize NZCnt
NZCnt=0;
switch(s.m_MatrixType)
{
case 1:
//--- CRS matrix - just copy data
NZCnt=s.m_RIdx[i+1]-s.m_RIdx[i];
CApServ::IVectorSetLengthAtLeast(ColIdx,NZCnt);
CApServ::RVectorSetLengthAtLeast(Vals,NZCnt);
k0=s.m_RIdx[i];
for(k=0; k<=NZCnt-1; k++)
{
ColIdx.Set(k,s.m_Idx[k0+k]);
Vals.Set(k,s.m_Vals[k0+k]);
}
break;
case 2:
//--- SKS matrix - a bit more complex sequence
//--- check
if(!CAp::Assert(s.m_N==s.m_M,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
//--- Allocate enough place for storage
upperprofile=s.m_UIdx[s.m_N];
CApServ::IVectorSetLengthAtLeast(ColIdx,s.m_DIdx[i]+1+upperprofile);
CApServ::RVectorSetLengthAtLeast(Vals,s.m_DIdx[i]+1+upperprofile);
//--- Copy subdiagonal and diagonal parts
j0=i-s.m_DIdx[i];
i0=-j0+s.m_RIdx[i];
for(j=j0; j<=i; j++)
{
ColIdx.Set(NZCnt,j);
Vals.Set(NZCnt,s.m_Vals[j+i0]);
NZCnt++;
}
//--- Copy superdiagonal part
j0=i+1;
j1=MathMin(s.m_N-1,i+upperprofile);
for(j=j0; j<=j1; j++)
{
if(j-i<=s.m_UIdx[j])
{
ColIdx.Set(NZCnt,j);
Vals.Set(NZCnt,s.m_Vals[s.m_RIdx[j+1]-(j-i)]);
NZCnt++;
}
}
break;
}
}
//+------------------------------------------------------------------+
//| This function performs efficient in-place transpose of SKS matrix|
//| No additional memory is allocated during transposition. |
//| This function supports only skyline storage format (SKS). |
//| INPUT PARAMETERS: |
//| S - sparse matrix in SKS format. |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix, transposed. |
//+------------------------------------------------------------------+
void CSparse::SparseTransposeSKS(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==2,__FUNCTION__+": only SKS matrices are supported"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
//--- create variables
int n=s.m_N;
int d=0;
int u=0;
int i=0;
int k=0;
int t0=0;
int t1=0;
double v=0;
for(i=1; i<n; i++)
{
d=s.m_DIdx[i];
u=s.m_UIdx[i];
k=s.m_UIdx[i];
s.m_UIdx.Set(i,s.m_DIdx[i]);
s.m_DIdx.Set(i,k);
if(d==u)
{
//--- Upper skyline height equal to lower skyline height,
//--- simple exchange is needed for transposition
t0=s.m_RIdx[i];
for(k=0; k<d; k++)
{
v=s.m_Vals[t0+k];
s.m_Vals.Set(t0+k,s.m_Vals[t0+d+1+k]);
s.m_Vals.Set(t0+d+1+k,v);
}
}
if(d>u)
{
//--- Upper skyline height is less than lower skyline height.
//--- Transposition becomes a bit tricky: we have to rearrange
//--- "L0 L1 D U" to "U D L0 L1", where |L0|=|U|=u, |L1|=d-u.
//--- In order to do this we perform a sequence of swaps and
//--- in-place reversals:
//---*swap(L0,U) => "U L1 D L0"
//---*reverse("L1 D L0") => "U L0~ D L1~" (where X~ is a reverse of X)
//---*reverse("L0~ D") => "U D L0 L1~"
//---*reverse("L1") => "U D L0 L1"
t0=s.m_RIdx[i];
t1=s.m_RIdx[i]+d+1;
for(k=0; k<u; k++)
{
v=s.m_Vals[t0+k];
s.m_Vals.Set(t0+k,s.m_Vals[t1+k]);
s.m_Vals.Set(t1+k,v);
}
t0=s.m_RIdx[i]+u;
t1=s.m_RIdx[i+1]-1;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
t0=s.m_RIdx[i]+u;
t1=t0+u;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
t0=s.m_RIdx[i+1]-(d-u);
t1=s.m_RIdx[i+1]-1;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
}
if(d<u)
{
//--- Upper skyline height is greater than lower skyline height.
//--- Transposition becomes a bit tricky: we have to rearrange
//--- "L D U0 U1" to "U0 U1 D L", where |U1|=|L|=d, |U0|=u-d.
//--- In order to do this we perform a sequence of swaps and
//--- in-place reversals:
//---*swap(L,U1) => "U1 D U0 L"
//---*reverse("U1 D U0") => "U0~ D U1~ L" (where X~ is a reverse of X)
//---*reverse("U0~") => "U0 D U1~ L"
//---*reverse("D U1~") => "U0 U1 D L"
t0=s.m_RIdx[i];
t1=s.m_RIdx[i+1]-d;
for(k=0; k<d; k++)
{
v=s.m_Vals[t0+k];
s.m_Vals.Set(t0+k,s.m_Vals[t1+k]);
s.m_Vals.Set(t1+k,v);
}
t0=s.m_RIdx[i];
t1=t0+u;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
t0=s.m_RIdx[i];
t1=t0+u-d-1;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
t0=s.m_RIdx[i]+u-d;
t1=s.m_RIdx[i+1]-d-1;
while(t1>t0)
{
v=s.m_Vals[t0];
s.m_Vals.Set(t0,s.m_Vals[t1]);
s.m_Vals.Set(t1,v);
t0=t0+1;
t1=t1-1;
}
}
}
k=s.m_UIdx[n];
s.m_UIdx.Set(n,s.m_DIdx[n]);
s.m_DIdx.Set(n,k);
}
//+------------------------------------------------------------------+
//| This function performs transpose of CRS matrix. |
//| INPUT PARAMETERS: |
//| S - sparse matrix in CRS format. |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix, transposed. |
//| NOTE: internal temporary copy is allocated for the purposes of |
//| transposition. It is deallocated after transposition. |
//+------------------------------------------------------------------+
void CSparse::SparseTransposeCRS(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(s.m_MatrixType==1,"SparseTransposeCRS: only CRS matrices are supported"))
return;
//--- return result
CRowDouble oldvals;
CRowInt oldidx;
CRowInt oldridx;
int i=0;
int j=0;
int k=0;
int nonne=0;
int counts[];
int oldn=s.m_N;
int oldm=s.m_M;
int newn=oldm;
int newm=oldn;
CAp::Swap(s.m_Vals,oldvals);
CAp::Swap(s.m_Idx,oldidx);
CAp::Swap(s.m_RIdx,oldridx);
//--- Update matrix size
s.m_N=newn;
s.m_M=newm;
//--- Fill RIdx by number of elements per row:
//--- RIdx[I+1] stores number of elements in I-th row.
//--- Convert RIdx from row sizes to row offsets.
//-- Set NInitialized
nonne=0;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,newm+1);
s.m_RIdx.Fill(0,0,newm+1);
for(i=0; i<=oldm-1; i++)
{
for(j=oldridx[i]; j<=oldridx[i+1]-1; j++)
{
k=oldidx[j]+1;
s.m_RIdx.Set(k,s.m_RIdx[k]+1);
nonne++;
}
}
for(i=0; i<=newm-1; i++)
s.m_RIdx.Set(i+1,s.m_RIdx[i+1]+s.m_RIdx[i]);
s.m_NInitialized=s.m_RIdx[newm];
//--- Allocate memory and move elements to Vals/Idx.
ArrayResize(counts,newm);
ArrayFill(counts,0,newm,0);
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nonne);
CApServ::IVectorSetLengthAtLeast(s.m_Idx,nonne);
for(i=0; i<oldm; i++)
for(j=oldridx[i]; j<oldridx[i+1]; j++)
{
k=oldidx[j];
k=s.m_RIdx[k]+counts[k];
s.m_Idx.Set(k,i);
s.m_Vals.Set(k,oldvals[j]);
k=oldidx[j];
counts[k]++;
}
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s);
}
//+------------------------------------------------------------------+
//| This function performs copying with transposition of CRS matrix. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in CRS format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix, transposed |
//+------------------------------------------------------------------+
void CSparse::SparseCopyTransposeCRS(CSparseMatrix &s0,
CSparseMatrix &s1)
{
SparseCopyTransposeCRSBuf(s0,s1);
}
//+------------------------------------------------------------------+
//| This function performs copying with transposition of CRS matrix |
//| (buffered version which reuses memory already allocated by the |
//| target as much as possible). |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in CRS format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix, transposed; previously allocated memory|
//| is reused if possible. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyTransposeCRSBuf(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert(s0.m_MatrixType==1,__FUNCTION__+": only CRS matrices are supported"))
return;
//--- create variables
int i=0;
int j=0;
int k=0;
int kk=0;
int j0=0;
int j1=0;
int oldn=s0.m_N;
int oldm=s0.m_M;
int newn=oldm;
int newm=oldn;
//--- Update matrix size
s1.m_MatrixType=1;
s1.m_N=newn;
s1.m_M=newm;
//--- Fill RIdx by number of elements per row:
//--- RIdx[I+1] stores number of elements in I-th row.
//--- Convert RIdx from row sizes to row offsets.
//--- Set NInitialized
CAblasF::ISetAllocV(newm+1,0,s1.m_RIdx);
for(i=0; i<oldm; i++)
{
j0=s0.m_RIdx[i];
j1=s0.m_RIdx[i+1];
for(j=j0; j<j1; j++)
{
k=s0.m_Idx[j]+1;
s1.m_RIdx.Set(k,s1.m_RIdx[k]+1);
}
}
for(i=0; i<newm; i++)
s1.m_RIdx.Set(i+1,s1.m_RIdx[i+1]+s1.m_RIdx[i]);
s1.m_NInitialized=s1.m_RIdx[newm];
//--- Allocate memory and move elements to Vals/Idx.
CApServ::IVectorSetLengthAtLeast(s1.m_DIdx,newm);
for(i=0; i<=newm-1; i++)
s1.m_DIdx.Set(i,s1.m_RIdx[i]);
CApServ::RVectorSetLengthAtLeast(s1.m_Vals,s1.m_NInitialized);
CApServ::IVectorSetLengthAtLeast(s1.m_Idx,s1.m_NInitialized);
for(i=0; i<oldm; i++)
{
j0=s0.m_RIdx[i];
j1=s0.m_RIdx[i+1] ;
for(j=j0; j<j1; j++)
{
kk=s0.m_Idx[j];
k=s1.m_DIdx[kk];
s1.m_Idx.Set(k,i);
s1.m_Vals.Set(k,s0.m_Vals[j]);
s1.m_DIdx.Set(kk,k+1);
}
}
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s1);
}
//+------------------------------------------------------------------+
//| This function performs in-place conversion to desired sparse |
//| storage format. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| Fmt - desired storage format of the output, as returned by |
//| SparseGetMatrixType() function: |
//| * 0 for hash-based storage |
//| * 1 for CRS |
//| * 2 for SKS |
//| OUTPUT PARAMETERS: |
//| S0 - sparse matrix in requested format. |
//| NOTE: in-place conversion wastes a lot of memory which is used |
//| to store temporaries. If you perform a lot of repeated |
//| conversions, we recommend to use out-of-place buffered |
//| conversion functions, like SparseCopyToBuf(), which can |
//| reuse already allocated memory. |
//+------------------------------------------------------------------+
void CSparse::SparseConvertTo(CSparseMatrix &s0,int fmt)
{
//--- check
if(!CAp::Assert((fmt==0 || fmt==1) || fmt==2,__FUNCTION__+": invalid fmt parameter"))
return;
switch(fmt)
{
case 0:
SparseConvertToHash(s0);
break;
case 1:
SparseConvertToCRS(s0);
break;
case 2:
SparseConvertToSKS(s0);
break;
default:
CAp::Assert(false,__FUNCTION__+": invalid matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to desired sparse |
//| storage format. S0 is copied to S1 and converted on-the-fly. |
//| Memory allocated in S1 is reused to maximum extent possible. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| Fmt - desired storage format of the output, as returned by |
//| SparseGetMatrixType() function: |
//| * 0 for hash-based storage |
//| * 1 for CRS |
//| * 2 for SKS |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in requested format. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToBuf(CSparseMatrix &s0,int fmt,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((fmt==0 || fmt==1) || fmt==2,__FUNCTION__+": invalid fmt parameter"))
return;
switch(fmt)
{
case 0:
SparseCopyToHashBuf(s0,s1);
break;
case 1:
SparseCopyToCRSBuf(s0,s1);
break;
case 2:
SparseCopyToSKSBuf(s0,s1);
break;
default:
CAp::Assert(false,"SparseCopyToBuf: invalid matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function performs in-place conversion to Hash table storage.|
//| INPUT PARAMETERS: |
//| S - sparse matrix in CRS format. |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix in Hash table format. |
//| NOTE: this function has no effect when called with matrix which |
//| is already in Hash table mode. |
//| NOTE: in-place conversion involves allocation of temporary arrays|
//| If you perform a lot of repeated in-place conversions, it |
//| may lead to memory fragmentation. Consider using |
//| out-of-place SparseCopyToHashBuf() function in this case. |
//+------------------------------------------------------------------+
void CSparse::SparseConvertToHash(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
//--- create variables
CRowInt tidx;
CRowInt tridx;
CRowInt tdidx;
CRowInt tuidx;
CRowDouble tvals;
int n=0;
int m=0;
int offs0=0;
int i=0;
int j=0;
int k=0;
switch(s.m_MatrixType)
{
case 0:
//--- Already in Hash mode
break;
case 1:
//--- From CRS to Hash
s.m_MatrixType=0;
m=s.m_M;
n=s.m_N;
CAp::Swap(s.m_Idx,tidx);
CAp::Swap(s.m_RIdx,tridx);
CAp::Swap(s.m_Vals,tvals);
SparseCreateBuf(m,n,tridx[m],s);
for(i=0; i<m; i++)
for(j=tridx[i]; j<tridx[i+1]; j++)
SparseSet(s,i,tidx[j],tvals[j]);
break;
case 2:
//--- From SKS to Hash
s.m_MatrixType=0;
m=s.m_M;
n=s.m_N;
CAp::Swap(s.m_RIdx,tridx);
CAp::Swap(s.m_DIdx,tdidx);
CAp::Swap(s.m_UIdx,tuidx);
CAp::Swap(s.m_Vals,tvals);
SparseCreateBuf(m,n,tridx[m],s);
for(i=0; i<m; i++)
{
//--- copy subdiagonal and diagonal parts of I-th block
offs0=tridx[i];
k=tdidx[i]+1;
for(j=0; j<k; j++)
SparseSet(s,i,i-tdidx[i]+j,tvals[offs0+j]);
//--- Copy superdiagonal part of I-th block
offs0=tridx[i]+tdidx[i]+1;
k=tuidx[i];
for(j=0; j<k; j++)
SparseSet(s,i-k+j,i,tvals[offs0+j]);
}
break;
default:
CAp::Assert(false,__FUNCTION__+": invalid matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to Hash table |
//| storage format. S0 is copied to S1 and converted on-the-fly. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in Hash table format. |
//| NOTE: if S0 is stored as Hash-table, it is just copied without |
//| conversion. |
//| NOTE: this function de-allocates memory occupied by S1 before |
//| starting conversion. If you perform a lot of repeated |
//| conversions, it may lead to memory fragmentation. In this |
//| case we recommend you to use SparseCopyToHashBuf() function |
//| which re-uses memory in S1 as much as possible. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToHash(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
SparseCopyToHashBuf(s0,s1);
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to Hash table |
//| storage format. S0 is copied to S1 and converted on-the-fly. |
//| Memory allocated in S1 is reused to maximum extent possible. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in Hash table format. |
//| NOTE: if S0 is stored as Hash-table, it is just copied without |
//| conversion. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToHashBuf(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
//--- create variables
double val=0;
int t0=0;
int t1=0;
int i=0;
int j=0;
switch(s0.m_MatrixType)
{
case 0:
//--- Already hash, just copy
SparseCopyBuf(s0,s1);
break;
case 1:
//--- CRS storage
t0=0;
t1=0;
SparseCreateBuf(s0.m_M,s0.m_N,s0.m_RIdx[s0.m_M],s1);
while(SparseEnumerate(s0,t0,t1,i,j,val))
SparseSet(s1,i,j,val);
break;
case 2:
//--- SKS storage
t0=0;
t1=0;
SparseCreateBuf(s0.m_M,s0.m_N,s0.m_RIdx[s0.m_M],s1);
while(SparseEnumerate(s0,t0,t1,i,j,val))
SparseSet(s1,i,j,val);
break;
default:
CAp::Assert(false,__FUNCTION__+": invalid matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function converts matrix to CRS format. |
//| Some algorithms (linear algebra ones, for example) require |
//| matrices in CRS format. This function allows to perform in-place |
//| conversion. |
//| INPUT PARAMETERS: |
//| S - sparse M*N matrix in any format |
//| OUTPUT PARAMETERS: |
//| S - matrix in CRS format |
//| NOTE: this function has no effect when called with matrix which |
//| is already in CRS mode. |
//| NOTE: this function allocates temporary memory to store a copy of|
//| the matrix. If you perform a lot of repeated conversions, we|
//| recommend you to use SparseCopyToCRSBuf() function, which |
//| can reuse previously allocated memory. |
//+------------------------------------------------------------------+
void CSparse::SparseConvertToCRS(CSparseMatrix &s)
{
//--- create variables
int i=0;
int j=0;
CRowDouble tvals;
CRowInt tidx;
CRowInt temp;
CRowInt tridx;
int nonne=0;
int k=0;
int offs0=0;
int offs1=0;
int m=s.m_M;
switch(s.m_MatrixType)
{
case 0:
//--- From Hash-table to CRS.
//--- First, create local copy of the hash table.
s.m_MatrixType=1;
k=s.m_TableSize;
CAp::Swap(s.m_Vals,tvals);
CAp::Swap(s.m_Idx,tidx);
//--- Fill RIdx by number of elements per row:
//--- RIdx[I+1] stores number of elements in I-th row.
//--- Convert RIdx from row sizes to row offsets.
//--- Set NInitialized
nonne=0;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,s.m_M+1);
s.m_RIdx.Fill(0,0,s.m_M+1);
for(i=0; i<k; i++)
if(tidx[2*i]>=0)
{
s.m_RIdx.Set(tidx[2*i]+1,s.m_RIdx[tidx[2*i]+1]+1);
nonne++;
}
for(i=0; i<s.m_M; i++)
s.m_RIdx.Set(i+1,s.m_RIdx[i+1]+s.m_RIdx[i]);
s.m_NInitialized=s.m_RIdx[s.m_M];
//--- Allocate memory and move elements to Vals/Idx.
//--- Initially, elements are sorted by rows, but unsorted within row.
//--- After initial insertion we sort elements within row.
temp.Resize(s.m_M);
temp.Fill(0,0,s.m_M);
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nonne);
CApServ::IVectorSetLengthAtLeast(s.m_Idx,nonne);
for(i=0; i<k; i++)
{
if(tidx[2*i]>=0)
{
s.m_Vals.Set(s.m_RIdx[tidx[2*i]]+temp[tidx[2*i]],tvals[i]);
s.m_Idx.Set(s.m_RIdx[tidx[2*i]]+temp[tidx[2*i]],tidx[2*i+1]);
temp.Set(tidx[2*i],temp[tidx[2*i]]+1);
}
}
for(i=0; i<s.m_M; i++)
CTSort::TagSortMiddleIR(s.m_Idx,s.m_Vals,s.m_RIdx[i],s.m_RIdx[i+1]-s.m_RIdx[i]);
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s);
break;
case 1:
//--- Already CRS
break;
case 2:
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
//--- From SKS to CRS.
//--- First, create local copy of the SKS matrix (Vals,
//--- Idx, RIdx are stored; DIdx/UIdx for some time are
//--- left in the SparseMatrix structure).
s.m_MatrixType=1;
CAp::Swap(s.m_Vals,tvals);
CAp::Swap(s.m_Idx,tidx);
CAp::Swap(s.m_RIdx,tridx);
//--- Fill RIdx by number of elements per row:
//--- RIdx[I+1] stores number of elements in I-th row.
//--- Convert RIdx from row sizes to row offsets.
//--- Set NInitialized
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,m+1);
s.m_RIdx.Fill(1,1,m);
s.m_RIdx.Set(0,0);
nonne=0;
for(i=0; i<m; i++)
{
s.m_RIdx.Add(i+1,s.m_DIdx[i]);
for(j=i-s.m_UIdx[i]; j<i; j++)
s.m_RIdx.Add(j+1,1);
nonne+=s.m_DIdx[i]+1+s.m_UIdx[i];
}
for(i=0; i<s.m_M; i++)
s.m_RIdx.Add(i+1,s.m_RIdx[i]);
s.m_NInitialized=s.m_RIdx[s.m_M];
//--- Allocate memory and move elements to Vals/Idx.
//--- Initially, elements are sorted by rows, and are sorted within row too.
//--- No additional post-sorting is required.
temp.Resize(m);
temp.Fill(0,0,m);
CApServ::RVectorSetLengthAtLeast(s.m_Vals,nonne);
CApServ::IVectorSetLengthAtLeast(s.m_Idx,nonne);
for(i=0; i<m; i++)
{
//--- copy subdiagonal and diagonal parts of I-th block
offs0=tridx[i];
offs1=s.m_RIdx[i]+temp[i];
k=s.m_DIdx[i]+1;
for(j=0; j<k; j++)
{
s.m_Vals.Set(offs1+j,tvals[offs0+j]);
s.m_Idx.Set(offs1+j,i-s.m_DIdx[i]+j);
}
temp.Set(i,temp[i]+s.m_DIdx[i]+1);
//--- Copy superdiagonal part of I-th block
offs0=tridx[i]+s.m_DIdx[i]+1;
k=s.m_UIdx[i];
for(j=0; j<k; j++)
{
offs1=s.m_RIdx[i-k+j]+temp[i-k+j];
s.m_Vals.Set(offs1,tvals[offs0+j]);
s.m_Idx.Set(offs1,i);
temp.Set(i-k+j,temp[i-k+j]+1);
}
}
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s);
break;
default:
CAp::Assert(false,__FUNCTION__+": invalid matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to CRS format. S0 |
//| is copied to S1 and converted on-the-fly. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in CRS format. |
//| NOTE: if S0 is stored as CRS, it is just copied without |
//| conversion. |
//| NOTE: this function de-allocates memory occupied by S1 before |
//| starting CRS conversion. If you perform a lot of repeated |
//| CRS conversions, it may lead to memory fragmentation. In |
//| this case we recommend you to use SparseCopyToCRSBuf() |
//| function which re-uses memory in S1 as much as possible. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToCRS(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
SparseCopyToCRSBuf(s0,s1);
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to CRS format. S0 |
//| is copied to S1 and converted on-the-fly. Memory allocated in S1 |
//| is reused to maximum extent possible. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| S1 - matrix which may contain some pre-allocated memory, or|
//| can be just uninitialized structure. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in CRS format. |
//| NOTE: if S0 is stored as CRS, it is just copied without |
//| conversion. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToCRSBuf(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
//--- create variables
int temp[];
int nonne=0;
int i=0;
int j=0;
int k=0;
int offs0=0;
int offs1=0;
int m=s0.m_M;
switch(s0.m_MatrixType)
{
case 0:
//--- Convert from hash-table to CRS
//--- Done like ConvertToCRS function
s1.m_MatrixType=1;
s1.m_M=s0.m_M;
s1.m_N=s0.m_N;
s1.m_NFree=s0.m_NFree;
nonne=0;
k=s0.m_TableSize;
CApServ::IVectorSetLengthAtLeast(s1.m_RIdx,s1.m_M+1);
s1.m_RIdx.Fill(0,0,s1.m_M+1);
ArrayResize(temp,s1.m_M);
ArrayFill(temp,0,s1.m_M,0);
//--- Number of elements per row
for(i=0; i<k; i++)
if(s0.m_Idx[2*i]>=0)
{
s1.m_RIdx.Set(s0.m_Idx[2*i]+1,s1.m_RIdx[s0.m_Idx[2*i]+1]+1);
nonne=nonne+1;
}
//--- Fill RIdx (offsets of rows)
for(i=0; i<s1.m_M; i++)
s1.m_RIdx.Set(i+1,s1.m_RIdx[i+1]+s1.m_RIdx[i]);
//--- Allocate memory
CApServ::RVectorSetLengthAtLeast(s1.m_Vals,nonne);
CApServ::IVectorSetLengthAtLeast(s1.m_Idx,nonne);
for(i=0; i<k; i++)
if(s0.m_Idx[2*i]>=0)
{
s1.m_Vals.Set(s1.m_RIdx[s0.m_Idx[2*i]]+temp[s0.m_Idx[2*i]],s0.m_Vals[i]);
s1.m_Idx.Set(s1.m_RIdx[s0.m_Idx[2*i]]+temp[s0.m_Idx[2*i]],s0.m_Idx[2*i+1]);
temp[s0.m_Idx[2*i]]=temp[s0.m_Idx[2*i]]+1;
}
//--- Set NInitialized
s1.m_NInitialized=s1.m_RIdx[s1.m_M];
//--- Sorting of elements
for(i=0; i<s1.m_M; i++)
CTSort::TagSortMiddleIR(s1.m_Idx,s1.m_Vals,s1.m_RIdx[i],s1.m_RIdx[i+1]-s1.m_RIdx[i]);
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s1);
break;
case 1:
//--- Already CRS, just copy
SparseCopyBuf(s0,s1);
break;
case 2:
//--- check
if(!CAp::Assert(s0.m_M==s0.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return;
//--- From SKS to CRS.
s1.m_M=s0.m_M;
s1.m_N=s0.m_N;
s1.m_MatrixType=1;
//--- Fill RIdx by number of elements per row:
//--- RIdx[I+1] stores number of elements in I-th row.
//--- Convert RIdx from row sizes to row offsets.
//--- Set NInitialized
CApServ::IVectorSetLengthAtLeast(s1.m_RIdx,m+1);
s1.m_RIdx.Set(0,0);
s1.m_RIdx.Fill(1,1,m);
nonne=0;
for(i=0; i<m; i++)
{
s1.m_RIdx.Set(i+1,s0.m_DIdx[i]+s1.m_RIdx[i+1]);
for(j=i-s0.m_UIdx[i]; j<i; j++)
s1.m_RIdx.Set(j+1,s1.m_RIdx[j+1]+1);
nonne+=s0.m_DIdx[i]+1+s0.m_UIdx[i];
}
for(i=0; i<m; i++)
s1.m_RIdx.Set(i+1,s1.m_RIdx[i+1]+s1.m_RIdx[i]);
s1.m_NInitialized=s1.m_RIdx[m];
//--- Allocate memory and move elements to Vals/Idx.
//--- Initially, elements are sorted by rows, and are sorted within row too.
//--- No additional post-sorting is required.
ArrayResize(temp,m);
ArrayFill(temp,0,m,0);
CApServ::RVectorSetLengthAtLeast(s1.m_Vals,nonne);
CApServ::IVectorSetLengthAtLeast(s1.m_Idx,nonne);
for(i=0; i<m; i++)
{
//--- copy subdiagonal and diagonal parts of I-th block
offs0=s0.m_RIdx[i];
offs1=s1.m_RIdx[i]+temp[i];
k=s0.m_DIdx[i]+1;
for(j=0; j<k; j++)
{
s1.m_Vals.Set(offs1+j,s0.m_Vals[offs0+j]);
s1.m_Idx.Set(offs1+j,i-s0.m_DIdx[i]+j);
}
temp[i]=temp[i]+s0.m_DIdx[i]+1;
//--- Copy superdiagonal part of I-th block
offs0=s0.m_RIdx[i]+s0.m_DIdx[i]+1;
k=s0.m_UIdx[i];
for(j=0; j<k; j++)
{
offs1=s1.m_RIdx[i-k+j]+temp[i-k+j];
s1.m_Vals.Set(offs1,s0.m_Vals[offs0+j]);
s1.m_Idx.Set(offs1,i);
temp[i-k+j]=temp[i-k+j]+1;
}
}
//--- Initialization 'S.m_UIdx' and 'S.m_DIdx'
SparseInitDUIdx(s1);
break;
default:
CAp::Assert(false,"SparseCopyToCRSBuf: unexpected matrix type");
break;
}
}
//+------------------------------------------------------------------+
//| This function performs in-place conversion to SKS format. |
//| INPUT PARAMETERS: |
//| S - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix in SKS format. |
//| NOTE: this function has no effect when called with matrix which |
//| is already in SKS mode. |
//| NOTE: in-place conversion involves allocation of temporary arrays|
//| If you perform a lot of repeated in-place conversions, it may|
//| lead to memory fragmentation. Consider using out-of-place |
//| SparseCopyToSKSBuf() function in this case. |
//+------------------------------------------------------------------+
void CSparse::SparseConvertToSKS(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": rectangular matrices are not supported"))
return;
//--- create variables
CRowInt tridx;
CRowInt tdidx;
CRowInt tuidx;
CRowDouble tvals;
int n=s.m_N;
int t0=0;
int t1=0;
int i=0;
int j=0;
int k=0;
double v=0;
if(s.m_MatrixType==2)
//--- Already in SKS mode
return;
//--- Generate internal copy of SKS matrix
CApServ::IVectorSetLengthAtLeast(tdidx,n+1);
CApServ::IVectorSetLengthAtLeast(tuidx,n+1);
tdidx.Fill(0,0,n+1);
tuidx.Fill(0,0,n+1);
t0=0;
t1=0;
while(SparseEnumerate(s,t0,t1,i,j,v))
{
if(j<i)
tdidx.Set(i,MathMax(tdidx[i],i-j));
else
tuidx.Set(j,MathMax(tuidx[j],j-i));
}
CApServ::IVectorSetLengthAtLeast(tridx,n+1);
tridx.Set(0,0);
for(i=1; i<=n; i++)
tridx.Set(i,tridx[i-1]+tdidx[i-1]+1+tuidx[i-1]);
tvals=vector<double>::Zeros(tridx[n]);
t0=0;
t1=0;
while(SparseEnumerate(s,t0,t1,i,j,v))
{
if(j<=i)
tvals.Set(tridx[i]+tdidx[i]-(i-j),v);
else
tvals.Set(tridx[j+1]-(j-i),v);
}
for(i=0; i<n; i++)
{
tdidx.Set(n,MathMax(tdidx[n],tdidx[i]));
tuidx.Set(n,MathMax(tuidx[n],tuidx[i]));
}
s.m_MatrixType=2;
s.m_NInitialized=0;
s.m_NFree=0;
s.m_M=n;
s.m_N=n;
CAp::Swap(s.m_DIdx,tdidx);
CAp::Swap(s.m_UIdx,tuidx);
CAp::Swap(s.m_RIdx,tridx);
CAp::Swap(s.m_Vals,tvals);
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to SKS storage |
//| format. S0 is copied to S1 and converted on-the-fly. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in SKS format. |
//| NOTE: if S0 is stored as SKS, it is just copied without |
//| conversion. |
//| NOTE: this function de-allocates memory occupied by S1 before |
//| starting conversion. If you perform a lot of repeated |
//| conversions, it may lead to memory fragmentation. In this |
//| case we recommend you to use SparseCopyToSKSBuf() function |
//| which re-uses memory in S1 as much as possible. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToSKS(CSparseMatrix &s0,
CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
SparseCopyToSKSBuf(s0,s1);
}
//+------------------------------------------------------------------+
//| This function performs out-of-place conversion to SKS format. S0 |
//| is copied to S1 and converted on-the-fly. Memory allocated in S1 |
//| is reused to maximum extent possible. |
//| INPUT PARAMETERS: |
//| S0 - sparse matrix in any format. |
//| OUTPUT PARAMETERS: |
//| S1 - sparse matrix in SKS format. |
//| NOTE: if S0 is stored as SKS, it is just copied without |
//| conversion. |
//+------------------------------------------------------------------+
void CSparse::SparseCopyToSKSBuf(CSparseMatrix &s0,CSparseMatrix &s1)
{
//--- check
if(!CAp::Assert((s0.m_MatrixType==0 || s0.m_MatrixType==1) || s0.m_MatrixType==2,__FUNCTION__+": invalid matrix type"))
return;
//--- check
if(!CAp::Assert(s0.m_M==s0.m_N,__FUNCTION__+": rectangular matrices are not supported"))
return;
//--- create variables
double v=0;
int n=s0.m_N;
int t0=0;
int t1=0;
int i=0;
int j=0;
int k=0;
if(s0.m_MatrixType==2)
{
//--- Already SKS, just copy
SparseCopyBuf(s0,s1);
return;
}
//--- Generate copy of matrix in the SKS format
CApServ::IVectorSetLengthAtLeast(s1.m_DIdx,n+1);
CApServ::IVectorSetLengthAtLeast(s1.m_UIdx,n+1);
s1.m_DIdx.Fill(0,0,n+1);
s1.m_UIdx.Fill(0,0,n+1);
t0=0;
t1=0;
while(SparseEnumerate(s0,t0,t1,i,j,v))
{
if(j<i)
s1.m_DIdx.Set(i,MathMax(s1.m_DIdx[i],i-j));
else
s1.m_UIdx.Set(j,MathMax(s1.m_UIdx[j],j-i));
}
CApServ::IVectorSetLengthAtLeast(s1.m_RIdx,n+1);
s1.m_RIdx.Set(0,0);
for(i=1; i<=n; i++)
s1.m_RIdx.Set(i,s1.m_RIdx[i-1]+s1.m_DIdx[i-1]+1+s1.m_UIdx[i-1]);
s1.m_Vals=vector<double>::Zeros(s1.m_RIdx[n]);
t0=0;
t1=0;
while(SparseEnumerate(s0,t0,t1,i,j,v))
{
if(j<=i)
s1.m_Vals.Set(s1.m_RIdx[i]+s1.m_DIdx[i]-(i-j),v);
else
s1.m_Vals.Set(s1.m_RIdx[j+1]-(j-i),v);
}
for(i=0; i<n; i++)
{
s1.m_DIdx.Set(n,MathMax(s1.m_DIdx[n],s1.m_DIdx[i]));
s1.m_UIdx.Set(n,MathMax(s1.m_UIdx[n],s1.m_UIdx[i]));
}
s1.m_MatrixType=2;
s1.m_NInitialized=0;
s1.m_NFree=0;
s1.m_M=n;
s1.m_N=n;
}
//+------------------------------------------------------------------+
//| This non-accessible to user function performs in-place creation |
//| of CRS matrix. It is expected that: |
//| * S.M and S.N are initialized |
//| * S.m_RIdx, S.m_Idx and S.m_Vals are loaded with values in CRS |
//| format used by ALGLIB, with elements of S.m_Idx/S.m_Vals |
//| possibly being unsorted within each row (this constructor |
//| function may post-sort matrix, assuming that it is sorted by |
//| rows). |
//| Only 5 fields should be set by caller. Other fields will be |
//| rewritten by this constructor function. |
//| This function performs integrity check on user-specified values, |
//| with the only exception being Vals[] array: |
//| * it does not require values to be non-zero |
//| * it does not check for elements of Vals[] being finite |
//| IEEE-754 values |
//| INPUT PARAMETERS: |
//| S - sparse matrix with corresponding fields set by caller |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix in CRS format. |
//+------------------------------------------------------------------+
void CSparse::SparseCreateCRSInplace(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert(s.m_M>=0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(s.m_N>=0,__FUNCTION__+": integrity check failed"))
return;
//--- create variables
int i=0;
int j=0;
int j0=0;
int j1=0;
int m=s.m_M;
int n=s.m_N;
//--- Quick exit for M=0 or N=0
if(m==0 || n==0)
{
s.m_MatrixType=1;
s.m_NInitialized=0;
CApServ::IVectorSetLengthAtLeast(s.m_RIdx,s.m_M+1);
CApServ::IVectorSetLengthAtLeast(s.m_DIdx,s.m_M);
CApServ::IVectorSetLengthAtLeast(s.m_UIdx,s.m_M);
s.m_RIdx.Fill(0,0,s.m_M+1);
s.m_UIdx.Fill(0,0,s.m_M);
s.m_DIdx.Fill(0,0,s.m_M);
return;
}
//--- Perform integrity check
//--- check
if(!CAp::Assert(s.m_M>0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(s.m_N>0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(CAp::Len(s.m_RIdx)>=m+1,__FUNCTION__+": integrity check failed"))
return;
for(i=0; i<m; i++)
//--- check
if(!CAp::Assert(s.m_RIdx[i]>=0 && s.m_RIdx[i]<=s.m_RIdx[i+1],__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(s.m_RIdx[m]<=CAp::Len(s.m_Idx),__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(s.m_RIdx[m]<=CAp::Len(s.m_Vals),__FUNCTION__+": integrity check failed"))
return;
for(i=0; i<m; i++)
{
j0=s.m_RIdx[i];
j1=s.m_RIdx[i+1];
for(j=j0; j<j1; j++)
//--- check
if(!CAp::Assert(s.m_Idx[j]>=0 && s.m_Idx[j]<n,__FUNCTION__+": integrity check failed"))
return;
}
//--- Initialize
s.m_MatrixType=1;
s.m_NInitialized=s.m_RIdx[m];
for(i=0; i<m; i++)
CTSort::TagSortMiddleIR(s.m_Idx,s.m_Vals,s.m_RIdx[i],s.m_RIdx[i+1]-s.m_RIdx[i]);
SparseInitDUIdx(s);
}
//+------------------------------------------------------------------+
//| This function returns type of the matrix storage format. |
//| INPUT PARAMETERS: |
//| S - sparse matrix. |
//| RESULT: |
//| sparse storage format used by matrix: |
//| 0 - Hash-table |
//| 1 - CRS (compressed row storage) |
//| 2 - SKS (skyline) |
//| NOTE: future versions of ALGLIB may include additional sparse |
//| storage formats. |
//+------------------------------------------------------------------+
int CSparse::SparseGetMatrixType(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2) || s.m_MatrixType==-10081) || s.m_MatrixType==-10082,__FUNCTION__+": invalid matrix type"))
return(-1);
int result=s.m_MatrixType;
return(result);
}
//+------------------------------------------------------------------+
//| This function checks matrix storage format and returns True when |
//| matrix is stored using Hash table representation. |
//| INPUT PARAMETERS: |
//| S - sparse matrix. |
//| RESULT: |
//| True if matrix type is Hash table |
//| False if matrix type is not Hash table |
//+------------------------------------------------------------------+
bool CSparse::SparseIsHash(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2) || s.m_MatrixType==-10081) || s.m_MatrixType==-10082,__FUNCTION__+": invalid matrix type"))
return(false);
bool result=s.m_MatrixType==0;
return(result);
}
//+------------------------------------------------------------------+
//| This function checks matrix storage format and returns True when |
//| matrix is stored using CRS representation. |
//| INPUT PARAMETERS: |
//| S - sparse matrix. |
//| RESULT: |
//| True if matrix type is CRS |
//| False if matrix type is not CRS |
//+------------------------------------------------------------------+
bool CSparse::SparseIsCRS(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2) || s.m_MatrixType==-10081) || s.m_MatrixType==-10082,__FUNCTION__+": invalid matrix type"))
return(false);
bool result=s.m_MatrixType==1;
return(result);
}
//+------------------------------------------------------------------+
//| This function checks matrix storage format and returns True when |
//| matrix is stored using SKS representation. |
//| INPUT PARAMETERS: |
//| S - sparse matrix. |
//| RESULT: |
//| True if matrix type is SKS |
//| False if matrix type is not SKS |
//+------------------------------------------------------------------+
bool CSparse::SparseIsSKS(CSparseMatrix &s)
{
//--- check
if(!CAp::Assert((((s.m_MatrixType==0 || s.m_MatrixType==1) || s.m_MatrixType==2) || s.m_MatrixType==-10081) || s.m_MatrixType==-10082,__FUNCTION__+": invalid matrix type"))
return(false);
bool result=s.m_MatrixType==2;
return(result);
}
//+------------------------------------------------------------------+
//| The function frees all memory occupied by sparse matrix. Sparse |
//| matrix structure becomes unusable after this call. |
//| OUTPUT PARAMETERS: |
//| S - sparse matrix to delete |
//+------------------------------------------------------------------+
void CSparse::SparseFree(CSparseMatrix &s)
{
s.m_MatrixType=-1;
s.m_M=0;
s.m_N=0;
s.m_NFree=0;
s.m_NInitialized=0;
s.m_TableSize=0;
}
//+------------------------------------------------------------------+
//| The function returns number of rows of a sparse matrix. |
//| RESULT: number of rows of a sparse matrix. |
//+------------------------------------------------------------------+
int CSparse::SparseGetNRows(CSparseMatrix &s)
{
return(s.m_M);
}
//+------------------------------------------------------------------+
//| The function returns number of columns of a sparse matrix. |
//| RESULT: number of columns of a sparse matrix. |
//+------------------------------------------------------------------+
int CSparse::SparseGetNCols(CSparseMatrix &s)
{
return(s.m_N);
}
//+------------------------------------------------------------------+
//| The function returns number of strictly upper triangular non-zero|
//| elements in the matrix. It counts SYMBOLICALLY non-zero elements,|
//| i.e. entries in the sparse matrix data structure. If some element|
//| has zero numerical value, it is still counted. |
//| This function has different cost for different types of matrices:|
//| * for hash-based matrices it involves complete pass over entire|
//| hash-table with O(NNZ) cost, where NNZ is number of non-zero |
//| elements |
//| * for CRS and SKS matrix types cost of counting is O(N) |
//| (N - matrix size). |
//| RESULT: number of non-zero elements strictly above main diagonal |
//+------------------------------------------------------------------+
int CSparse::SparseGetUpperCount(CSparseMatrix &s)
{
//--- create variables
int sz=0;
int i0=0;
int i=0;
int result=-1;
switch(s.m_MatrixType)
{
case 0:
//--- Hash-table matrix
result=0;
sz=s.m_TableSize;
for(i0=0; i0<sz; i0++)
{
i=s.m_Idx[2*i0];
if(i>=0 && s.m_Idx[2*i0+1]>i)
result=result+1;
}
break;
case 1:
//--- CRS matrix
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return(-1);
result=0;
sz=s.m_M;
for(i=0; i<sz; i++)
result=result+(s.m_RIdx[i+1]-s.m_UIdx[i]);
break;
case 2:
//--- SKS matrix
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return(-1);
result=0;
sz=s.m_M;
for(i=0; i<sz; i++)
result=result+s.m_UIdx[i];
break;
default:
//--- check
if(!CAp::Assert(false,__FUNCTION__+": internal error"))
return(-1);
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| The function returns number of strictly lower triangular non-zero|
//| elements in the matrix. It counts SYMBOLICALLY non-zero elements,|
//| i.e. entries in the sparse matrix data structure. If some element|
//| has zero numerical value, it is still counted. |
//| This function has different cost for different types of matrices:|
//| * for hash-based matrices it involves complete pass over entire|
//| hash-table with O(NNZ) cost, where NNZ is number of non-zero |
//| elements |
//| * for CRS and SKS matrix types cost of counting is O(N) |
//| (N - matrix size). |
//| RESULT: number of non-zero elements strictly below main diagonal |
//+------------------------------------------------------------------+
int CSparse::SparseGetLowerCount(CSparseMatrix &s)
{
//--- create variables
int sz=0;
int i0=0;
int i=0;
int result=-1;
switch(s.m_MatrixType)
{
case 0:
//--- Hash-table matrix
result=0;
sz=s.m_TableSize;
for(i0=0; i0<sz; i0++)
{
i=s.m_Idx[2*i0];
if(i>=0 && s.m_Idx[2*i0+1]<i)
result=result+1;
}
break;
case 1:
//--- CRS matrix
//--- check
if(!CAp::Assert(s.m_NInitialized==s.m_RIdx[s.m_M],__FUNCTION__+": some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)"))
return(-1);
result=0;
sz=s.m_M;
for(i=0; i<sz; i++)
result=result+(s.m_DIdx[i]-s.m_RIdx[i]);
break;
case 2:
//--- SKS matrix
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": non-square SKS matrices are not supported"))
return(-1);
result=0;
sz=s.m_M;
for(i=0; i<sz; i++)
result=result+s.m_DIdx[i];
break;
default:
//--- check
if(!CAp::Assert(false,__FUNCTION__+": internal error"))
return(-1);
break;
}
return(result);
}
//+------------------------------------------------------------------+
//| Serializer: allocation. |
//| INTERNAL-ONLY FUNCTION, SUPPORTS ONLY CRS MATRICES |
//+------------------------------------------------------------------+
void CSparse::SparseAlloc(CSerializer &s,CSparseMatrix &a)
{
if(a.m_MatrixType==-10082)
return;
int i=0;
int nused=0;
//--- check
if(!CAp::Assert((a.m_MatrixType==0 || a.m_MatrixType==1) || a.m_MatrixType==2,__FUNCTION__+": only CRS/SKS matrices are supported"))
return;
//--- Header
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
//--- Alloc other parameters
switch(a.m_MatrixType)
{
case 0:
//--- Alloc Hash
nused=0;
for(i=0; i<a.m_TableSize; i++)
{
if(a.m_Idx[2*i+0]>=0)
nused=nused+1;
}
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
for(i=0; i<a.m_TableSize; i++)
{
if(a.m_Idx[2*i+0]>=0)
{
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
}
}
break;
case 1:
//--- Alloc CRS
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
CApServ::AllocIntegerArray(s,a.m_RIdx,a.m_M+1);
CApServ::AllocIntegerArray(s,a.m_Idx,a.m_RIdx[a.m_M]);
CApServ::AllocRealArray(s,a.m_Vals,a.m_RIdx[a.m_M]);
break;
case 2:
//--- Alloc SKS
//--- check
if(!CAp::Assert(a.m_M==a.m_N,__FUNCTION__+": rectangular SKS serialization is not supported"))
return;
s.Alloc_Entry();
s.Alloc_Entry();
CApServ::AllocIntegerArray(s,a.m_RIdx,a.m_M+1);
CApServ::AllocIntegerArray(s,a.m_DIdx,a.m_N+1);
CApServ::AllocIntegerArray(s,a.m_UIdx,a.m_N+1);
CApServ::AllocRealArray(s,a.m_Vals,a.m_RIdx[a.m_M]);
break;
}
//--- End of stream
s.Alloc_Entry();
}
//+------------------------------------------------------------------+
//| Serializer: serialization |
//| INTERNAL-ONLY FUNCTION, SUPPORTS ONLY CRS MATRICES |
//+------------------------------------------------------------------+
void CSparse::SparseSerialize(CSerializer &s,CSparseMatrix &a)
{
if(a.m_MatrixType==-10082)
return;
//--- check
if(!CAp::Assert((a.m_MatrixType==0 || a.m_MatrixType==1) || a.m_MatrixType==2,__FUNCTION__+": only CRS/SKS matrices are supported"))
return;
//--- create variables
int i=0;
int nused=0;
//--- Header
s.Serialize_Int(CSCodes::GetSparseMatrixSerializationCode());
s.Serialize_Int(a.m_MatrixType);
s.Serialize_Int(0);
//--- Serialize other parameters
switch(a.m_MatrixType)
{
case 0:
//--- Serialize Hash
nused=0;
for(i=0; i<a.m_TableSize; i++)
{
if(a.m_Idx[2*i+0]>=0)
nused=nused+1;
}
s.Serialize_Int(a.m_M);
s.Serialize_Int(a.m_N);
s.Serialize_Int(nused);
for(i=0; i<a.m_TableSize; i++)
if(a.m_Idx[2*i+0]>=0)
{
s.Serialize_Int(a.m_Idx[2*i+0]);
s.Serialize_Int(a.m_Idx[2*i+1]);
s.Serialize_Double(a.m_Vals[i]);
}
break;
case 1:
//--- Serialize CRS
s.Serialize_Int(a.m_M);
s.Serialize_Int(a.m_N);
s.Serialize_Int(a.m_NInitialized);
CApServ::SerializeIntegerArray(s,a.m_RIdx,a.m_M+1);
CApServ::SerializeIntegerArray(s,a.m_Idx,a.m_RIdx[a.m_M]);
CApServ::SerializeRealArray(s,a.m_Vals,a.m_RIdx[a.m_M]);
break;
case 2:
//--- Serialize SKS
//--- check
if(!CAp::Assert(a.m_M==a.m_N,__FUNCTION__+": rectangular SKS serialization is not supported"))
return;
s.Serialize_Int(a.m_M);
s.Serialize_Int(a.m_N);
CApServ::SerializeIntegerArray(s,a.m_RIdx,a.m_M+1);
CApServ::SerializeIntegerArray(s,a.m_DIdx,a.m_N+1);
CApServ::SerializeIntegerArray(s,a.m_UIdx,a.m_N+1);
CApServ::SerializeRealArray(s,a.m_Vals,a.m_RIdx[a.m_M]);
break;
}
//--- End of stream
s.Serialize_Int(117);
}
//+------------------------------------------------------------------+
//| Serializer: unserialization |
//+------------------------------------------------------------------+
void CSparse::SparseUnserialize(CSerializer &s,CSparseMatrix &a)
{
//--- create variables
int i=0;
int i0=0;
int i1=0;
int m=0;
int n=0;
int nused=0;
int k=0;
double v=0;
//--- Check stream header: scode, matrix type, version type
k=s.Unserialize_Int();
//--- check
if(!CAp::Assert(k==CSCodes::GetSparseMatrixSerializationCode(),__FUNCTION__+": stream header corrupted"))
return;
a.m_MatrixType=s.Unserialize_Int();
//--- check
if(!CAp::Assert((a.m_MatrixType==0 || a.m_MatrixType==1) || a.m_MatrixType==2,__FUNCTION__+": unexpected matrix type"))
return;
k=s.Unserialize_Int();
//--- check
if(!CAp::Assert(k==0,__FUNCTION__+": stream header corrupted"))
return;
//--- Unserialize other parameters
switch(a.m_MatrixType)
{
case 0:
//--- Unerialize Hash
m=s.Unserialize_Int();
n=s.Unserialize_Int();
nused=s.Unserialize_Int();
SparseCreate(m,n,nused,a);
for(i=0; i<nused; i++)
{
i0=s.Unserialize_Int();
i1=s.Unserialize_Int();
v=s.Unserialize_Double();
SparseSet(a,i0,i1,v);
}
break;
case 1:
//--- Unserialize CRS
a.m_M=s.Unserialize_Int();
a.m_N=s.Unserialize_Int();
a.m_NInitialized=s.Unserialize_Int();
CApServ::UnserializeIntegerArray(s,a.m_RIdx);
CApServ::UnserializeIntegerArray(s,a.m_Idx);
CApServ::UnserializeRealArray(s,a.m_Vals);
SparseInitDUIdx(a);
break;
case 2:
//--- Unserialize SKS
a.m_M=s.Unserialize_Int();
a.m_N=s.Unserialize_Int();
//--- check
if(!CAp::Assert(a.m_M==a.m_N,__FUNCTION__+": rectangular SKS unserialization is not supported"))
return;
CApServ::UnserializeIntegerArray(s,a.m_RIdx);
CApServ::UnserializeIntegerArray(s,a.m_DIdx);
CApServ::UnserializeIntegerArray(s,a.m_UIdx);
CApServ::UnserializeRealArray(s,a.m_Vals);
break;
}
//--- End of stream
k=s.Unserialize_Int();
CAp::Assert(k==117,__FUNCTION__+": end-of-stream marker not found");
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSparse::SparseTrace(CSparseMatrix &m)
{
//--- create a variable
CSerializer s;
//--- serialization start
s.Alloc_Start();
//--- function call
SparseAlloc(s,m);
s.Alloc_Entry();
//--- serialization
s.SStart_Str();
SparseSerialize(s,m);
s.Stop();
CAp::Trace(s.Get_String()+"\n");
CAp::Trace("------\n");
}
//+------------------------------------------------------------------+
//| This is hash function. |
//+------------------------------------------------------------------+
int CSparse::Hash(int i,int j,int tabsize)
{
CHighQualityRandState r;;
CHighQualityRand::HQRndSeed(i,j,r);
int result=CHighQualityRand::HQRndUniformI(r,tabsize);
return(result);
}
//+------------------------------------------------------------------+
//| This object stores state of the subspace iteration algorithm. |
//| You should use ALGLIB functions to work with this object. |
//+------------------------------------------------------------------+
struct CEigSubSpaceState
{
int m_N;
int m_K;
int m_NWork;
int m_MaxIts;
int m_RequestType;
int m_RequestSize;
int m_RepIterationsCount;
int m_EigenVectorsNeeded;
int m_MatrixType;
bool m_UseWarmStart;
bool m_FirstCall;
bool m_Running;
double m_Eps;
//---
CRowDouble m_Tau;
CRowDouble m_RW;
CRowDouble m_TW;
CRowDouble m_WCur;
CRowDouble m_WPrev;
CRowDouble m_WRank;
CMatrixDouble m_Q0;
CMatrixDouble m_QCur;
CMatrixDouble m_QNew;
CMatrixDouble m_ZNew;
CMatrixDouble m_R;
CMatrixDouble m_RZ;
CMatrixDouble m_TZ;
CMatrixDouble m_RQ;
CMatrixDouble m_Dummy;
CMatrixDouble m_X;
CMatrixDouble m_AX;
CApBuff m_Buf;
//---
CHighQualityRandState m_RS;
RCommState m_RState;
CEigSubSpaceState(void) { Init(); }
void Init(void);
void Copy(const CEigSubSpaceState &obj);
//--- overloading
void operator=(const CEigSubSpaceState &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CEigSubSpaceState::Init(void)
{
m_N=0;
m_K=0;
m_NWork=0;
m_MaxIts=0;
m_RequestType=0;
m_RequestSize=0;
m_RepIterationsCount=0;
m_EigenVectorsNeeded=0;
m_MatrixType=0;
m_UseWarmStart=0;
m_FirstCall=0;
m_Running=0;
m_Eps=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CEigSubSpaceState::Copy(const CEigSubSpaceState &obj)
{
m_N=obj.m_N;
m_K=obj.m_K;
m_NWork=obj.m_NWork;
m_MaxIts=obj.m_MaxIts;
m_Eps=obj.m_Eps;
m_EigenVectorsNeeded=obj.m_EigenVectorsNeeded;
m_MatrixType=obj.m_MatrixType;
m_UseWarmStart=obj.m_UseWarmStart;
m_FirstCall=obj.m_FirstCall;
m_RS=obj.m_RS;
m_Running=obj.m_Running;
m_Tau=obj.m_Tau;
m_Q0=obj.m_Q0;
m_QCur=obj.m_QCur;
m_QNew=obj.m_QNew;
m_ZNew=obj.m_ZNew;
m_R=obj.m_R;
m_RZ=obj.m_RZ;
m_TZ=obj.m_TZ;
m_RQ=obj.m_RQ;
m_Dummy=obj.m_Dummy;
m_RW=obj.m_RW;
m_TW=obj.m_TW;
m_WCur=obj.m_WCur;
m_WPrev=obj.m_WPrev;
m_WRank=obj.m_WRank;
m_Buf=obj.m_Buf;
m_X=obj.m_X;
m_AX=obj.m_AX;
m_RequestType=obj.m_RequestType;
m_RequestSize=obj.m_RequestSize;
m_RepIterationsCount=obj.m_RepIterationsCount;
m_RState=obj.m_RState;
}
//+------------------------------------------------------------------+
//| This object stores state of the subspace iteration algorithm. |
//| You should use ALGLIB functions to work with this object. |
//+------------------------------------------------------------------+
struct CEigSubSpaceReport
{
int m_IterationsCount;
CEigSubSpaceReport() { Init(); }
void Init() { m_IterationsCount=0; }
void Copy(const CEigSubSpaceReport &obj);
//--- overloading
void operator=(const CEigSubSpaceReport &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CEigSubSpaceReport::Copy(const CEigSubSpaceReport &obj)
{
m_IterationsCount=obj.m_IterationsCount;
}
//+------------------------------------------------------------------+
//| Eigenvalues and eigenvectors |
//+------------------------------------------------------------------+
class CEigenVDetect
{
public:
static const int m_StepsWithinTol;
//--- SubSpace methods
static void EigSubSpaceCreate(int n,int k,CEigSubSpaceState &state);
static void EigSubSpaceCreateBuf(int n,int k,CEigSubSpaceState &state);
static void EigSubSpaceSetCond(CEigSubSpaceState &state,double eps,int maxits);
static void EigSubSpaceSetWarmStart(CEigSubSpaceState &state,bool usewarmstart);
static void EigSubSpaceOOCStart(CEigSubSpaceState &state,int mtype);
static bool EigSubSpaceOOCContinue(CEigSubSpaceState &state);
static void EigSubSpaceOOCGetRequestInfo(CEigSubSpaceState &state,int &requesttype,int &requestsize);
static void EigSubSpaceOOCGetRequestData(CEigSubSpaceState &state,CMatrixDouble &x);
static void EigSubSpaceOOCSendResult(CEigSubSpaceState &state,CMatrixDouble &ax);
static void EigSubSpaceOOCStop(CEigSubSpaceState &state,CRowDouble &w,CMatrixDouble &z,CEigSubSpaceReport &rep);
static void EigSubSpaceSolveDenses(CEigSubSpaceState &state,CMatrixDouble &a,bool IsUpper,CRowDouble &w,CMatrixDouble &z,CEigSubSpaceReport &rep);
static void EigSubSpaceSolveSparses(CEigSubSpaceState &state,CSparseMatrix &a,bool IsUpper,CRowDouble &w,CMatrixDouble &z,CEigSubSpaceReport &rep);
static bool EigSubspaceIteration(CEigSubSpaceState &state);
//--- public methods
static bool SMatrixEVD(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,double &d[],CMatrixDouble &z);
static bool SMatrixEVD(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,CRowDouble &d,CMatrixDouble &z);
static bool SMatrixEVDR(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,const double b1,const double b2,int &m,double &w[],CMatrixDouble &z);
static bool SMatrixEVDR(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,const double b1,const double b2,int &m,CRowDouble &w,CMatrixDouble &z);
static bool SMatrixEVDI(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,const int i1,const int i2,double &w[],CMatrixDouble &z);
static bool SMatrixEVDI(CMatrixDouble &ca,const int n,const int zneeded,const bool IsUpper,const int i1,const int i2,CRowDouble &w,CMatrixDouble &z);
static bool HMatrixEVD(CMatrixComplex &ca,const int n,int zneeded,const bool IsUpper,double &d[],CMatrixComplex &z);
static bool HMatrixEVD(CMatrixComplex &ca,const int n,int zneeded,const bool IsUpper,CRowDouble &d,CMatrixComplex &z);
static bool HMatrixEVDR(CMatrixComplex &ca,const int n,int zneeded,bool IsUpper,const double b1,const double b2,int &m,double &w[],CMatrixComplex &z);
static bool HMatrixEVDR(CMatrixComplex &ca,const int n,int zneeded,bool IsUpper,const double b1,const double b2,int &m,CRowDouble &w,CMatrixComplex &z);
static bool HMatrixEVDI(CMatrixComplex &ca,const int n,int zneeded,const bool IsUpper,const int i1,const int i2,double &w[],CMatrixComplex &z);
static bool HMatrixEVDI(CMatrixComplex &ca,const int n,int zneeded,const bool IsUpper,const int i1,const int i2,CRowDouble &w,CMatrixComplex &z);
static bool SMatrixTdEVD(double &d[],double &ce[],const int n,const int zneeded,CMatrixDouble &z);
static bool SMatrixTdEVD(CRowDouble &d,CRowDouble &ce,const int n,const int zneeded,CMatrixDouble &z);
static bool SMatrixTdEVDR(double &d[],double &e[],const int n,const int zneeded,const double a,const double b,int &m,CMatrixDouble &z);
static bool SMatrixTdEVDR(CRowDouble &d,CRowDouble &e,const int n,const int zneeded,const double a,const double b,int &m,CMatrixDouble &z);
static bool SMatrixTdEVDI(double &d[],double &e[],const int n,const int zneeded,const int i1,const int i2,CMatrixDouble &z);
static bool SMatrixTdEVDI(CRowDouble &d,CRowDouble &e,const int n,const int zneeded,const int i1,const int i2,CMatrixDouble &z);
static bool RMatrixEVD(CMatrixDouble &ca,const int n,const int vneeded,double &wr[],double &wi[],CMatrixDouble &vl,CMatrixDouble &vr);
static bool RMatrixEVD(CMatrixDouble &ca,const int n,const int vneeded,CRowDouble &wr,CRowDouble &wi,CMatrixDouble &vl,CMatrixDouble &vr);
private:
static void ClearRFields(CEigSubSpaceState &state);
static bool TriDiagonalEVD(CRowDouble &d,CRowDouble &ce,const int n,const int zneeded,CMatrixDouble &z);
static void TdEVDE2(const double a,const double b,const double c,double &rt1,double &rt2);
static void TdEVDEv2(const double a,const double b,const double c,double &rt1,double &rt2,double &cs1,double &sn1);
static double TdEVDPythag(const double a,const double b);
static double TdEVDExtSign(const double a,const double b);
static bool InternalBisectionEigenValues(CRowDouble &cd,CRowDouble &ce,const int n,int irange,const int iorder,const double vl,const double vu,const int il,const int iu,const double abstol,CRowDouble &w,int &m,int &nsplit,CRowInt &iblock,CRowInt &isplit,int &errorcode);
static void InternalDStein(const int n,CRowDouble &d,CRowDouble &ce,const int m,CRowDouble &cw,CRowInt &iblock,CRowInt &isplit,CMatrixDouble &z,CRowInt &ifail,int &info);
static void TdIninternalDLAGTF(const int n,CRowDouble &a,const double lambdav,CRowDouble &b,CRowDouble &c,double tol,CRowDouble &d,CRowInt &iin,int &info);
static void TdIninternalDLAGTS(const int n,CRowDouble &a,CRowDouble &b,CRowDouble &c,CRowDouble &d,CRowInt &iin,CRowDouble &y,double &tol,int &info);
static void InternalDLAEBZ(const int ijob,const int nitmax,const int n,const int mmax,const int minp,const double abstol,const double reltol,const double pivmin,CRowDouble &d,CRowDouble &e,CRowDouble &e2,CRowInt &nval,CMatrixDouble &ab,CRowDouble &c,int &mout,CMatrixInt &nab,CRowDouble &work,CRowInt &iwork,int &info);
static void RMatrixInternalTREVC(CMatrixDouble &t,int n,int side,int howmny,bool &vselect[],CMatrixDouble &vl,CMatrixDouble &vr,int &m,int &info);
static void InternalTREVC(CMatrixDouble &t,const int n,const int side,const int howmny,bool &cvselect[],CMatrixDouble &vl,CMatrixDouble &vr,int &m,int &info);
static void InternalHsEVDLALN2(const bool ltrans,const int na,const int nw,const double smin,const double ca,CMatrixDouble &a,const double d1,const double d2,CMatrixDouble &b,const double wr,const double wi,bool &rswap4[],bool &zswap4[],CMatrixInt &ipivot44,CRowDouble &civ4,CRowDouble &crv4,CMatrixDouble &x,double &scl,double &xnorm,int &info);
static void InternalHsEVDLADIV(const double a,const double b,const double c,const double d,double &p,double &q);
static bool NonSymmetricEVD(CMatrixDouble &ca,const int n,const int vneeded,CRowDouble &wr,CRowDouble &wi,CMatrixDouble &vl,CMatrixDouble &vr);
static void ToUpperHessenberg(CMatrixDouble &a,const int n,CRowDouble &tau);
static void UnpackQFromUpperHessenberg(CMatrixDouble &a,const int n,CRowDouble &tau,CMatrixDouble &q);
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
const int CEigenVDetect::m_StepsWithinTol=2;
//+------------------------------------------------------------------+
//| This function initializes subspace iteration solver. This solver |
//| is used to solve symmetric real eigenproblems where just a few |
//| (top K) eigenvalues and corresponding eigenvectors is required. |
//| This solver can be significantly faster than complete EVD |
//| decomposition in the following case: |
//| * when only just a small fraction of top eigenpairs of dense |
//| matrix is required. When K approaches N, this solver is |
//| slower than complete dense EVD |
//| * when problem matrix is sparse(and/or is not known explicitly,|
//| i.e. only matrix-matrix product can be performed) |
//| USAGE (explicit dense/sparse matrix): |
//| 1. User initializes algorithm state with EigSubSpaceCreate() |
//| call |
//| 2. [optional] User tunes solver parameters by calling |
//| eigsubspacesetcond() or other functions |
//| 3. User calls EigSubSpaceSolveDense() or |
//| EigSubSpaceSolveSparse() methods, which take algorithm state|
//| and 2D array or alglib.sparsematrix object. |
//| USAGE (out-of-core mode): |
//| 1. User initializes algorithm state with EigSubSpaceCreate() |
//| call |
//| 2. [optional] User tunes solver parameters by calling |
//| EigSubSpaceSetCond() or other functions |
//| 3. User activates out-of-core mode of the solver and repeatedly|
//| calls communication functions in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| N - problem dimensionality, N>0 |
//| K - number of top eigenvector to calculate, 0<K<=N. |
//| OUTPUT PARAMETERS: |
//| State - structure which stores algorithm state |
//| NOTE: if you solve many similar EVD problems you may find it |
//| useful to reuse previous subspace as warm-start point for |
//| new EVD problem. It can be done with |
//| EigSubSpaceSetWarmStart() function. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceCreate(int n,int k,
CEigSubSpaceState &state)
{
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(k>0,__FUNCTION__+": K<=0"))
return;
//--- check
if(!CAp::Assert(k<=n,__FUNCTION__+": K>N"))
return;
EigSubSpaceCreateBuf(n,k,state);
}
//+------------------------------------------------------------------+
//| Buffered version of constructor which aims to reuse previously |
//| allocated memory as much as possible. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceCreateBuf(int n,int k,
CEigSubSpaceState &state)
{
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
//--- check
if(!CAp::Assert(k>0,__FUNCTION__+": K<=0"))
return;
//--- check
if(!CAp::Assert(k<=n,__FUNCTION__+": K>N"))
return;
//--- Initialize algorithm parameters
state.m_Running=false;
state.m_N=n;
state.m_K=k;
state.m_NWork=MathMin(MathMax(2*k,8),n);
state.m_EigenVectorsNeeded=1;
state.m_UseWarmStart=false;
state.m_FirstCall=true;
EigSubSpaceSetCond(state,0.0,0);
//--- Allocate temporaries
CApServ::RMatrixSetLengthAtLeast(state.m_X,state.m_N,state.m_NWork);
CApServ::RMatrixSetLengthAtLeast(state.m_AX,state.m_N,state.m_NWork);
}
//+------------------------------------------------------------------+
//| This function sets stopping critera for the solver: |
//| * error in eigenvector/value allowed by solver |
//| * maximum number of iterations to perform |
//| INPUT PARAMETERS: |
//| State - solver structure |
//| Eps - eps>=0, with non-zero value used to tell solver |
//| that it can stop after all eigenvalues converged |
//| with error roughly proportional to |
//| eps*MAX(LAMBDA_MAX), where LAMBDA_MAX is a maximum |
//| eigenvalue. Zero value means that no check for |
//| precision is performed. |
//| MaxIts - maxits>=0, with non-zero value used to tell solver |
//| that it can stop after maxits steps (no matter how |
//| precise current estimate is) |
//| NOTE: passing eps=0 and maxits=0 results in automatic selection |
//| of moderate eps as stopping criteria (1.0E-6 in current |
//| implementation, but it may change without notice). |
//| NOTE: very small values of eps are possible (say, 1.0E-12), |
//| although the larger problem you solve (N and/or K), the |
//| harder it is to find precise eigenvectors because rounding |
//| errors tend to accumulate. |
//| NOTE: passing non-zero eps results in some performance penalty, |
//| roughly equal to 2N*(2K)^2 FLOPs per iteration. These |
//| additional computations are required in order to estimate |
//| current error in eigenvalues via Rayleigh-Ritz process. |
//| Most of this additional time is spent in construction of |
//| ~2Kx2K symmetric subproblem whose eigenvalues are checked |
//| with exact eigensolver. |
//| This additional time is negligible if you search for |
//| eigenvalues of the large dense matrix, but may become |
//| noticeable on highly sparse EVD problems, where cost of |
//| matrix-matrix product is low. |
//| If you set eps to exactly zero, Rayleigh-Ritz phase is |
//| completely turned off. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceSetCond(CEigSubSpaceState &state,
double eps,int maxits)
{
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is already running"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(eps) && (double)(eps)>=0.0,__FUNCTION__+": Eps<0 or NAN/INF"))
return;
//--- check
if(!CAp::Assert(maxits>=0,__FUNCTION__+": MaxIts<0"))
return;
if((double)(eps)==0.0 && maxits==0)
eps=1.0E-6;
state.m_Eps=eps;
state.m_MaxIts=maxits;
}
//+------------------------------------------------------------------+
//| This function sets warm-start mode of the solver: next call to |
//| the solver will reuse previous subspace as warm-start point. It |
//| can significantly speed-up convergence when you solve many |
//| similar eigenproblems. |
//| INPUT PARAMETERS: |
//| State - solver structure |
//| UseWarmStart - either True or False |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceSetWarmStart(CEigSubSpaceState &state,
bool usewarmstart)
{
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is already running"))
return;
state.m_UseWarmStart=usewarmstart;
}
//+------------------------------------------------------------------+
//| This function initiates out-of-core mode of subspace eigensolver.|
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| State - solver object |
//| MType - matrix type: |
//| * 0 for real symmetric matrix (solver assumes that matrix|
//| being processed is symmetric; symmetric direct |
//| eigensolver is used for smaller subproblems arising |
//| during solution of larger "full" task) |
//| Future versions of ALGLIB may introduce support for other|
//| matrix types; for now, only symmetric eigenproblems are |
//| supported. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceOOCStart(CEigSubSpaceState &state,
int mtype)
{
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is already running"))
return;
//--- check
if(!CAp::Assert(mtype==0,__FUNCTION__+": incorrect mtype parameter"))
return;
state.m_RState.ia.Resize(7+1);
state.m_RState.ra=vector<double>::Zeros(1+1);
state.m_RState.stage=-1;
ClearRFields(state);
state.m_Running=true;
state.m_MatrixType=mtype;
}
//+------------------------------------------------------------------+
//| This function performs subspace iteration in the out-of-core mode|
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestdData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//+------------------------------------------------------------------+
bool CEigenVDetect::EigSubSpaceOOCContinue(CEigSubSpaceState &state)
{
//--- check
if(!CAp::Assert(state.m_Running,__FUNCTION__+": solver is not running"))
return(false);
bool result=EigSubspaceIteration(state);
state.m_Running=result;
return(result);
}
//+------------------------------------------------------------------+
//| This function is used to retrieve information about out-of-core |
//| request sent by solver to user code: request type (current |
//| version of the solver sends only requests for matrix-matrix |
//| products) and request size (size of the matrices being |
//| multiplied). |
//| This function returns just request metrics; in order to get |
//| contents of the matrices being multiplied, use |
//| EigSubSpaceOOCGetRequestData(). |
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| State - solver running in out-of-core mode |
//| OUTPUT PARAMETERS: |
//| RequestType - type of the request to process: |
//| * 0 - for matrix-matrix product A*X, with A being |
//| NxN matrix whose eigenvalues/vectors are needed,|
//| and X being NxREQUESTSIZE one which is returned|
//| by the eigsubspaceoocgetrequestdata(). |
//| RequestSize - size of the X matrix (number of columns), |
//| usually it is several times larger than number |
//| of vectors K requested by user. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceOOCGetRequestInfo(CEigSubSpaceState &state,
int &requesttype,
int &requestsize)
{
//--- init variables
requesttype=0;
requestsize=0;
//--- check
if(!CAp::Assert(state.m_Running,__FUNCTION__+": solver is not running"))
return;
requesttype=state.m_RequestType;
requestsize=state.m_RequestSize;
}
//+------------------------------------------------------------------+
//| This function is used to retrieve information about out-of-core |
//| request sent by solver to user code: |
//| matrix X(array[N,RequestSize]) |
//| which have to be multiplied by out-of-core matrix A in a product |
//| A*X. |
//| This function returns just request data; in order to get size of |
//| the data prior to processing requestm, use |
//| EigSubSpaceOOCGetRequestInfo(). |
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| State - solver running in out-of-core mode |
//| X - possibly preallocated storage; reallocated if |
//| needed, left unchanged, if large enough to store|
//| request data. |
//| OUTPUT PARAMETERS: |
//| X - array[N,RequestSize] or larger, leading |
//| rectangle is filled with dense matrix X. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceOOCGetRequestData(CEigSubSpaceState &state,
CMatrixDouble &x)
{
//--- check
if(!CAp::Assert(state.m_Running,__FUNCTION__+": solver is not running"))
return;
x=state.m_X;
}
//+------------------------------------------------------------------+
//| This function is used to send user reply to out-of-core request |
//| sent by solver. Usually it is product A*X for returned by solver |
//| matrix X. |
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| State - solver running in out-of-core mode |
//| AX - array[N,RequestSize] or larger, leading rectangle |
//| is filled with product A*X. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceOOCSendResult(CEigSubSpaceState &state,
CMatrixDouble &ax)
{
//--- check
if(!CAp::Assert(state.m_Running,__FUNCTION__+": solver is not running"))
return;
state.m_AX=ax;
}
//+------------------------------------------------------------------+
//| This function finalizes out-of-core mode of subspace eigensolver.|
//| It should be used in conjunction with other out-of-core-related |
//| functions of this subspackage in a loop like below: |
//| > EigSubSpaceOOCStart(state) |
//| > while EigSubSpaceOOCContinue(state) do |
//| > EigSubSpaceOOCGetRequestInfo(state, RequestType, M) |
//| > EigSubSpaceOOCGetRequestData(state, X) |
//| > [calculate Y=A*X, with X=R^NxM] |
//| > EigSubSpaceOOCSendResult(state, Y) |
//| > EigSubSpaceOOCStop(state, W, Z, Report) |
//| INPUT PARAMETERS: |
//| State - solver state |
//| OUTPUT PARAMETERS: |
//| W - array[K], depending on solver settings: |
//| * top K eigenvalues ordered by descending - if |
//| EigenVectors are returned in Z |
//| * zeros - if invariant subspace is returned in Z |
//| Z - array[N,K], depending on solver settings either: |
//| * matrix of eigenvectors found |
//| * orthogonal basis of K-dimensional invariant subspace|
//| Rep - report with additional parameters |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceOOCStop(CEigSubSpaceState &state,
CRowDouble &w,
CMatrixDouble &z,
CEigSubSpaceReport &rep)
{
w=vector<double>::Zeros(0);
z=matrix<double>::Zeros(0,0);
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is still running"))
return;
w=state.m_RW;
z=state.m_RQ;
rep.m_IterationsCount=state.m_RepIterationsCount;
}
//+------------------------------------------------------------------+
//| This function runs subspace eigensolver for dense NxN symmetric |
//| matrix A, given by its upper or lower triangle. |
//| This function can not process nonsymmetric matrices. |
//| INPUT PARAMETERS: |
//| State - solver state |
//| A - array[N,N], symmetric NxN matrix given by one of |
//| its triangles |
//| IsUpper - whether upper or lower triangle of A is given (the |
//| other one is not referenced at all). |
//| OUTPUT PARAMETERS: |
//| W - array[K], top K EigenValues ordered by descending |
//| of their absolute values |
//| Z - array[N,K], matrix of eigenvectors found |
//| Rep - report with additional parameters |
//| NOTE: internally this function allocates a copy of NxN dense A. |
//| You should take it into account when working with very large|
//| matrices occupying almost all RAM. |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceSolveDenses(CEigSubSpaceState &state,
CMatrixDouble &a,
bool IsUpper,
CRowDouble &w,
CMatrixDouble &z,
CEigSubSpaceReport &rep)
{
//--- create variables
int n=0;
int m=0;
int i=0;
int j=0;
double v=0;
CMatrixDouble acopy;
w=vector<double>::Zeros(0);
z=matrix<double>::Zeros(0,0);
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is still running"))
return;
n=state.m_N;
//--- Allocate copy of A, copy one triangle to another
acopy.Resize(n,n);
for(i=0; i<n; i++)
{
for(j=i; j<n; j++)
{
if(IsUpper)
v=a.Get(i,j);
else
v=a.Get(j,i);
acopy.Set(i,j,v);
acopy.Set(j,i,v);
}
}
//--- Start iterations
state.m_MatrixType=0;
state.m_RState.ia.Resize(7+1);
state.m_RState.ra=vector<double>::Zeros(1+1);
state.m_RState.stage=-1;
ClearRFields(state);
while(EigSubspaceIteration(state))
{
//--- Calculate A*X with RMatrixGEMM
//--- check
if(!CAp::Assert(state.m_RequestType==0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(state.m_RequestSize>0,__FUNCTION__+": integrity check failed"))
return;
//---
m=state.m_RequestSize;
CAblas::RMatrixGemm(n,m,n,1.0,acopy,0,0,0,state.m_X,0,0,0,0.0,state.m_AX,0,0);
}
w=state.m_RW;
z=state.m_RQ;
rep.m_IterationsCount=state.m_RepIterationsCount;
}
//+------------------------------------------------------------------+
//| This function runs EigenSolver for dense NxN symmetric matrix A, |
//| given by upper or lower triangle. |
//| This function can not process nonsymmetric matrices. |
//| INPUT PARAMETERS: |
//| State - solver state |
//| A - NxN symmetric matrix given by one of its triangles |
//| IsUpper - whether upper or lower triangle of A is given (the |
//| other one is not referenced at all). |
//| OUTPUT PARAMETERS: |
//| W - array[K], top K eigenvalues ordered by descending |
//| of their absolute values |
//| Z - array[N,K], matrix of eigenvectors found |
//| Rep - report with additional parameters |
//+------------------------------------------------------------------+
void CEigenVDetect::EigSubSpaceSolveSparses(CEigSubSpaceState &state,
CSparseMatrix &a,
bool IsUpper,
CRowDouble &w,
CMatrixDouble &z,
CEigSubSpaceReport &rep)
{
w=vector<double>::Zeros(0);
z=matrix<double>::Zeros(0,0);
//--- check
if(!CAp::Assert(!state.m_Running,__FUNCTION__+": solver is still running"))
return;
state.m_MatrixType=0;
state.m_RState.ia.Resize(7+1);
state.m_RState.ra.Resize(1+1);
state.m_RState.stage=-1;
ClearRFields(state);
while(EigSubspaceIteration(state))
{
//--- check
if(!CAp::Assert(state.m_RequestType==0,__FUNCTION__+": integrity check failed"))
return;
if(!CAp::Assert(state.m_RequestSize>0,__FUNCTION__+": integrity check failed"))
return;
CSparse::SparseSMM(a,IsUpper,state.m_X,state.m_RequestSize,state.m_AX);
}
w=state.m_RW;
z=state.m_RQ;
rep.m_IterationsCount=state.m_RepIterationsCount;
}
//+------------------------------------------------------------------+
//| Internal r-comm function. |
//+------------------------------------------------------------------+
bool CEigenVDetect::EigSubspaceIteration(CEigSubSpaceState &state)
{
//--- create variables
bool result;
int n=0;
int nwork=0;
int k=0;
int cnt=0;
int i=0;
int i1=0;
int j=0;
double vv=0;
double v=0;
int convcnt=0;
//--- Reverse communication preparations
//--- This code initializes locals by:
//--- * random values determined during code
//--- generation - on first subroutine call
//--- * values from previous call - on subsequent calls
if(state.m_RState.stage>=0)
{
n=state.m_RState.ia[0];
nwork=state.m_RState.ia[1];
k=state.m_RState.ia[2];
cnt=state.m_RState.ia[3];
i=state.m_RState.ia[4];
i1=state.m_RState.ia[5];
j=state.m_RState.ia[6];
convcnt=state.m_RState.ia[7];
vv=state.m_RState.ra[0];
v=state.m_RState.ra[1];
}
else
{
n=359;
nwork=-58;
k=-919;
cnt=-909;
i=81;
i1=255;
j=74;
convcnt=-788;
vv=809;
v=205;
}
if(state.m_RState.stage==0)
{
//--- Perform Rayleigh-Ritz step to estimate convergence of diagonal eigenvalues
if(state.m_Eps>(double)0.0)
{
//--- check
if(!CAp::Assert(state.m_MatrixType==0,__FUNCTION__+": integrity check failed"))
return(false);
CApServ::RMatrixSetLengthAtLeast(state.m_R,nwork,nwork);
CAblas::RMatrixGemm(nwork,nwork,n,1.0,state.m_QCur,0,0,0,state.m_AX,0,0,0,0.0,state.m_R,0,0);
if(!SMatrixEVD(state.m_R,nwork,0,true,state.m_WCur,state.m_Dummy))
{
CAp::Assert(false,__FUNCTION__+": direct eigensolver failed to converge");
return(false);
}
state.m_WRank=state.m_WCur.Abs()+0;
CBasicStatOps::RankXUntied(state.m_WRank,nwork,state.m_Buf);
v=0;
vv=0;
for(j=0; j<nwork; j++)
{
if(state.m_WRank[j]>=(double)(nwork-k))
{
v=MathMax(v,MathAbs(state.m_WCur[j]-state.m_WPrev[j]));
vv=MathMax(vv,MathAbs(state.m_WCur[j]));
}
}
if(vv==0.0)
vv=1;
if(v<=(state.m_Eps*vv))
convcnt++;
else
convcnt=0;
state.m_WPrev=state.m_WCur;
}
//--- QR renormalization and update of QNew
CAblas::RMatrixTranspose(n,nwork,state.m_AX,0,0,state.m_ZNew,0,0);
COrtFac::RMatrixLQ(state.m_ZNew,nwork,n,state.m_Tau);
COrtFac::RMatrixLQUnpackQ(state.m_ZNew,nwork,n,state.m_Tau,nwork,state.m_QNew);
//--- Update iteration index
state.m_RepIterationsCount++;
}
else
{
//--- Routine body
n=state.m_N;
k=state.m_K;
nwork=state.m_NWork;
//--- Initialize RNG. Deterministic initialization (with fixed
//--- seed) is required because we need deterministic behavior
//--- of the entire solver.
CHighQualityRand::HQRndSeed(453,463664,state.m_RS);
//--- Prepare iteration
//--- Initialize QNew with random orthogonal matrix (or reuse its previous value).
state.m_RepIterationsCount=0;
CApServ::RMatrixSetLengthAtLeast(state.m_QCur,nwork,n);
CApServ::RMatrixSetLengthAtLeast(state.m_QNew,nwork,n);
CApServ::RMatrixSetLengthAtLeast(state.m_ZNew,nwork,n);
CApServ::RVectorSetLengthAtLeast(state.m_WCur,nwork);
CApServ::RVectorSetLengthAtLeast(state.m_WPrev,nwork);
CApServ::RVectorSetLengthAtLeast(state.m_WRank,nwork);
CApServ::RMatrixSetLengthAtLeast(state.m_X,n,nwork);
CApServ::RMatrixSetLengthAtLeast(state.m_AX,n,nwork);
CApServ::RMatrixSetLengthAtLeast(state.m_RQ,n,k);
CApServ::RVectorSetLengthAtLeast(state.m_RW,k);
CApServ::RMatrixSetLengthAtLeast(state.m_RZ,nwork,k);
CApServ::RMatrixSetLengthAtLeast(state.m_R,nwork,nwork);
state.m_WPrev.Fill(-1);
if(!state.m_UseWarmStart || state.m_FirstCall)
{
//--- Use Q0 (either no warm start request, or warm start was
//--- requested by user - but it is first call).
if(state.m_FirstCall)
{
//--- First call, generate Q0
for(i=0; i<nwork; i++)
{
for(j=0; j<n; j++)
state.m_ZNew.Set(i,j,CHighQualityRand::HQRndUniformR(state.m_RS)-0.5);
}
COrtFac::RMatrixLQ(state.m_ZNew,nwork,n,state.m_Tau);
COrtFac::RMatrixLQUnpackQ(state.m_ZNew,nwork,n,state.m_Tau,nwork,state.m_Q0);
state.m_FirstCall=false;
}
state.m_QNew=state.m_Q0;
}
//--- Start iteration
state.m_RepIterationsCount=0;
convcnt=0;
}
if(!((state.m_MaxIts==0 || state.m_RepIterationsCount<state.m_MaxIts) && convcnt<m_StepsWithinTol))
{
//--- Perform Rayleigh-Ritz step: find true eigenpairs in NWork-dimensional
//--- subspace.
//--- check
if(!CAp::Assert(state.m_MatrixType==0,__FUNCTION__+": integrity check failed"))
return(false);
if(!CAp::Assert(state.m_EigenVectorsNeeded==1))
return(false);
CAblas::RMatrixGemm(nwork,nwork,n,1.0,state.m_QCur,0,0,0,state.m_AX,0,0,0,0.0,state.m_R,0,0);
if(!SMatrixEVD(state.m_R,nwork,1,true,state.m_TW,state.m_TZ))
{
CAp::Assert(false,__FUNCTION__+": direct eigensolver failed to converge");
return(false);
}
//--- Reorder eigenpairs according to their absolute magnitude, select
//--- K top ones. This reordering algorithm is very inefficient and has
//--- O(NWork*K) running time, but it is still faster than other parts
//--- of the solver, so we may use it.
//---
//--- Then, we transform RZ to RQ (full N-dimensional representation).
//--- After this part is done, RW and RQ contain solution.
state.m_WRank=state.m_TW.Abs()+0;
CBasicStatOps::RankXUntied(state.m_WRank,nwork,state.m_Buf);
cnt=0;
for(i=nwork-1; i>=nwork-k; i--)
{
for(i1=0; i1<nwork; i1++)
{
if(state.m_WRank[i1]==(double)i)
{
//--- check
if(!CAp::Assert(cnt<k,__FUNCTION__+": integrity check failed"))
return(false);
state.m_RW.Set(cnt,state.m_TW[i1]);
state.m_RZ.Col(cnt,state.m_TZ.Col(i1)+0);
cnt=cnt+1;
}
}
}
//--- check
if(!CAp::Assert(cnt==k,__FUNCTION__+": integrity check failed"))
return(false);
CAblas::RMatrixGemm(n,k,nwork,1.0,state.m_QCur,0,0,1,state.m_RZ,0,0,0,0.0,state.m_RQ,0,0);
result=false;
return(result);
}
//--- Update QCur := QNew
//--- Calculate A*Q'
state.m_QCur=state.m_QNew;
CAblas::RMatrixTranspose(nwork,n,state.m_QCur,0,0,state.m_X,0,0);
ClearRFields(state);
state.m_RequestType=0;
state.m_RequestSize=nwork;
state.m_RState.stage=0;
//--- Saving state
result=true;
state.m_RState.ia.Set(0,n);
state.m_RState.ia.Set(1,nwork);
state.m_RState.ia.Set(2,k);
state.m_RState.ia.Set(3,cnt);
state.m_RState.ia.Set(4,i);
state.m_RState.ia.Set(5,i1);
state.m_RState.ia.Set(6,j);
state.m_RState.ia.Set(7,convcnt);
state.m_RState.ra.Set(0,vv);
state.m_RState.ra.Set(1,v);
return(result);
}
//+------------------------------------------------------------------+
//| Finding the eigenvalues and eigenvectors of a symmetric matrix |
//| The algorithm finds eigen pairs of a symmetric matrix by reducing|
//| it to tridiagonal form and using the QL/QR algorithm. |
//| Input parameters: |
//| A - symmetric matrix which is given by its upper or |
//| lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. |
//| If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| IsUpper - storage format. |
//| Output parameters: |
//| D - eigenvalues in ascending order. |
//| Array whose index ranges within [0..N-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains the eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| The eigenvectors are stored in the matrix |
//| columns. |
//| Result: |
//| True, if the algorithm has converged. |
//| False, if the algorithm hasn't converged (rare case). |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVD(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,double &d[],CMatrixDouble &z)
{
CRowDouble D;
ArrayFree(d);
if(!SMatrixEVD(ca,n,zneeded,IsUpper,D,z))
return(false);
return (D.ToArray(d));
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVD(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,CRowDouble &d,CMatrixDouble &z)
{
//--- create arrays
CRowDouble tau;
CRowDouble e;
//--- create copy
CMatrixDouble a=ca;
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- function call
COrtFac::SMatrixTD(a,n,IsUpper,tau,d,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::SMatrixTDUnpackQ(a,n,IsUpper,tau,z);
}
//--- return result
return(SMatrixTdEVD(d,e,n,zneeded,z));
}
//+------------------------------------------------------------------+
//| Subroutine for finding the eigenvalues (and eigenvectors) of a |
//| symmetric matrix in a given half open interval (A, B] by using a |
//| bisection and inverse iteration |
//| Input parameters: |
//| A - symmetric matrix which is given by its upper or |
//| lower triangular part. Array [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. |
//| If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| isUpperA - storage format of matrix A. |
//| B1, B2 - half open interval (B1, B2] to search |
//| eigenvalues in. |
//| Output parameters: |
//| M - number of eigenvalues found in a given |
//| half-interval (M>=0). |
//| W - array of the eigenvalues found. |
//| Array whose index ranges within [0..M-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..M-1]. |
//| The eigenvectors are stored in the matrix |
//| columns. |
//| Result: |
//| True, if successful. M contains the number of eigenvalues in |
//| the given half-interval (could be equal to 0), W contains the|
//| eigenvalues, Z contains the eigenvectors (if needed). |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| iteration subroutine wasn't able to find all the |
//| corresponding eigenvectors. In that case, the eigenvalues |
//| and eigenvectors are not returned, M is equal to 0. |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVDR(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,const double b1,const double b2,
int &m,double &w[],CMatrixDouble &z)
{
CRowDouble W;
ArrayFree(w);
if(!SMatrixEVDR(ca,n,zneeded,IsUpper,b1,b2,m,W,z))
return(false);
return(W.ToArray(w));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVDR(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,const double b1,const double b2,
int &m,CRowDouble &w,CMatrixDouble &z)
{
//--- create arrays
CRowDouble tau;
CRowDouble e;
//--- create copy
CMatrixDouble a=ca;
//--- initialization
m=0;
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- function call
COrtFac::SMatrixTD(a,n,IsUpper,tau,w,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::SMatrixTDUnpackQ(a,n,IsUpper,tau,z);
}
//--- return result
return(SMatrixTdEVDR(w,e,n,zneeded,b1,b2,m,z));
}
//+------------------------------------------------------------------+
//| Subroutine for finding the eigenvalues and eigenvectors of a |
//| symmetric matrix with given indexes by using bisection and |
//| inverse iteration methods. |
//| Input parameters: |
//| A - symmetric matrix which is given by its upper or |
//| lower triangular part. Array whose indexes range |
//| within [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. |
//| If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| isUpperA - storage format of matrix A. |
//| I1, I2 - index interval for searching (from I1 to I2). |
//| 0 <= I1 <= I2 <= N-1. |
//| Output parameters: |
//| W - array of the eigenvalues found. |
//| Array whose index ranges within [0..I2-I1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..I2-I1]. |
//| In that case, the eigenvectors are stored in the |
//| matrix columns. |
//| Result: |
//| True, if successful. W contains the eigenvalues, Z contains |
//| the eigenvectors (if needed). |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| iteration subroutine wasn't able to find all the |
//| corresponding eigenvectors. In that case, the eigenvalues |
//| and eigenvectors are not returned. |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVDI(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,const int i1,const int i2,
double &w[],CMatrixDouble &z)
{
CRowDouble W;
ArrayFree(w);
if(!SMatrixEVDI(ca,n,zneeded,IsUpper,i1,i2,W,z))
return(false);
return (W.ToArray(w));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixEVDI(CMatrixDouble &ca,const int n,const int zneeded,
const bool IsUpper,const int i1,const int i2,
CRowDouble &w,CMatrixDouble &z)
{
//--- create arrays
CRowDouble tau;
CRowDouble e;
//--- create copy
CMatrixDouble a=ca;
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- function call
COrtFac::SMatrixTD(a,n,IsUpper,tau,w,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::SMatrixTDUnpackQ(a,n,IsUpper,tau,z);
}
//--- return result
return(SMatrixTdEVDI(w,e,n,zneeded,i1,i2,z));
}
//+------------------------------------------------------------------+
//| Finding the eigenvalues and eigenvectors of a Hermitian matrix |
//| The algorithm finds eigen pairs of a Hermitian matrix by reducing|
//| it to real tridiagonal form and using the QL/QR algorithm. |
//| Input parameters: |
//| A - Hermitian matrix which is given by its upper or |
//| lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - storage format. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| Output parameters: |
//| D - eigenvalues in ascending order. |
//| Array whose index ranges within [0..N-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains the eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| The eigenvectors are stored in the matrix |
//| columns. |
//| Result: |
//| True, if the algorithm has converged. |
//| False, if the algorithm hasn't converged (rare case). |
//| Note: |
//| eigenvectors of Hermitian matrix are defined up to |
//| multiplication by a complex number L, such that |L|=1. |
//+------------------------------------------------------------------+
bool CEigenVDetect::HMatrixEVD(CMatrixComplex &ca,const int n,int zneeded,
const bool IsUpper,double &d[],CMatrixComplex &z)
{
CRowDouble D;
ArrayFree(d);
if(!HMatrixEVD(ca,n,zneeded,IsUpper,D,z))
return(false);
return (D.ToArray(d));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::HMatrixEVD(CMatrixComplex &ca,const int n,int zneeded,const bool IsUpper,CRowDouble &d,CMatrixComplex &z)
{
//--- create variables
int i=0;
int j=0;
bool result;
//--- create arrays
CRowComplex tau;
CRowDouble e;
//--- create matrix
CMatrixDouble t;
CMatrixDouble qz;
CMatrixComplex q;
//--- create copy
CMatrixComplex a=ca;
d=vector<double>::Zeros(0);
z=matrix<complex>::Zeros(0,0);
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- Reduce to tridiagonal form
COrtFac::HMatrixTD(a,n,IsUpper,tau,d,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::HMatrixTDUnpackQ(a,n,IsUpper,tau,q);
zneeded=2;
}
//--- get result
result=SMatrixTdEVD(d,e,n,zneeded,t);
//--- Eigenvectors are needed
//--- Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
if(result && zneeded!=0)
{
z.Resize(n,n);
qz.Resize(n,2*n);
//--- Calculate Re(Q)*T
for(i=0; i<n; i++)
{
for(j=0; j<n; j++)
qz.Set(i,j,q.Get(i,j).real);
}
CAblas::RMatrixGemm(n,n,n,1.0,qz,0,0,0,t,0,0,0,0.0,qz,0,n);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
z.SetRe(i,j,qz.Get(i,n+j));
//--- Calculate Im(Q)*T
for(i=0; i<n; i++)
for(j=0; j<n; j++)
qz.Set(i,j,q.Get(i,j).imag);
CAblas::RMatrixGemm(n,n,n,1.0,qz,0,0,0,t,0,0,0,0.0,qz,0,n);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
z.SetIm(i,j,qz.Get(i,n+j));
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Subroutine for finding the eigenvalues (and eigenvectors) of a |
//| Hermitian matrix in a given half-interval (A, B] by using a |
//| bisection and inverse iteration |
//| Input parameters: |
//| A - Hermitian matrix which is given by its upper or |
//| lower triangular part. Array whose indexes range |
//| within [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| isUpperA - storage format of matrix A. |
//| B1, B2 - half-interval (B1, B2] to search eigenvalues in. |
//| Output parameters: |
//| M - number of eigenvalues found in a given |
//| half-interval, M>=0 |
//| W - array of the eigenvalues found. |
//| Array whose index ranges within [0..M-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..M-1]. |
//| The eigenvectors are stored in the matrix |
//| columns. |
//| Result: |
//| True, if successful. M contains the number of eigenvalues |
//| in the given half-interval (could be equal to 0), W contains |
//| the eigenvalues, Z contains the eigenvectors (if needed). |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| iteration subroutine wasn't able to find all the |
//| corresponding eigenvectors. In that case, the eigenvalues and|
//| eigenvectors are not returned, M is equal to 0. |
//| Note: |
//| eigen vectors of Hermitian matrix are defined up to |
//| multiplication by a complex number L, such as |L|=1. |
//+------------------------------------------------------------------+
bool CEigenVDetect::HMatrixEVDR(CMatrixComplex &ca,const int n,int zneeded,
bool IsUpper,const double b1,const double b2,
int &m,double &w[],CMatrixComplex &z)
{
//--- create variables
int i=0;
int k=0;
double v=0;
int i_=0;
bool result;
//--- create arrays
complex tau[];
double e[];
double work[];
//--- create matrix
CMatrixComplex q;
CMatrixDouble t;
//--- create copy
CMatrixComplex a;
a=ca;
//--- initialization
m=0;
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- Reduce to tridiagonal form
COrtFac::HMatrixTD(a,n,IsUpper,tau,w,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::HMatrixTDUnpackQ(a,n,IsUpper,tau,q);
zneeded=2;
}
//--- Bisection and inverse iteration
result=SMatrixTdEVDR(w,e,n,zneeded,b1,b2,m,t);
//--- Eigenvectors are needed
//--- Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
if((result && zneeded!=0) && m!=0)
{
ArrayResize(work,m);
z.Resize(n,m);
for(i=0; i<n; i++)
{
//--- Calculate real part
for(k=0; k<=m-1; k++)
work[k]=0;
for(k=0; k<n; k++)
{
v=q.Get(i,k).real;
for(i_=0; i_<m; i_++)
work[i_]=work[i_]+v*t.Get(k,i_);
}
//--- get real part
for(k=0; k<=m-1; k++)
z.SetRe(i,k,work[k]);
//--- Calculate imaginary part
for(k=0; k<=m-1; k++)
work[k]=0;
for(k=0; k<n; k++)
{
v=q.Get(i,k).imag;
for(i_=0; i_<m; i_++)
work[i_]=work[i_]+v*t.Get(k,i_);
}
//--- get imaginary part
for(k=0; k<=m-1; k++)
z.SetIm(i,k,work[k]);
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Subroutine for finding the eigenvalues and eigenvectors of a |
//| Hermitian matrix with given indexes by using bisection and |
//| inverse iteration methods |
//| Input parameters: |
//| A - Hermitian matrix which is given by its upper or |
//| lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. If ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| isUpperA - storage format of matrix A. |
//| I1, I2 - index interval for searching (from I1 to I2). |
//| 0 <= I1 <= I2 <= N-1. |
//| Output parameters: |
//| W - array of the eigenvalues found. |
//| Array whose index ranges within [0..I2-I1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..I2-I1]. |
//| In that case, the eigenvectors are stored in |
//| the matrix columns. |
//| Result: |
//| True, if successful. W contains the eigenvalues, Z contains |
//| the eigenvectors (if needed). |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| corresponding eigenvectors. iteration subroutine wasn't able |
//| to find all the corresponding eigenvectors. In that case, |
//| the eigenvalues and eigenvectors are not returned. |
//| Note: |
//| eigen vectors of Hermitian matrix are defined up to |
//| multiplication by a complex number L, such as |L|=1. |
//+------------------------------------------------------------------+
bool CEigenVDetect::HMatrixEVDI(CMatrixComplex &ca,const int n,int zneeded,
const bool IsUpper,const int i1,const int i2,
double &w[],CMatrixComplex &z)
{
//--- create variables
int i=0;
int k=0;
double v=0;
int m=0;
int i_=0;
bool result;
//--- create arrays
complex tau[];
double e[];
double work[];
//--- create matrix
CMatrixComplex q;
CMatrixDouble t;
//--- create copy
CMatrixComplex a;
a=ca;
//--- check
if(!CAp::Assert(zneeded==0 || zneeded==1,__FUNCTION__+": incorrect ZNeeded"))
return(false);
//--- Reduce to tridiagonal form
COrtFac::HMatrixTD(a,n,IsUpper,tau,w,e);
//--- check
if(zneeded==1)
{
//--- function call
COrtFac::HMatrixTDUnpackQ(a,n,IsUpper,tau,q);
zneeded=2;
}
//--- Bisection and inverse iteration
result=SMatrixTdEVDI(w,e,n,zneeded,i1,i2,t);
//--- Eigenvectors are needed
//--- Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
m=i2-i1+1;
//--- check
if(result && zneeded!=0)
{
ArrayResize(work,m);
z.Resize(n,m);
for(i=0; i<n; i++)
{
//--- Calculate real part
for(k=0; k<=m-1; k++)
work[k]=0;
for(k=0; k<n; k++)
{
v=q.Get(i,k).real;
for(i_=0; i_<m; i_++)
work[i_]=work[i_]+v*t.Get(k,i_);
}
//--- get real part
for(k=0; k<=m-1; k++)
z.SetRe(i,k,work[k]);
//--- Calculate imaginary part
for(k=0; k<=m-1; k++)
work[k]=0;
for(k=0; k<n; k++)
{
v=q.Get(i,k).imag;
for(i_=0; i_<m; i_++)
work[i_]=work[i_]+v*t.Get(k,i_);
}
//--- get imaginary part
for(k=0; k<=m-1; k++)
z.SetIm(i,k,work[k]);
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Finding the eigenvalues and eigenvectors of a tridiagonal |
//| symmetric matrix |
//| The algorithm finds the eigen pairs of a tridiagonal symmetric |
//| matrix by using an QL/QR algorithm with implicit shifts. |
//| Input parameters: |
//| D - the main diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-1]. |
//| E - the secondary diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-2]. |
//| N - size of matrix A. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. |
//| If ZNeeded is equal to: |
//| * 0, the eigenvectors are not needed; |
//| * 1, the eigenvectors of a tridiagonal matrix |
//| are multiplied by the square matrix Z. It is |
//| used if the tridiagonal matrix is obtained by |
//| the similarity transformation of a symmetric |
//| matrix; |
//| * 2, the eigenvectors of a tridiagonal matrix |
//| replace the square matrix Z; |
//| * 3, matrix Z contains the first row of the |
//| eigenvectors matrix. |
//| Z - if ZNeeded=1, Z contains the square matrix by |
//| which the eigenvectors are multiplied. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| Output parameters: |
//| D - eigenvalues in ascending order. |
//| Array whose index ranges within [0..N-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains the product of a given matrix |
//| (from the left) and the eigenvectors matrix |
//| (from the right); |
//| * 2, Z contains the eigenvectors. |
//| * 3, Z contains the first row of the |
//| eigenvectors matrix. |
//| If ZNeeded<3, Z is the array whose indexes range |
//| within [0..N-1, 0..N-1]. |
//| In that case, the eigenvectors are stored in the |
//| matrix columns. |
//| If ZNeeded=3, Z is the array whose indexes range |
//| within [0..0, 0..N-1]. |
//| Result: |
//| True, if the algorithm has converged. |
//| False, if the algorithm hasn't converged. |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| September 30, 1994 |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVD(double &d[],double &ce[],const int n,const int zneeded,CMatrixDouble &z)
{
CRowDouble D=d;
CRowDouble CE=ce;
if(!SMatrixTdEVD(D,CE,n,zneeded,z))
return(false);
return(D.ToArray(d));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVD(CRowDouble &d,CRowDouble &ce,const int n,int zneeded,CMatrixDouble &z)
{
//--- create variables
int i =0;
int i_ =0;
int i1_=0;
int j =0;
bool result;
//--- create arrays
CRowDouble d1;
CRowDouble e1;
//--- create matrix
CMatrixDouble z1;
//--- create copy
CRowDouble e=ce;
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<=0"))
return(false);
if(!CAp::Assert(zneeded>=0 && zneeded<=3,__FUNCTION__+": incorrect ZNeeded"))
return(false);
result=false;
//--- Preprocess Z: make ZNeeded equal to 0, 1 or 3.
//--- Ensure that memory for Z is allocated.
if(zneeded==2)
{
//--- Load identity to Z
CApServ::RMatrixSetLengthAtLeast(z,n,n);
z=matrix<double>::Identity(n,n);
zneeded=1;
}
if(zneeded==3)
{
//--- Allocate memory
CApServ::RMatrixSetLengthAtLeast(z,1,n);
}
//--- Prepare 1-based task
d1=vector<double>::Zeros(n+1);
e1=vector<double>::Zeros(n+1);
i1_=-1;
for(i_=1; i_<=n; i_++)
d1.Set(i_,d[i_+i1_]);
if(n>1)
{
for(i_=1; i_<n; i_++)
e1.Set(i_,e[i_+i1_]);
}
if(zneeded==1)
{
z1.Resize(n+1,n+1);
for(i=1; i<=n; i++)
for(i_=1; i_<=n; i_++)
z1.Set(i,i_,z.Get(i-1,i_+i1_));
}
//--- Solve 1-based task
result=TriDiagonalEVD(d1,e1,n,zneeded,z1);
if(!result)
return(result);
//--- Convert back to 0-based result
i1_=1;
for(i_=0; i_<n; i_++)
d.Set(i_,d1[i_+i1_]);
switch(zneeded)
{
case 1:
for(i=1; i<=n; i++)
for(i_=0; i_<n; i_++)
z.Set(i-1,i_,z1.Get(i,i_+i1_));
break;
case 2:
z.Resize(n,n);
for(i=1; i<=n; i++)
for(i_=0; i_<n; i_++)
z.Set(i-1,i_,z1.Get(i,i_+i1_));
break;
case 3:
z.Resize(1,n);
for(i_=0; i_<n; i_++)
z.Set(0,i_,z1.Get(1,i_+i1_));
break;
default:
if(!CAp::Assert(zneeded==0,__FUNCTION__+": Incorrect ZNeeded!"))
return(false);
break;
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Subroutine for finding the tridiagonal matrix eigenvalues/vectors|
//| in a given half-interval (A, B] by using bisection and inverse |
//| iteration. |
//| Input parameters: |
//| D - the main diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-1]. |
//| E - the secondary diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-2]. |
//| N - size of matrix, N>=0. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. If ZNeeded is equal to: |
//| * 0, the eigenvectors are not needed; |
//| * 1, the eigenvectors of a tridiagonal matrix |
//| are multiplied by the square matrix Z. It is |
//| used if the tridiagonal matrix is obtained by |
//| the similarity transformation of a symmetric |
//| matrix. |
//| * 2, the eigenvectors of a tridiagonal matrix |
//| replace matrix Z. |
//| A, B - half-interval (A, B] to search eigenvalues in. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z isn't used and remains unchanged; |
//| * 1, Z contains the square matrix (array whose |
//| indexes range within [0..N-1, 0..N-1]) which |
//| reduces the given symmetric matrix to |
//| tridiagonal form; |
//| * 2, Z isn't used (but changed on the exit). |
//| Output parameters: |
//| D - array of the eigenvalues found. |
//| Array whose index ranges within [0..M-1]. |
//| M - number of eigenvalues found in the given |
//| half-interval (M>=0). |
//| Z - if ZNeeded is equal to: |
//| * 0, doesn't contain any information; |
//| * 1, contains the product of a given NxN matrix |
//| Z (from the left) and NxM matrix of the |
//| eigenvectors found (from the right). Array |
//| whose indexes range within [0..N-1, 0..M-1]. |
//| * 2, contains the matrix of the eigenvectors |
//| found. Array whose indexes range within |
//| [0..N-1, 0..M-1]. |
//| Result: |
//| True, if successful. In that case, M contains the number of |
//| eigenvalues in the given half-interval (could be equal to 0),|
//| D contains the eigenvalues, Z contains the eigenvectors (if |
//| needed). It should be noted that the subroutine changes the |
//| size of arrays D and Z. |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| iteration subroutine wasn't able to find all the |
//| corresponding eigenvectors. In that case, the eigenvalues and|
//| eigenvectors are not returned, M is equal to 0. |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVDR(double &d[],double &e[],const int n,
const int zneeded,const double a,
const double b,int &m,CMatrixDouble &z)
{
CRowDouble D=d;
CRowDouble E=e;
if(!SMatrixTdEVDR(D,E,n,zneeded,a,b,m,z))
return(false);
return(D.ToArray(d));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVDR(CRowDouble &d,CRowDouble &e,const int n,
const int zneeded,const double a,
const double b,int &m,CMatrixDouble &z)
{
//--- create variables
bool result;
int errorcode=0;
int nsplit=0;
int i=0;
int j=0;
int k=0;
int cr=0;
double v=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowInt iblock;
CRowInt isplit;
CRowInt ifail;
CRowDouble d1;
CRowDouble e1;
CRowDouble w;
//--- create matrix
CMatrixDouble z2;
CMatrixDouble z3;
//--- initialization
m=0;
//--- check
if(!CAp::Assert(zneeded>=0 && zneeded<=2,__FUNCTION__+": incorrect ZNeeded!"))
return(false);
//--- check
if(b<=a)
{
m=0;
//--- return result
return(true);
}
//--- check
if(n<=0)
{
m=0;
//--- return result
return(true);
}
//--- Copy D,E to D1, E1
d1.Resize(n+1);
i1_=-1;
for(i_=1; i_<=n; i_++)
d1.Set(i_,d[i_+i1_]);
//--- check
if(n>1)
{
e1.Resize(n);
i1_=-1;
for(i_=1; i_<n; i_++)
e1.Set(i_,e[i_+i1_]);
}
i1_=1;
switch(zneeded)
{
//--- No eigen vectors
case 0:
//--- get result
result=InternalBisectionEigenValues(d1,e1,n,2,1,a,b,0,0,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result || m==0)
{
m=0;
break;
}
d.Resize(m);
for(i_=0; i_<m; i_++)
d.Set(i_,w[i_+i1_]);
break;
//--- Eigen vectors are multiplied by Z
case 1:
//--- Find eigen pairs
result=InternalBisectionEigenValues(d1,e1,n,2,2,a,b,0,0,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result || m==0)
{
m=0;
break;
}
//--- function call
InternalDStein(n,d1,e1,m,w,iblock,isplit,z2,ifail,cr);
//--- check
if(cr!=0)
{
m=0;
//--- get result
result=false;
break;
}
//--- Sort eigen values and vectors
for(i=1; i<=m; i++)
{
k=i;
for(j=i; j<=m; j++)
{
//--- check
if(w[j]<w[k])
k=j;
}
//--- swap
w.Swap(i,k);
for(j=1; j<=n; j++)
{
//--- swap
v=z2.Get(j,i);
z2.Set(j,i,z2.Get(j,k));
z2.Set(j,k,v);
}
}
//--- Transform Z2 and overwrite Z
z3=z2.Transpose()+0;
for(i=1; i<=n; i++)
{
for(j=1; j<=m; j++)
{
v=0.0;
for(i_=1; i_<=n; i_++)
v+=z.Get(i-i1_,i_-i1_)*z3.Get(j,i_);
z2.Set(i,j,v);
}
}
//--- rewrite
z.Resize(n,m);
for(i=1; i<=m; i++)
for(i_=1; i_<=n; i_++)
z.Set(i_-i1_,i-i1_,z2.Get(i_,i));
//--- Store W
d.Resize(m);
for(i=1; i<=m; i++)
d.Set(i-i1_,w[i]);
break;
//--- Eigen vectors are stored in Z
case 2:
//--- Find eigen pairs
result=InternalBisectionEigenValues(d1,e1,n,2,2,a,b,0,0,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result || m==0)
{
m=0;
break;
}
//--- function call
InternalDStein(n,d1,e1,m,w,iblock,isplit,z2,ifail,cr);
//--- check
if(cr!=0)
{
m=0;
result=false;
break;
}
//--- Sort eigen values and vectors
for(i=1; i<=m; i++)
{
k=i;
for(j=i; j<=m; j++)
{
//--- check
if(w[j]<w[k])
k=j;
}
//--- swap
w.Swap(i,k);
for(j=1; j<=n; j++)
{
//--- swap
v=z2.Get(j,i);
z2.Set(j,i,z2.Get(j,k));
z2.Set(j,k,v);
}
}
//--- Store W
d.Resize(m);
for(i=1; i<=m; i++)
d.Set(i-i1_,w[i]);
z.Resize(n,m);
for(i=1; i<=m; i++)
{
for(i_=1; i_<=n; i_++)
z.Set(i_-i1_,i-i1_,z2.Get(i_,i));
}
break;
default:
result=false;
break;
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Subroutine for finding tridiagonal matrix eigenvalues/vectors |
//| with given indexes (in ascending order) by using the bisection |
//| and inverse iteraion. |
//| Input parameters: |
//| D - the main diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-1]. |
//| E - the secondary diagonal of a tridiagonal matrix. |
//| Array whose index ranges within [0..N-2]. |
//| N - size of matrix. N>=0. |
//| ZNeeded - flag controlling whether the eigenvectors are |
//| needed or not. If ZNeeded is equal to: |
//| * 0, the eigenvectors are not needed; |
//| * 1, the eigenvectors of a tridiagonal matrix |
//| are multiplied by the square matrix Z. It is |
//| used if the tridiagonal matrix is obtained by |
//| the similarity transformation of a symmetric |
//| matrix. |
//| * 2, the eigenvectors of a tridiagonal matrix |
//| replace matrix Z. |
//| I1, I2 - index interval for searching (from I1 to I2). |
//| 0 <= I1 <= I2 <= N-1. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z isn't used and remains unchanged; |
//| * 1, Z contains the square matrix (array whose |
//| indexes range within [0..N-1, 0..N-1]) which |
//| reduces the given symmetric matrix to |
//| tridiagonal form; |
//| * 2, Z isn't used (but changed on the exit). |
//| Output parameters: |
//| D - array of the eigenvalues found. |
//| Array whose index ranges within [0..I2-I1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, doesn't contain any information; |
//| * 1, contains the product of a given NxN matrix |
//| Z (from the left) and Nx(I2-I1) matrix of the |
//| eigenvectors found (from the right). Array |
//| whose indexes range within [0..N-1, 0..I2-I1].|
//| * 2, contains the matrix of the eigenvalues |
//| found. Array whose indexes range within |
//| [0..N-1, 0..I2-I1]. |
//| Result: |
//| True, if successful. In that case, D contains the |
//| eigenvalues, Z contains the eigenvectors (if needed). |
//| It should be noted that the subroutine changes the size of |
//| arrays D and Z. |
//| False, if the bisection method subroutine wasn't able to find|
//| the eigenvalues in the given interval or if the inverse |
//| iteration subroutine wasn't able to find all the |
//| corresponding eigenvectors. In that case, the eigenvalues and|
//| eigenvectors are not returned. |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVDI(double &d[],double &e[],const int n,
const int zneeded,const int i1,
const int i2,CMatrixDouble &z)
{
CRowDouble D=d;
CRowDouble E=e;
if(!SMatrixTdEVDI(D,E,n,zneeded,i1,i2,z))
return(false);
return(D.ToArray(d));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::SMatrixTdEVDI(CRowDouble &d,CRowDouble &e,const int n,
const int zneeded,const int i1,
const int i2,CMatrixDouble &z)
{
//--- create variables
bool result;
int errorcode=0;
int nsplit=0;
int i=0;
int j=0;
int k=0;
int m=0;
int cr=0;
double v=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowInt iblock;
CRowInt isplit;
CRowInt ifail;
CRowDouble w;
CRowDouble d1;
CRowDouble e1;
//--- create matrix
CMatrixDouble z2;
CMatrixDouble z3;
//--- check
if(!CAp::Assert((0<=i1 && i1<=i2) && i2<n,__FUNCTION__+": incorrect I1/I2!"))
return(false);
//--- Copy D,E to D1, E1
d1.Resize(n+1);
i1_=-1;
for(i_=1; i_<=n; i_++)
d1.Set(i_,d[i_+i1_]);
//--- check
if(n>1)
{
e1.Resize(n);
for(i_=1; i_<n; i_++)
e1.Set(i_,e[i_+i1_]);
}
switch(zneeded)
{
//--- No eigen vectors
case 0:
result=InternalBisectionEigenValues(d1,e1,n,3,1,0,0,i1+1,i2+1,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result)
break;
//--- check
if(m!=i2-i1+1)
{
result=false;
break;
}
d.Resize(m);
for(i=1; i<=m; i++)
d.Set(i+i1_,w[i]);
break;
//--- Eigen vectors are multiplied by Z
case 1:
//--- Find eigen pairs
result=InternalBisectionEigenValues(d1,e1,n,3,2,0,0,i1+1,i2+1,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result)
break;
//--- check
if(m!=i2-i1+1)
{
result=false;
break;
}
//--- function call
InternalDStein(n,d1,e1,m,w,iblock,isplit,z2,ifail,cr);
//--- check
if(cr!=0)
{
result=false;
break;
}
//--- Sort eigen values and vectors
for(i=1; i<=m; i++)
{
k=i;
for(j=i; j<=m; j++)
{
//--- check
if(w[j]<w[k])
k=j;
}
//--- swap
w.Swap(i,k);
for(j=1; j<=n; j++)
{
//--- swap
v=z2.Get(j,i);
z2.Set(j,i,z2.Get(j,k));
z2.Set(j,k,v);
}
}
//--- Transform Z2 and overwrite Z
z3=z2.Transpose()+0;
for(i=1; i<=n; i++)
{
for(j=1; j<=m; j++)
{
v=0.0;
for(i_=1; i_<=n; i_++)
v+=z.Get(i+i1_,i_+i1_)*z3.Get(j,i_);
z2.Set(i,j,v);
}
}
//--- rewrite z
z.Resize(n,m);
for(i=1; i<=m; i++)
{
for(i_=1; i_<=n; i_++)
z.Set(i_+i1_,i+i1_,z2.Get(i_,i));
}
//--- Store W
d.Resize(m);
for(i=1; i<=m; i++)
d.Set(i+i1_,w[i]);
break;
//--- Eigen vectors are stored in Z
case 2:
//--- Find eigen pairs
result=InternalBisectionEigenValues(d1,e1,n,3,2,0,0,i1+1,i2+1,-1,w,m,nsplit,iblock,isplit,errorcode);
//--- check
if(!result)
break;
//--- check
if(m!=i2-i1+1)
{
result=false;
break;
}
//--- function call
InternalDStein(n,d1,e1,m,w,iblock,isplit,z2,ifail,cr);
//--- check
if(cr!=0)
{
result=false;
break;
}
//--- Sort eigen values and vectors
for(i=1; i<=m; i++)
{
k=i;
for(j=i; j<=m; j++)
{
//--- check
if(w[j]<w[k])
k=j;
}
//--- swap
w.Swap(i,k);
for(j=1; j<=n; j++)
{
//--- swap
v=z2.Get(j,i);
z2.Set(j,i,z2.Get(j,k));
z2.Set(j,k,v);
}
}
//--- Store Z
z.Resize(n,m);
for(i=1; i<=m; i++)
{
for(i_=1; i_<=n; i_++)
z.Set(i_+i1_,i+i1_,z2.Get(i_,i));
}
//--- Store W
d.Resize(m);
for(i=1; i<=m; i++)
d.Set(i+i1_,w[i]);
break;
default:
result=false;
break;
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Finding eigenvalues and eigenvectors of a general matrix |
//| The algorithm finds eigenvalues and eigenvectors of a general |
//| matrix by using the QR algorithm with multiple shifts. The |
//| algorithm can find eigenvalues and both left and right |
//| eigenvectors. |
//| The right eigenvector is a vector x such that A*x = w*x, and the |
//| left eigenvector is a vector y such that y'*A = w*y' (here y' |
//| implies a complex conjugate transposition of vector y). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| VNeeded - flag controlling whether eigenvectors are needed |
//| or not. If VNeeded is equal to: |
//| * 0, eigenvectors are not returned; |
//| * 1, right eigenvectors are returned; |
//| * 2, left eigenvectors are returned; |
//| * 3, both left and right eigenvectors are |
//| returned. |
//| Output parameters: |
//| WR - real parts of eigenvalues. |
//| Array whose index ranges within [0..N-1]. |
//| WI - imaginary parts of eigenvalues. |
//| Array whose index ranges within [0..N-1]. |
//| VL, VR - arrays of left and right eigenvectors (if they |
//| are needed). If WI[i]=0, the respective |
//| eigenvalue is a real number, and it corresponds |
//| to the column number I of matrices VL/VR. If |
//| WI[i]>0, we have a pair of complex conjugate |
//| numbers with positive and negative imaginary |
//| parts: the first eigenvalue WR[i] + |
//| + sqrt(-1)*WI[i]; the second eigenvalue |
//| WR[i+1] + sqrt(-1)*WI[i+1]; |
//| WI[i]>0 |
//| WI[i+1] = -WI[i] < 0 |
//| In that case, the eigenvector corresponding to |
//| the first eigenvalue is located in i and i+1 |
//| columns of matrices VL/VR (the column number i |
//| contains the real part, and the column number |
//| i+1 contains the imaginary part), and the vector |
//| corresponding to the second eigenvalue is a |
//| complex conjugate to the first vector. |
//| Arrays whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| Result: |
//| True, if the algorithm has converged. |
//| False, if the algorithm has not converged. |
//| Note 1: |
//| Some users may ask the following question: what if WI[N-1]>0?|
//| WI[N] must contain an eigenvalue which is complex conjugate |
//| to the N-th eigenvalue, but the array has only size N? |
//| The answer is as follows: such a situation cannot occur |
//| because the algorithm finds a pairs of eigenvalues, |
//| therefore, if WI[i]>0, I is strictly less than N-1. |
//| Note 2: |
//| The algorithm performance depends on the value of the |
//| internal parameter NS of the InternalSchurDecomposition |
//| subroutine which defines the number of shifts in the QR |
//| algorithm (similarly to the block width in block-matrix |
//| algorithms of linear algebra). If you require maximum |
//| performance on your machine, it is recommended to adjust |
//| this parameter manually. |
//| See also the InternalTREVC subroutine. |
//| The algorithm is based on the LAPACK 3.0 library. |
//+------------------------------------------------------------------+
bool CEigenVDetect::RMatrixEVD(CMatrixDouble &ca,const int n,const int vneeded,
double &wr[],double &wi[],
CMatrixDouble &vl,CMatrixDouble &vr)
{
CRowDouble WR=wr;
CRowDouble WI=wi;
if(!RMatrixEVD(ca,n,vneeded,WR,WI,vl,vr))
return(false);
return (WR.ToArray(wr) && WI.ToArray(wi));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CEigenVDetect::RMatrixEVD(CMatrixDouble &ca,const int n,const int vneeded,
CRowDouble &wr,CRowDouble &wi,
CMatrixDouble &vl,CMatrixDouble &vr)
{
//--- create variables
int i=0;
int info=0;
int i_=0;
int m1=0;
bool result;
//--- create arrays
CRowDouble wr1;
CRowDouble wi1;
CRowDouble tau;
bool sel1[];
//--- create matrix
CMatrixDouble a1;
CMatrixDouble vl1;
CMatrixDouble vr1;
CMatrixDouble s1;
CMatrixDouble s;
CMatrixDouble dummy;
//--- create copy
CMatrixDouble a=ca;
wr.Resize(0);
wi.Resize(0);
vl.Resize(0,0);
vr.Resize(0,0);
//--- check
if(!CAp::Assert(vneeded>=0 && vneeded<=3,__FUNCTION__+": incorrect VNeeded!"))
return(false);
if(vneeded==0)
{
//--- Eigen values only
COrtFac::RMatrixHessenberg(a,n,tau);
CHsSchur::RMatrixInternalSchurDecomposition(a,n,0,0,wr,wi,dummy,info);
result=info==0;
return(result);
}
//--- Eigen values and vectors
COrtFac::RMatrixHessenberg(a,n,tau);
COrtFac::RMatrixHessenbergUnpackQ(a,n,tau,s);
CHsSchur::RMatrixInternalSchurDecomposition(a,n,1,1,wr,wi,s,info);
result=info==0;
if(!result)
return(result);
if(vneeded==1 || vneeded==3)
vr= s;
if(vneeded==2 || vneeded==3)
vl=s;
RMatrixInternalTREVC(a,n,vneeded,1,sel1,vl,vr,m1,info);
result=info==0;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Clears request fileds (to be sure that we don't forgot to clear |
//| something) |
//+------------------------------------------------------------------+
void CEigenVDetect::ClearRFields(CEigSubSpaceState &state)
{
state.m_RequestType=-1;
state.m_RequestSize=-1;
}
//+------------------------------------------------------------------+
//| Eigenvalues and eigenvectors in tridiagonal matrix |
//+------------------------------------------------------------------+
bool CEigenVDetect::TriDiagonalEVD(CRowDouble &d,CRowDouble &ce,const int n,
const int zneeded,CMatrixDouble &z)
{
//--- create variables
bool result=false;
int maxit=0;
int i=0;
int ii=0;
int iscale=0;
int j=0;
int jtot=0;
int k=0;
int t=0;
int l=0;
int l1=0;
int lend=0;
int lendm1=0;
int lendp1=0;
int lendsv=0;
int lm1=0;
int lsv=0;
int m=0;
int mm1=0;
int nm1=0;
int nmaxit=0;
int tmpint=0;
double anorm=0;
double b=0;
double c=0;
double eps=0;
double eps2=0;
double f=0;
double g=0;
double p=0;
double r=0;
double rt1=0;
double rt2=0;
double s=0;
double safmax=0;
double safmin=0;
double ssfmax=0;
double ssfmin=0;
double tst=0;
double tmp=0;
CRowDouble work1;
CRowDouble work2;
CRowDouble workc;
CRowDouble works;
CRowDouble wtemp;
bool gotoflag=false;
int zrows=0;
bool wastranspose=false;
int i_=0;
//--- copy
CRowDouble e=ce;
//--- check
if(!CAp::Assert(zneeded>=0 && zneeded<=3,"TridiagonalEVD: Incorrent ZNeeded"))
return(false);
//--- Quick return if possible
if(zneeded<0 || zneeded>3)
return(false);
result=true;
if(n==0)
return(result);
if(n==1)
{
if(zneeded==2 || zneeded==3)
{
z=matrix<double>::Zeros(2,2);
z.Set(1,1,1);
}
return(result);
}
maxit=30;
//--- Initialize arrays
wtemp=vector<double>::Zeros(n+1);
work1=vector<double>::Zeros(n);
work2=vector<double>::Zeros(n);
workc=vector<double>::Zeros(n+1);
works=vector<double>::Zeros(n+1);
//--- Determine the unit roundoff and over/underflow thresholds.
eps=CMath::m_machineepsilon;
eps2=CMath::Sqr(eps);
safmin=CMath::m_minrealnumber;
safmax=CMath::m_maxrealnumber;
ssfmax=MathSqrt(safmax)/3;
ssfmin=MathSqrt(safmin)/eps2;
//--- Prepare Z
//--- Here we are using transposition to get rid of column operations
wastranspose=false;
zrows=0;
switch(zneeded)
{
case 1:
zrows=n;
wastranspose=true;
CBlas::InplaceTranspose(z,1,n,1,n,wtemp);
break;
case 2:
zrows=n;
wastranspose=true;
z=matrix<double>::Identity(n+1,n+1);
z.Set(0,0,0);
break;
case 3:
zrows=1;
wastranspose=false;
z=matrix<double>::Zeros(2,n+1);
z.Set(1,1,1);
break;
}
nmaxit=n*maxit;
jtot=0;
//--- Determine where the matrix splits and choose QL or QR iteration
//--- for each block, according to whether top or bottom diagonal
//--- element is smaller.
l1=1;
nm1=n-1;
while(true)
{
if(l1>n)
break;
if(l1>1)
e.Set(l1-1,0);
gotoflag=false;
m=l1;
if(l1<=nm1)
for(m=l1; m<=nm1; m++)
{
tst=MathAbs(e[m]);
if(tst==0.0)
{
gotoflag=true;
break;
}
if(tst<=(MathSqrt(MathAbs(d[m]))*MathSqrt(MathAbs(d[m+1]))*eps))
{
e.Set(m,0);
gotoflag=true;
break;
}
}
if(!gotoflag)
m=n;
//---
l=l1;
lsv=l;
lend=m;
lendsv=lend;
l1=m+1;
if(lend==l)
continue;
//--- Scale submatrix in rows and columns L to LEND
anorm=MathMax(MathAbs(d[l])+MathAbs(e[l]),MathAbs(e[lend-1])+MathAbs(d[lend]));
for(i=l+1; i<lend; i++)
anorm=MathMax(anorm,MathAbs(d[i])+MathAbs(e[i])+MathAbs(e[i-1]));
iscale=0;
if(anorm==0.0)
continue;
if(anorm>ssfmax)
{
iscale=1;
tmp=ssfmax/anorm;
tmpint=lend-1;
for(i_=l; i_<=lend; i_++)
d.Mul(i_,tmp);
for(i_=l; i_<=tmpint; i_++)
e.Mul(i_,tmp);
}
if(anorm<ssfmin)
{
iscale=2;
tmp=ssfmin/anorm;
tmpint=lend-1;
for(i_=l; i_<=lend; i_++)
d.Mul(i_,tmp);
for(i_=l; i_<=tmpint; i_++)
e.Mul(i_,tmp);
}
//--- Choose between QL and QR iteration
if(MathAbs(d[lend])<MathAbs(d[l]))
{
lend=lsv;
l=lendsv;
}
if(lend>l)
{
//--- QL Iteration
//--- Look for small subdiagonal element.
while(true)
{
gotoflag=false;
if(l!=lend)
{
lendm1=lend-1;
for(m=l; m<=lendm1; m++)
{
tst=CMath::Sqr(e[m]);
if(tst<=(eps2*MathAbs(d[m])*MathAbs(d[m+1])+safmin))
{
gotoflag=true;
break;
}
}
}
if(!gotoflag)
m=lend;
if(m<lend)
e.Set(m,0);
p=d[l];
if(m!=l)
{
//--- If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
//--- to compute its eigensystem.
if(m==l+1)
{
if(zneeded>0)
{
TdEVDEv2(d[l],e[l],d[l+1],rt1,rt2,c,s);
work1.Set(l,c);
work2.Set(l,s);
workc.Set(1,c);
works.Set(1,s);
if(!wastranspose)
CRotations::ApplyRotationsFromTheRight(false,1,zrows,l,l+1,workc,works,z,wtemp);
else
CRotations::ApplyRotationsFromTheLeft(false,l,l+1,1,zrows,workc,works,z,wtemp);
}
else
TdEVDE2(d[l],e[l],d[l+1],rt1,rt2);
d.Set(l,rt1);
d.Set(l+1,rt2);
e.Set(l,0);
l+=2;
if(l<=lend)
continue;
break;
}
if(jtot==nmaxit)
break;
jtot++;
//--- Form shift.
g=(d[l+1]-p)/(2*e[l]);
r=TdEVDPythag(g,1);
g=d[m]-p+e[l]/(g+TdEVDExtSign(r,g));
s=1;
c=1;
p=0;
//--- Inner loop
mm1=m-1;
for(i=mm1; i>=l; i--)
{
f=s*e[i];
b=c*e[i];
CRotations::GenerateRotation(g,f,c,s,r);
if(i!=m-1)
e.Set(i+1,r);
g=d[i+1]-p;
r=(d[i]-g)*s+2*c*b;
p=s*r;
d.Set(i+1,g+p);
g=c*r-b;
//--- If eigenvectors are desired, then save CRotations::
if(zneeded>0)
{
work1.Set(i,c);
work2.Set(i,-s);
}
}
//--- If eigenvectors are desired, then apply saved CRotations::
if(zneeded>0)
{
for(i=l; i<m; i++)
{
workc.Set(i-l+1,work1[i]);
works.Set(i-l+1,work2[i]);
}
if(!wastranspose)
CRotations::ApplyRotationsFromTheRight(false,1,zrows,l,m,workc,works,z,wtemp);
else
CRotations::ApplyRotationsFromTheLeft(false,l,m,1,zrows,workc,works,z,wtemp);
}
d.Add(l,- p);
e.Set(l,g);
continue;
}
//--- Eigenvalue found.
d.Set(l,p);
l ++;
if(l<=lend)
continue;
break;
}
}
else
{
//--- QR Iteration
//--- Look for small superdiagonal element.
while(true)
{
gotoflag=false;
if(l!=lend)
{
lendp1=lend+1;
for(m=l; m>=lendp1; m--)
{
tst=CMath::Sqr(MathAbs(e[m-1]));
if(tst<=(MathAbs(eps2*d[m]*d[m-1])+safmin))
{
gotoflag=true;
break;
}
}
}
if(!gotoflag)
m=lend;
if(m>lend)
e.Set(m-1,0);
p=d[l];
if(m!=l)
{
//--- If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
//--- to compute its eigensystem.
if(m==l-1)
{
if(zneeded>0)
{
TdEVDEv2(d[l-1],e[l-1],d[l],rt1,rt2,c,s);
work1.Set(m,c);
work2.Set(m,s);
workc.Set(1,c);
works.Set(1,s);
if(!wastranspose)
CRotations::ApplyRotationsFromTheRight(true,1,zrows,l-1,l,workc,works,z,wtemp);
else
CRotations::ApplyRotationsFromTheLeft(true,l-1,l,1,zrows,workc,works,z,wtemp);
}
else
TdEVDE2(d[l-1],e[l-1],d[l],rt1,rt2);
d.Set(l-1,rt1);
d.Set(l,rt2);
e.Set(l-1,0);
l-=2;
if(l>=lend)
continue;
break;
}
if(jtot==nmaxit)
break;
jtot++;
//--- Form shift.
g=(d[l-1]-p)/(2*e[l-1]);
r=TdEVDPythag(g,1);
g=d[m]-p+e[l-1]/(g+TdEVDExtSign(r,g));
s=1;
c=1;
p=0;
//--- Inner loop
lm1=l-1;
for(i=m; i<=lm1; i++)
{
f=s*e[i];
b=c*e[i];
CRotations::GenerateRotation(g,f,c,s,r);
if(i!=m)
e.Set(i-1,r);
g=d[i]-p;
r=(d[i+1]-g)*s+2*c*b;
p=s*r;
d.Set(i,g+p);
g=c*r-b;
//--- If eigenvectors are desired, then save CRotations::
if(zneeded>0)
{
work1.Set(i,c);
work2.Set(i,s);
}
}
//--- If eigenvectors are desired, then apply saved CRotations::
if(zneeded>0)
{
for(i=m; i<l; i++)
{
workc.Set(i-m+1,work1[i]);
works.Set(i-m+1,work2[i]);
}
if(!wastranspose)
CRotations::ApplyRotationsFromTheRight(true,1,zrows,m,l,workc,works,z,wtemp);
else
CRotations::ApplyRotationsFromTheLeft(true,m,l,1,zrows,workc,works,z,wtemp);
}
d.Add(l,-p);
e.Set(lm1,g);
continue;
}
//--- Eigenvalue found.
d.Set(l,p);
l--;
if(l>=lend)
continue;
break;
}
}
//--- Undo scaling if necessary
if(iscale==1)
{
tmp=anorm/ssfmax;
tmpint=lendsv-1;
for(i_=lsv; i_<=lendsv; i_++)
d.Mul(i_,tmp);
for(i_=lsv; i_<=tmpint; i_++)
e.Mul(i_,tmp);
}
if(iscale==2)
{
tmp=anorm/ssfmin;
tmpint=lendsv-1;
for(i_=lsv; i_<=lendsv; i_++)
d.Mul(i_,tmp);
for(i_=lsv; i_<=tmpint; i_++)
e.Mul(i_,tmp);
}
//--- Check for no convergence to an eigenvalue after a total
//--- of N*MAXIT iterations.
if(jtot>=nmaxit)
{
result=false;
if(wastranspose)
CBlas::InplaceTranspose(z,1,n,1,n,wtemp);
return(result);
}
}
//--- Order eigenvalues and eigenvectors.
if(zneeded==0)
{
//--- Sort
if(n==1)
return(result);
if(n==2)
{
if(d[1]>d[2])
d.Swap(1,2);
return(result);
}
i=2;
do
{
t=i;
while(t!=1)
{
k=t/2;
if(d[k]>=d[t])
t=1;
else
{
d.Swap(k,t);
t=k;
}
}
i++;
}
while(i<=n);
i=n-1;
do
{
d.Swap(i+1,1);
t=1;
while(t!=0)
{
k=2*t;
if(k>i)
t=0;
else
{
if(k<i && d[k+1]>d[k])
k++;
if(d[t]>=d[k])
t=0;
else
{
d.Swap(k,t);
t=k;
}
}
}
i--;
}
while(i>=1);
}
else
{
//--- Use Selection Sort to minimize swaps of eigenvectors
for(ii=2; ii<=n; ii++)
{
i=ii-1;
k=i;
p=d[i];
for(j=ii; j<=n; j++)
if(d[j]<p)
{
k=j;
p=d[j];
}
if(k!=i)
{
d.Set(k,d[i]);
d.Set(i,p);
if(wastranspose)
{
for(i_=1; i_<=n; i_++)
wtemp.Set(i_,z.Get(i,i_));
for(i_=1; i_<=n; i_++)
z.Set(i,i_,z.Get(k,i_));
for(i_=1; i_<=n; i_++)
z.Set(k,i_,wtemp[i_]);
}
else
{
for(i_=1; i_<=zrows; i_++)
wtemp.Set(i_,z.Get(i_,i));
for(i_=1; i_<=zrows; i_++)
z.Set(i_,i,z.Get(i_,k));
for(i_=1; i_<=zrows; i_++)
z.Set(i_,k,wtemp[i_]);
}
}
}
if(wastranspose)
CBlas::InplaceTranspose(z,1,n,1,n,wtemp);
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix |
//| [ A B ] |
//| [ B C ]. |
//| On return, RT1 is the eigenvalue of larger absolute value, and |
//| RT2 is the eigenvalue of smaller absolute value. |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void CEigenVDetect::TdEVDE2(const double a,const double b,const double c,
double &rt1,double &rt2)
{
//--- create variables
double sm=a+c;
double df=a-c;
double adf=MathAbs(df);
double tb=b+b;
double ab=MathAbs(tb);
double acmn=0;
double acmx=0;
double rt=0;
//--- initialization
rt1=0;
rt2=0;
//--- check
if(MathAbs(a)>MathAbs(c))
{
acmx=a;
acmn=c;
}
else
{
acmx=c;
acmn=a;
}
//--- check
if(adf>ab)
{
rt=adf*MathSqrt(1+CMath::Sqr(ab/adf));
}
else
{
//--- check
if(adf<ab)
rt=ab*MathSqrt(1+CMath::Sqr(adf/ab));
else
{
//--- Includes case AB=ADF=0
rt=ab*MathSqrt(2);
}
}
//--- check
if(sm<0.0)
{
rt1=0.5*(sm-rt);
//--- Order of execution important.
//--- To get fully accurate smaller eigenvalue,
//--- next line needs to be executed in higher precision.
rt2=acmx/rt1*acmn-b/rt1*b;
}
else
{
//--- check
if(sm>0.0)
{
rt1=0.5*(sm+rt);
//--- Order of execution important.
//--- To get fully accurate smaller eigenvalue,
//--- next line needs to be executed in higher precision.
rt2=acmx/rt1*acmn-b/rt1*b;
}
else
{
//--- Includes case RT1 = RT2 = 0
rt1=0.5*rt;
rt2=-(0.5*rt);
}
}
}
//+------------------------------------------------------------------+
//| DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric |
//| matrix |
//| [ A B ] |
//| [ B C ]. |
//| On return, RT1 is the eigenvalue of larger absolute value, RT2 is|
//| the eigenvalue of smaller absolute value, and (CS1,SN1) is the |
//| unit right eigenvector for RT1, giving the decomposition |
//| [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] |
//| [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void CEigenVDetect::TdEVDEv2(const double a,const double b,const double c,
double &rt1,double &rt2,double &cs1,double &sn1)
{
//--- create variables
double sm=a+c;
double df=a-c;
double adf=MathAbs(df);
double tb=b+b;
double ab=MathAbs(tb);
int sgn1=0;
int sgn2=0;
double acmn=0;
double acmx=0;
double acs=0;
double cs=0;
double ct=0;
double rt=0;
double tn=0;
//--- initialization
rt1=0;
rt2=0;
cs1=0;
sn1=0;
//--- Compute the eigenvalues
if(MathAbs(a)>MathAbs(c))
{
acmx=a;
acmn=c;
}
else
{
acmx=c;
acmn=a;
}
//--- check
if(adf>ab)
rt=adf*MathSqrt(1+CMath::Sqr(ab/adf));
else
{
//--- check
if(adf<ab)
rt=ab*MathSqrt(1+CMath::Sqr(adf/ab));
else
{
//--- Includes case AB=ADF=0
rt=ab*MathSqrt(2);
}
}
//--- check
if(sm<0.0)
{
rt1=0.5*(sm-rt);
sgn1=-1;
//--- Order of execution important.
//--- To get fully accurate smaller eigenvalue,
//--- next line needs to be executed in higher precision.
rt2=acmx/rt1*acmn-b/rt1*b;
}
else
{
//--- check
if(sm>0.0)
{
rt1=0.5*(sm+rt);
sgn1=1;
//--- Order of execution important.
//--- To get fully accurate smaller eigenvalue,
//--- next line needs to be executed in higher precision.
rt2=acmx/rt1*acmn-b/rt1*b;
}
else
{
//--- Includes case RT1 = RT2 = 0
rt1=0.5*rt;
rt2=-(0.5*rt);
sgn1=1;
}
}
//--- Compute the eigenvector
if(df>=0.0)
{
cs=df+rt;
sgn2=1;
}
else
{
cs=df-rt;
sgn2=-1;
}
acs=MathAbs(cs);
//--- check
if(acs>ab)
{
ct=-(tb/cs);
sn1=1/MathSqrt(1+ct*ct);
cs1=ct*sn1;
}
else
{
//--- check
if(ab==0.0)
{
cs1=1;
sn1=0;
}
else
{
tn=-(cs/tb);
cs1=1/MathSqrt(1+tn*tn);
sn1=tn*cs1;
}
}
//--- check
if(sgn1==sgn2)
{
tn=cs1;
cs1=-sn1;
sn1=tn;
}
}
//+------------------------------------------------------------------+
//| Internal routine |
//+------------------------------------------------------------------+
double CEigenVDetect::TdEVDPythag(const double a,const double b)
{
//--- create variables
double result=0;
//--- check
if(MathAbs(a)<MathAbs(b))
result=MathAbs(b)*MathSqrt(1+CMath::Sqr(a/b));
else
result=MathAbs(a)*MathSqrt(1+CMath::Sqr(b/a));
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal routine |
//+------------------------------------------------------------------+
double CEigenVDetect::TdEVDExtSign(const double a,const double b)
{
//--- create variables
double result=0;
//--- check
if(b>=0.0)
result=MathAbs(a);
else
result=-MathAbs(a);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
bool CEigenVDetect::InternalBisectionEigenValues(CRowDouble &cd,CRowDouble &ce,
const int n,int irange,
const int iorder,const double vl,
const double vu,const int il,
const int iu,const double abstol,
CRowDouble &w,int &m,
int &nsplit,CRowInt &iblock,
CRowInt &isplit,int &errorcode)
{
//--- create variables
bool result;
double fudge=0;
double relfac=0;
bool ncnvrg;
bool toofew;
int ib=0;
int ibegin=0;
int idiscl=0;
int idiscu=0;
int ie=0;
int iend=0;
int iinfo=0;
int im=0;
int iin=0;
int ioff=0;
int iout=0;
int itmax=0;
int iw=0;
int iwoff=0;
int j=0;
int itmp1=0;
int jb=0;
int jdisc=0;
int je=0;
int nwl=0;
int nwu=0;
int tmpi=0;
double atoli=0;
double bnorm=0;
double gl=0;
double gu=0;
double pivmin=0;
double rtoli=0;
double safemn=0;
double tmp1=0;
double tmp2=0;
double tnorm=0;
double ulp=0;
double wkill=0;
double wl=0;
double wlu=0;
double wu=0;
double wul=0;
double scalefactor=0;
double t=0;
//--- create arrays
CRowInt idumma;
CRowDouble work;
CRowInt iwork;
CRowInt ia1s2;
CRowDouble ra1s2;
CRowDouble ra1siin;
CRowDouble ra2siin;
CRowDouble ra3siin;
CRowDouble ra4siin;
CRowInt iworkspace;
CRowDouble rworkspace;
//--- create matrix
CMatrixDouble ra1s2x2;
CMatrixInt ia1s2x2;
CMatrixDouble ra1siinx2;
CMatrixInt ia1siinx2;
//--- create copy
CRowDouble d=cd;
CRowDouble e=ce;
//--- initialization
m=0;
nsplit=0;
errorcode=0;
//--- Quick return if possible
if(n==0)
{
iblock.Resize(0);
isplit.Resize(0);
return(true);
}
//--- Get machine constants
//--- NB is the minimum vector length for vector bisection, or 0
//--- if only scalar is to be done.
fudge=2;
relfac=2;
safemn=CMath::m_minrealnumber;
ulp=2*CMath::m_machineepsilon;
rtoli=ulp*relfac;
//--- allocation
idumma.Resize(2);
work.Resize(4*n+1);
iwork.Resize(3*n+1);
w.Resize(n+1);
iblock.Resize(n+1);
isplit.Resize(n+1);
ia1s2.Resize(3);
ra1s2.Resize(3);
ra1siin.Resize(n+1);
ra2siin.Resize(n+1);
ra3siin.Resize(n+1);
ra4siin.Resize(n+1);
iworkspace.Resize(n+1);
rworkspace.Resize(n+1);
ra1siinx2.Resize(n+1,3);
ia1siinx2.Resize(n+1,3);
ra1s2x2.Resize(3,3);
ia1s2x2.Resize(3,3);
//--- initialization
wlu=0;
wul=0;
//--- Check for Errors
result=false;
errorcode=0;
//--- check
if(irange<=0 || irange>=4)
errorcode=-4;
if(iorder<=0 || iorder>=3)
errorcode=-5;
if(n<0)
errorcode=-3;
if(irange==2 && vl>=vu)
errorcode=-6;
if(irange==3 && (il<1 || il>MathMax(1,n)))
errorcode=-8;
if(irange==3 && (iu<MathMin(n,il) || iu>n))
errorcode=-9;
if(errorcode!=0)
return(result);
//--- Initialize error flags
ncnvrg=false;
toofew=false;
//--- Simplifications:
if(irange==3 && il==1 && iu==n)
irange=1;
//--- Special Case when N=1
if(n==1)
{
nsplit=1;
isplit.Set(1,1);
//--- check
if((irange==2 && vl>=d[1]) || vu<d[1])
m=0;
else
{
w.Set(1,d[1]);
iblock.Set(1,1);
m=1;
}
//--- return result
return(true);
}
//--- Scaling
t=MathAbs(d[n]);
for(j=1; j<n; j++)
{
t=MathMax(t,MathAbs(d[j]));
t=MathMax(t,MathAbs(e[j]));
}
scalefactor=1;
//--- check
if(t!=0.0)
{
//--- check
if(t>MathSqrt(MathSqrt(CMath::m_minrealnumber))*MathSqrt(CMath::m_maxrealnumber))
scalefactor=t;
//--- check
if(t<MathSqrt(MathSqrt(CMath::m_maxrealnumber))*MathSqrt(CMath::m_minrealnumber))
scalefactor=t;
CAblasF::RMulVX(n,1.0/scalefactor,d,1);
CAblasF::RMulVX(n-1,1.0/scalefactor,e,1);
}
//--- Compute Splitting Points
nsplit=1;
work.Set(n,0);
pivmin=1;
for(j=2; j<=n; j++)
{
tmp1=CMath::Sqr(e[j-1]);
//--- check
if(MathAbs(d[j]*d[j-1])*CMath::Sqr(ulp)+safemn>tmp1)
{
isplit.Set(nsplit,j-1);
nsplit++;
work.Set(j-1,0);
}
else
{
work.Set(j-1,tmp1);
pivmin=MathMax(pivmin,tmp1);
}
}
isplit.Set(nsplit,n);
pivmin=pivmin*safemn;
//--- Compute Interval and ATOLI
if(irange==3)
{
//--- RANGE='I': Compute the interval containing eigenvalues
//--- IL through IU.
//--- Compute Gershgorin interval for entire (split) matrix
//--- and use it as the initial interval
gu=d[1];
gl=d[1];
tmp1=0;
for(j=1; j<n; j++)
{
//--- change values
tmp2=MathSqrt(work[j]);
gu=MathMax(gu,d[j]+tmp1+tmp2);
gl=MathMin(gl,d[j]-tmp1-tmp2);
tmp1=tmp2;
}
//--- change values
gu=MathMax(gu,d[n]+tmp1);
gl=MathMin(gl,d[n]-tmp1);
tnorm=MathMax(MathAbs(gl),MathAbs(gu));
gl=gl-fudge*tnorm*ulp*n-fudge*2*pivmin;
gu=gu+fudge*tnorm*ulp*n+fudge*pivmin;
//--- Compute Iteration parameters
itmax=(int)MathCeil((MathLog(tnorm+pivmin)-MathLog(pivmin))/MathLog(2))+2;
//--- check
if(abstol<=0.0)
atoli=ulp*tnorm;
else
atoli=abstol;
//--- change values
work.Set(n+1,gl);
work.Set(n+2,gl);
work.Set(n+3,gu);
work.Set(n+4,gu);
work.Set(n+5,gl);
work.Set(n+6,gu);
iwork.Set(1,-1);
iwork.Set(2,-1);
iwork.Set(3,n+1);
iwork.Set(4,n+1);
iwork.Set(5,il-1);
iwork.Set(6,iu);
//--- Calling DLAEBZ
//--- DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E,
//--- WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
//--- IWORK, W, IBLOCK, IINFO )
ia1s2.Set(1,iwork[5]);
ia1s2.Set(2,iwork[6]);
ra1s2.Set(1,work[n+5]);
ra1s2.Set(2,work[n+6]);
ra1s2x2.Set(1,1,work[n+1]);
ra1s2x2.Set(2,1,work[n+2]);
ra1s2x2.Set(1,2,work[n+3]);
ra1s2x2.Set(2,2,work[n+4]);
ia1s2x2.Set(1,1,iwork[1]);
ia1s2x2.Set(2,1,iwork[2]);
ia1s2x2.Set(1,2,iwork[3]);
ia1s2x2.Set(2,2,iwork[4]);
//--- function call
InternalDLAEBZ(3,itmax,n,2,2,atoli,rtoli,pivmin,d,e,work,ia1s2,ra1s2x2,ra1s2,iout,ia1s2x2,w,iblock,iinfo);
iwork.Set(5,ia1s2[1]);
iwork.Set(6,ia1s2[2]);
work.Set(n+5,ra1s2[1]);
work.Set(n+6,ra1s2[2]);
work.Set(n+1,ra1s2x2.Get(1,1));
work.Set(n+2,ra1s2x2.Get(2,1));
work.Set(n+3,ra1s2x2.Get(1,2));
work.Set(n+4,ra1s2x2.Get(2,2));
iwork.Set(1,ia1s2x2.Get(1,1));
iwork.Set(2,ia1s2x2.Get(2,1));
iwork.Set(3,ia1s2x2.Get(1,2));
iwork.Set(4,ia1s2x2.Get(2,2));
//--- check
if(iwork[6]==iu)
{
//--- change values
wl=work[n+1];
wlu=work[n+3];
nwl=iwork[1];
wu=work[n+4];
wul=work[n+2];
nwu=iwork[4];
}
else
{
//--- change values
wl=work[n+2];
wlu=work[n+4];
nwl=iwork[2];
wu=work[n+3];
wul=work[n+1];
nwu=iwork[3];
}
//--- check
if(nwl<0 || nwl>=n || nwu<1 || nwu>n)
{
errorcode=4;
return(false);
}
}
else
{
//--- RANGE='A' or 'V' -- Set ATOLI
tnorm=MathMax(MathAbs(d[1])+MathAbs(e[1]),MathAbs(d[n])+MathAbs(e[n-1]));
for(j=2; j<n; j++)
tnorm=MathMax(tnorm,MathAbs(d[j])+MathAbs(e[j-1])+MathAbs(e[j]));
//--- check
if(abstol<=0.0)
atoli=ulp*tnorm;
else
atoli=abstol;
//--- check
if(irange==2)
{
wl=vl;
wu=vu;
}
else
{
wl=0;
wu=0;
}
}
//--- Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU.
//--- NWL accumulates the number of eigenvalues .le. WL,
//--- NWU accumulates the number of eigenvalues .le. WU
m=0;
iend=0;
errorcode=0;
nwl=0;
nwu=0;
for(jb=1; jb<=nsplit; jb++)
{
ioff=iend;
ibegin=ioff+1;
iend=isplit[jb];
iin=iend-ioff;
//--- check
if(iin==1)
{
//--- Special Case -- IIN=1
if(irange==1 || wl>=d[ibegin]-pivmin)
nwl=nwl+1;
//--- check
if(irange==1 || wu>=d[ibegin]-pivmin)
nwu=nwu+1;
//--- check
if((irange==1 || wl<d[ibegin]-pivmin) && wu>=d[ibegin]-pivmin)
{
m=m+1;
w.Set(m,d[ibegin]);
iblock.Set(m,jb);
}
}
else
{
//--- General Case -- IIN > 1
//--- Compute Gershgorin Interval
//--- and use it as the initial interval
gu=d[ibegin];
gl=d[ibegin];
tmp1=0;
for(j=ibegin; j<iend; j++)
{
//--- change values
tmp2=MathAbs(e[j]);
gu=MathMax(gu,d[j]+tmp1+tmp2);
gl=MathMin(gl,d[j]-tmp1-tmp2);
tmp1=tmp2;
}
//--- change values
gu=MathMax(gu,d[iend]+tmp1);
gl=MathMin(gl,d[iend]-tmp1);
bnorm=MathMax(MathAbs(gl),MathAbs(gu));
gl=gl-fudge*bnorm*ulp*iin-fudge*pivmin;
gu=gu+fudge*bnorm*ulp*iin+fudge*pivmin;
//--- Compute ATOLI for the current submatrix
if(abstol<=0.0)
atoli=ulp*MathMax(MathAbs(gl),MathAbs(gu));
else
atoli=abstol;
//--- check
if(irange>1)
{
//--- check
if(gu<wl)
{
nwl=nwl+iin;
nwu=nwu+iin;
continue;
}
gl=MathMax(gl,wl);
gu=MathMin(gu,wu);
//--- check
if(gl>=gu)
continue;
}
//--- Set Up Initial Interval
work.Set(n+1,gl);
work.Set(n+iin+1,gu);
//--- Calling DLAEBZ
//--- CALL DLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
//--- D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
//--- IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
//--- IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
for(tmpi=1; tmpi<=iin; tmpi++)
{
ra1siin.Set(tmpi,d[ibegin-1+tmpi]);
//--- check
if(ibegin-1+tmpi<n)
ra2siin.Set(tmpi,e[ibegin-1+tmpi]);
//--- change values
ra3siin.Set(tmpi,work[ibegin-1+tmpi]);
ra1siinx2.Set(tmpi,1,work[n+tmpi]);
ra1siinx2.Set(tmpi,2,work[n+tmpi+iin]);
ra4siin.Set(tmpi,work[n+2*iin+tmpi]);
rworkspace.Set(tmpi,w[m+tmpi]);
iworkspace.Set(tmpi,iblock[m+tmpi]);
ia1siinx2.Set(tmpi,1,iwork[tmpi]);
ia1siinx2.Set(tmpi,2,iwork[tmpi+iin]);
}
//--- function call
InternalDLAEBZ(1,0,iin,iin,1,atoli,rtoli,pivmin,ra1siin,ra2siin,ra3siin,idumma,ra1siinx2,ra4siin,im,ia1siinx2,rworkspace,iworkspace,iinfo);
for(tmpi=1; tmpi<=iin; tmpi++)
{
//--- change values
work.Set(n+tmpi,ra1siinx2.Get(tmpi,1));
work.Set(n+tmpi+iin,ra1siinx2.Get(tmpi,2));
work.Set(n+2*iin+tmpi,ra4siin[tmpi]);
w.Set(m+tmpi,rworkspace[tmpi]);
iblock.Set(m+tmpi,iworkspace[tmpi]);
iwork.Set(tmpi,ia1siinx2.Get(tmpi,1));
iwork.Set(tmpi+iin,ia1siinx2.Get(tmpi,2));
}
nwl=nwl+iwork[1];
nwu=nwu+iwork[iin+1];
iwoff=m-iwork[1];
//--- Compute Eigenvalues
itmax=(int)MathCeil((MathLog(gu-gl+pivmin)-MathLog(pivmin))/MathLog(2))+2;
//--- Calling DLAEBZ
//--- CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
//--- D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
//--- IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
//--- IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
for(tmpi=1; tmpi<=iin; tmpi++)
{
ra1siin.Set(tmpi,d[ibegin-1+tmpi]);
//--- check
if(ibegin-1+tmpi<n)
ra2siin.Set(tmpi,e[ibegin-1+tmpi]);
//--- change values
ra3siin.Set(tmpi,work[ibegin-1+tmpi]);
ra1siinx2.Set(tmpi,1,work[n+tmpi]);
ra1siinx2.Set(tmpi,2,work[n+tmpi+iin]);
ra4siin.Set(tmpi,work[n+2*iin+tmpi]);
rworkspace.Set(tmpi,w[m+tmpi]);
iworkspace.Set(tmpi,iblock[m+tmpi]);
ia1siinx2.Set(tmpi,1,iwork[tmpi]);
ia1siinx2.Set(tmpi,2,iwork[tmpi+iin]);
}
//--- function call
InternalDLAEBZ(2,itmax,iin,iin,1,atoli,rtoli,pivmin,ra1siin,ra2siin,ra3siin,idumma,ra1siinx2,ra4siin,iout,ia1siinx2,rworkspace,iworkspace,iinfo);
for(tmpi=1; tmpi<=iin; tmpi++)
{
//--- change values
work.Set(n+tmpi,ra1siinx2.Get(tmpi,1));
work.Set(n+tmpi+iin,ra1siinx2.Get(tmpi,2));
work.Set(n+2*iin+tmpi,ra4siin[tmpi]);
w.Set(m+tmpi,rworkspace[tmpi]);
iblock.Set(m+tmpi,iworkspace[tmpi]);
iwork.Set(tmpi,ia1siinx2.Get(tmpi,1));
iwork.Set(tmpi+iin,ia1siinx2.Get(tmpi,2));
}
//--- Copy Eigenvalues Into W and IBLOCK
//--- Use -JB for block number for unconverged eigenvalues.
for(j=1; j<=iout; j++)
{
tmp1=0.5*(work[j+n]+work[j+iin+n]);
//--- Flag non-convergence.
if(j>iout-iinfo)
{
ncnvrg=true;
ib=-jb;
}
else
ib=jb;
for(je=iwork[j]+1+iwoff; je<=iwork[j+iin]+iwoff; je++)
{
w.Set(je,tmp1);
iblock.Set(je,ib);
}
}
m=m+im;
}
}
//--- If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
//--- If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
if(irange==3)
{
im=0;
idiscl=il-1-nwl;
idiscu=nwu-iu;
//--- check
if(idiscl>0 || idiscu>0)
{
for(je=1; je<=m; je++)
{
//--- check
if(w[je]<=wlu && idiscl>0)
{
idiscl=idiscl-1;
}
else
{
//--- check
if(w[je]>=wul && idiscu>0)
idiscu=idiscu-1;
else
{
im++;
w.Set(im,w[je]);
iblock.Set(im,iblock[je]);
}
}
}
m=im;
}
//--- check
if(idiscl>0 || idiscu>0)
{
//--- Code to deal with effects of bad arithmetic:
//--- Some low eigenvalues to be discarded are not in (WL,WLU],
//--- or high eigenvalues to be discarded are not in (WUL,WU]
//--- so just kill off the smallest IDISCL/largest IDISCU
//--- eigenvalues, by simply finding the smallest/largest
//--- eigenvalue(s).
//--- (If N(w) is monotone non-decreasing, this should never
//--- happen.)
if(idiscl>0)
{
wkill=wu;
for(jdisc=1; jdisc<=idiscl; jdisc++)
{
iw=0;
for(je=1; je<=m; je++)
{
//--- check
if(iblock[je]!=0 && (w[je]<(double)(wkill) || iw==0))
{
iw=je;
wkill=w[je];
}
}
iblock.Set(iw,0);
}
}
//--- check
if(idiscu>0)
{
wkill=wl;
for(jdisc=1; jdisc<=idiscu; jdisc++)
{
iw=0;
for(je=1; je<=m; je++)
{
//--- check
if(iblock[je]!=0 && (w[je]>(double)(wkill) || iw==0))
{
iw=je;
wkill=w[je];
}
}
iblock.Set(iw,0);
}
}
im=0;
for(je=1; je<=m; je++)
{
//--- check
if(iblock[je]!=0)
{
im++;
w.Set(im,w[je]);
iblock.Set(im,iblock[je]);
}
}
m=im;
}
//--- check
if(idiscl<0 || idiscu<0)
toofew=true;
}
//--- If ORDER='B', do nothing -- the eigenvalues are already sorted
//--- by block.
//--- If ORDER='E', sort the eigenvalues from smallest to largest
if(iorder==1 && nsplit>1)
{
for(je=1; je<=m-1; je++)
{
ie=0;
tmp1=w[je];
for(j=je+1; j<=m; j++)
{
//--- check
if(w[j]<tmp1)
{
ie=j;
tmp1=w[j];
}
}
//--- check
if(ie!=0)
{
//--- change values
itmp1=iblock[ie];
w.Set(ie,w[je]);
iblock.Set(ie,iblock[je]);
w.Set(je,tmp1);
iblock.Set(je,itmp1);
}
}
}
CAblasF::RMulVX(m,scalefactor,w,1);
errorcode=0;
//--- check
if(ncnvrg)
errorcode=errorcode+1;
//--- check
if(toofew)
errorcode=errorcode+2;
result=errorcode==0;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CEigenVDetect::InternalDStein(const int n,CRowDouble &d,CRowDouble &ce,
const int m,CRowDouble &cw,CRowInt &iblock,
CRowInt &isplit,CMatrixDouble &z,
CRowInt &ifail,int &info)
{
//--- create variables
int maxits=0;
int extra=0;
int b1=0;
int blksiz=0;
int bn=0;
int gpind=0;
int i=0;
int iinfo=0;
int its=0;
int j=0;
int j1=0;
int jblk=0;
int jmax=0;
int nblk=0;
int nrmchk=0;
double dtpcrt=0;
double eps=0;
double eps1=0;
double nrm=0;
double onenrm=0;
double ortol=0;
double pertol=0;
double scl=0;
double sep=0;
double tol=0;
double xj=0;
double xjm=0;
double ztr=0;
bool tmpcriterion;
int ti=0;
int i1=0;
int i2=0;
double v=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble work1;
CRowDouble work2;
CRowDouble work3;
CRowDouble work4;
CRowDouble work5;
CRowInt iwork;
//--- create copy
CRowDouble e=ce;
CRowDouble w=cw;
CHighQualityRandState rs;
//--- initialization
info=0;
maxits=5;
extra=2;
CHighQualityRand::HQRndSeed(346436,2434,rs);
//--- allocation
work1.Resize((int)MathMax(n,1)+1);
work2.Resize((int)MathMax(n-1,1)+1);
work3.Resize((int)MathMax(n,1)+1);
work4.Resize((int)MathMax(n,1)+1);
work5.Resize((int)MathMax(n,1)+1);
iwork.Resize((int)MathMax(n,1)+1);
CAblasF::ISetAllocV((int)MathMax(m,1)+1,0,ifail);
z.Resize((int)MathMax(n,1)+1,(int)MathMax(m,1)+1);
//--- initialization
gpind=0;
onenrm=0;
ortol=0;
dtpcrt=0;
xjm=0;
//--- check input parameters
info=0;
if(n<0)
{
info=-1;
return;
}
//--- check
if(m<0 || m>n)
{
info=-4;
return;
}
for(j=2; j<=m; j++)
{
//--- check
if(iblock[j]<iblock[j-1])
{
info=-6;
//--- break the cycle
break;
}
//--- check
if(iblock[j]==iblock[j-1] && w[j]<w[j-1])
{
info=-5;
//--- break the cycle
break;
}
}
//--- check
if(info!=0)
return;
//--- Quick return if possible
if(n==0 || m==0)
return;
//--- check
if(n==1)
{
z.Set(1,1,1);
return;
}
//--- Some preparations
e.Resize(n+1);
w.Resize(n+1);
//--- Get machine constants.
eps=CMath::m_machineepsilon;
//--- Compute eigenvectors of matrix blocks.
j1=1;
for(nblk=1; nblk<=iblock[m]; nblk++)
{
//--- Find starting and ending indices of block nblk.
if(nblk==1)
b1=1;
else
b1=isplit[nblk-1]+1;
bn=isplit[nblk];
blksiz=bn-b1+1;
//--- check
if(blksiz!=1)
{
//--- Compute reorthogonalization criterion and stopping criterion.
gpind=b1;
onenrm=MathAbs(d[b1])+MathAbs(e[b1]);
onenrm=MathMax(onenrm,MathAbs(d[bn])+MathAbs(e[bn-1]));
for(i=b1+1; i<bn; i++)
onenrm=MathMax(onenrm,MathAbs(d[i])+MathAbs(e[i-1])+MathAbs(e[i]));
ortol=0.001*onenrm;
dtpcrt=MathSqrt(0.1/blksiz);
}
//--- Loop through eigenvalues of block nblk.
jblk=0;
for(j=j1; j<=m; j++)
{
//--- check
if(iblock[j]!=nblk)
{
j1=j;
//--- break the cycle
break;
}
jblk=jblk+1;
xj=w[j];
//--- check
if(blksiz==1)
{
//--- Skip all the work if the block size is one.
work1.Set(1,1);
}
else
{
//--- If eigenvalues j and j-1 are too close, add a relatively
//--- small perturbation.
if(jblk>1)
{
eps1=MathAbs(eps*xj);
pertol=10*eps1;
sep=xj-xjm;
//--- check
if(sep<pertol)
xj=xjm+pertol;
}
its=0;
nrmchk=0;
//--- Get random starting vector.
for(ti=1; ti<=blksiz; ti++)
work1.Set(ti,2*CHighQualityRand::HQRndUniformR(rs)-1);
//--- Copy the matrix T so it won't be destroyed in factorization.
for(ti=1; ti<=blksiz-1; ti++)
{
work2.Set(ti,e[b1+ti-1]);
work3.Set(ti,e[b1+ti-1]);
work4.Set(ti,d[b1+ti-1]);
}
work4.Set(blksiz,d[b1+blksiz-1]);
//--- Compute LU factors with partial pivoting ( PT = LU )
tol=0;
TdIninternalDLAGTF(blksiz,work4,xj,work2,work3,tol,work5,iwork,iinfo);
//--- Update iteration count.
do
{
its=its+1;
//--- check
if(its>maxits)
{
//--- If stopping criterion was not satisfied, update info and
//--- store eigenvector number in array ifail.
info=info+1;
ifail.Set(info,j);
break;
}
//--- Normalize and scale the righthand side vector Pb.
v=0;
for(ti=1; ti<=blksiz; ti++)
v=v+MathAbs(work1[ti]);
scl=blksiz*onenrm*MathMax(eps,MathAbs(work4[blksiz]))/v;
CAblasF::RMulVX(blksiz,scl,work1,1);
//--- Solve the system LU = Pb.
TdIninternalDLAGTS(blksiz,work4,work2,work3,work5,iwork,work1,tol,iinfo);
//--- Reorthogonalize by modified Gram-Schmidt if eigenvalues are
//--- close enough.
if(jblk!=1)
{
//--- check
if(MathAbs(xj-xjm)>ortol)
gpind=j;
//--- check
if(gpind!=j)
{
for(i=gpind; i<j; i++)
{
i1=b1;
i2=b1+blksiz-1;
i1_=i1-1;
ztr=0.0;
for(i_=1; i_<=blksiz; i_++)
ztr+=work1[i_]*z.Get(i_+i1_,i);
for(i_=1; i_<=blksiz; i_++)
work1.Set(i_,work1[i_]-ztr*z.Get(i_+i1_,i));
}
}
}
//--- Check the infinity norm of the iterate.
jmax=CBlas::VectorIdxAbsMax(work1,1,blksiz);
nrm=MathAbs(work1[jmax]);
//--- Continue for additional iterations after norm reaches
//--- stopping criterion.
tmpcriterion=false;
//--- check
if(nrm<dtpcrt)
tmpcriterion=true;
else
{
nrmchk=nrmchk+1;
//--- check
if(nrmchk<extra+1)
tmpcriterion=true;
}
}
while(tmpcriterion);
//--- Accept iterate as jth eigenvector.
scl=1/CBlas::VectorNorm2(work1,1,blksiz);
jmax=CBlas::VectorIdxAbsMax(work1,1,blksiz);
//--- check
if(work1[jmax]<0.0)
scl=-scl;
CAblasF::RMulVX(blksiz,scl,work1,1);
}
z.Col(j,vector<double>::Zeros(n+1));
for(i=1; i<=blksiz; i++)
z.Set(b1+i-1,j,work1[i]);
//--- Save the shift to check eigenvalue spacing at next iteration.
xjm=xj;
}
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CEigenVDetect::TdIninternalDLAGTF(const int n,CRowDouble &a,const double lambdav,
CRowDouble &b,CRowDouble &c,double tol,
CRowDouble &d,CRowInt &iin,int &info)
{
//--- create variables
int k=0;
double eps=0;
double mult=0;
double piv1=0;
double piv2=0;
double scale1=0;
double scale2=0;
double temp=0;
double tl=0;
//--- initialization
info=0;
//--- check
if(n<0)
{
info=-1;
return;
}
//--- check
if(n==0)
return;
a.Set(1,a[1]-lambdav);
iin.Set(n,0);
//--- check
if(n==1)
{
//--- check
if(a[1]==0.0)
iin.Set(1,1);
//--- exit the function
return;
}
//--- initialization
eps=CMath::m_machineepsilon;
tl=MathMax(tol,eps);
scale1=MathAbs(a[1])+MathAbs(b[1]);
for(k=1; k<n; k++)
{
a.Set(k+1,a[k+1]-lambdav);
scale2=MathAbs(c[k])+MathAbs(a[k+1]);
//--- check
if(k<n-1)
scale2=scale2+MathAbs(b[k+1]);
//--- check
if(a[k]==0.0)
piv1=0;
else
piv1=MathAbs(a[k])/scale1;
//--- check
if(c[k]==0.0)
{
iin.Set(k,0);
piv2=0;
scale1=scale2;
//--- check
if(k<n-1)
d.Set(k,0);
}
else
{
piv2=MathAbs(c[k])/scale2;
//--- check
if(piv2<=piv1)
{
//--- change values
iin.Set(k,0);
scale1=scale2;
c.Set(k,c[k]/a[k]);
a.Set(k+1,a[k+1]-c[k]*b[k]);
//--- check
if(k<n-1)
d.Set(k,0);
}
else
{
//--- change values
iin.Set(k,1);
mult=a[k]/c[k];
a.Set(k,c[k]);
temp=a[k+1];
a.Set(k+1,b[k]-mult*temp);
if(k<n-1)
{
d.Set(k,b[k+1]);
b.Set(k+1,-(mult*d[k]));
}
b.Set(k,temp);
c.Set(k,mult);
}
}
//--- check
if(MathMax(piv1,piv2)<=tl && iin[n]==0)
iin.Set(n,k);
}
//--- check
if(MathAbs(a[n])<=scale1*tl && iin[n]==0)
iin.Set(n,n);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CEigenVDetect::TdIninternalDLAGTS(const int n,CRowDouble &a,CRowDouble &b,
CRowDouble &c,CRowDouble &d,CRowInt &iin,
CRowDouble &y,double &tol,int &info)
{
//--- create variables
int k=0;
double absak=0;
double ak=0;
double bignum=0;
double eps=0;
double pert=0;
double sfmin=0;
double temp=0;
//--- initialization
info=0;
//--- check
if(n<0)
{
info=-1;
return;
}
//--- check
if(n==0)
return;
//--- initialization
eps=CMath::m_machineepsilon;
sfmin=CMath::m_minrealnumber;
bignum=1/sfmin;
//--- check
if(tol<=0.0)
{
tol=MathAbs(a[1]);
//--- check
if(n>1)
tol=MathMax(tol,MathMax(MathAbs(a[2]),MathAbs(b[1])));
for(k=3; k<=n; k++)
tol=MathMax(tol,MathMax(MathAbs(a[k]),MathMax(MathAbs(b[k-1]),MathAbs(d[k-2]))));
//--- check
if(tol==0.0)
tol=eps;
else
tol=tol*eps;
}
for(k=2; k<=n; k++)
{
//--- check
if(iin[k-1]==0)
y.Set(k,y[k]-c[k-1]*y[k-1]);
else
{
temp=y[k-1];
y.Set(k-1,y[k]);
y.Set(k,temp-c[k-1]*y[k]);
}
}
for(k=n; k>=1; k--)
{
//--- check
if(k<=n-2)
temp=y[k]-b[k]*y[k+1]-d[k]*y[k+2];
else
{
//--- check
if(k==n-1)
temp=y[k]-b[k]*y[k+1];
else
temp=y[k];
}
ak=a[k];
pert=MathAbs(tol);
//--- check
if(ak<0.0)
pert=-pert;
while(true)
{
absak=MathAbs(ak);
//--- check
if(absak<1.0)
{
//--- check
if(absak<sfmin)
{
//--- check
if(absak==0.0 || MathAbs(temp)*sfmin>absak)
{
ak=ak+pert;
pert=2*pert;
continue;
}
else
{
temp=temp*bignum;
ak=ak*bignum;
}
}
else
{
//--- check
if(MathAbs(temp)>absak*bignum)
{
ak=ak+pert;
pert=2*pert;
continue;
}
}
}
//--- break the cycle
break;
}
y.Set(k,temp/ak);
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CEigenVDetect::InternalDLAEBZ(const int ijob,const int nitmax,
const int n,const int mmax,const int minp,
const double abstol,const double reltol,
const double pivmin,CRowDouble &d,
CRowDouble &e,CRowDouble &e2,CRowInt &nval,
CMatrixDouble &ab,CRowDouble &c,int &mout,
CMatrixInt &nab,CRowDouble &work,
CRowInt &iwork,int &info)
{
//--- create variables
int itmp1=0;
int itmp2=0;
int j=0;
int ji=0;
int jit=0;
int jp=0;
int kf=0;
int kfnew=0;
int kl=0;
int klnew=0;
double tmp1=0;
double tmp2=0;
//--- initialization
mout=0;
info=0;
//--- check
if(ijob<1 || ijob>3)
{
info=-1;
//--- exit the function
return;
}
//--- Initialize NAB
if(ijob==1)
{
//--- Compute the number of eigenvalues in the initial intervals.
mout=0;
//--- DIR$ NOVECTOR
for(ji=1; ji<=minp; ji++)
{
for(jp=1; jp<=2; jp++)
{
tmp1=d[1]-ab.Get(ji,jp);
//--- check
if(MathAbs(tmp1)<pivmin)
tmp1=-pivmin;
nab.Set(ji,jp,0);
//--- check
if(tmp1<=0.0)
nab.Set(ji,jp,1);
for(j=2; j<=n; j++)
{
tmp1=d[j]-e2[j-1]/tmp1-ab.Get(ji,jp);
//--- check
if(MathAbs(tmp1)<pivmin)
tmp1=-pivmin;
//--- check
if(tmp1<=0.0)
nab.Set(ji,jp,nab.Get(ji,jp)+1);
}
}
mout=mout+nab.Get(ji,2)-nab.Get(ji,1);
}
//--- exit the function
return;
}
//--- Initialize for loop
//--- KF and KL have the following meaning:
//--- Intervals 1,...,KF-1 have converged.
//--- Intervals KF,...,KL still need to be refined.
kf=1;
kl=minp;
//--- If IJOB=2, initialize C.
//--- If IJOB=3, use the user-supplied starting point.
if(ijob==2)
{
for(ji=1; ji<=minp; ji++)
c.Set(ji,0.5*(ab.Get(ji,1)+ab.Get(ji,2)));
}
//--- Iteration loop
for(jit=1; jit<=nitmax; jit++)
{
//--- Loop over intervals
//--- Serial Version of the loop
klnew=kl;
for(ji=kf; ji<=kl; ji++)
{
//--- Compute N(w), the number of eigenvalues less than w
tmp1=c[ji];
tmp2=d[1]-tmp1;
itmp1=0;
//--- check
if(tmp2<=pivmin)
{
itmp1=1;
tmp2=MathMin(tmp2,-pivmin);
}
//--- A series of compiler directives to defeat vectorization
//--- for the next loop
//--- *$PL$ CMCHAR=' '
//--- CDIR$ NEXTSCALAR
//--- C$DIR SCALAR
//--- CDIR$ NEXT SCALAR
//--- CVD$L NOVECTOR
//--- CDEC$ NOVECTOR
//--- CVD$ NOVECTOR
//--- *VDIR NOVECTOR
//--- *VOCL LOOP,SCALAR
//--- CIBM PREFER SCALAR
//--- *$PL$ CMCHAR='*'
for(j=2; j<=n; j++)
{
tmp2=d[j]-e2[j-1]/tmp2-tmp1;
//--- check
if(tmp2<=pivmin)
{
itmp1=itmp1+1;
tmp2=MathMin(tmp2,-pivmin);
}
}
//--- check
if(ijob<=2)
{
//--- IJOB=2: Choose all intervals containing eigenvalues.
//--- Insure that N(w) is monotone
itmp1=MathMin(nab.Get(ji,2),MathMax(nab.Get(ji,1),itmp1));
//--- Update the Queue -- add intervals if both halves
//--- contain eigenvalues.
if(itmp1==nab.Get(ji,2))
{
//--- No eigenvalue in the upper interval:
//--- just use the lower interval.
ab.Set(ji,2,tmp1);
}
else
{
//--- check
if(itmp1==nab.Get(ji,1))
{
//--- No eigenvalue in the lower interval:
//--- just use the upper interval.
ab.Set(ji,1,tmp1);
}
else
{
//--- check
if(klnew<mmax)
{
//--- Eigenvalue in both intervals -- add upper to queue.
klnew=klnew+1;
ab.Set(klnew,2,ab.Get(ji,2));
nab[klnew].Set(2,nab.Get(ji,2));
ab.Set(klnew,1,tmp1);
nab[klnew].Set(1,itmp1);
ab.Set(ji,2,tmp1);
nab[ji].Set(2,itmp1);
}
else
{
info=mmax+1;
//--- exit the function
return;
}
}
}
}
else
{
//--- IJOB=3: Binary search. Keep only the interval
//--- containing w s.t. N(w) = NVAL
if(itmp1<=nval[ji])
{
ab.Set(ji,1,tmp1);
nab[ji].Set(1,itmp1);
}
//--- check
if(itmp1>=nval[ji])
{
ab.Set(ji,2,tmp1);
nab.Set(ji,2,itmp1);
}
}
}
kl=klnew;
//--- Check for convergence
kfnew=kf;
for(ji=kf; ji<=kl; ji++)
{
tmp1=MathAbs(ab.Get(ji,2)-ab.Get(ji,1));
tmp2=MathMax(MathAbs(ab.Get(ji,2)),MathAbs(ab.Get(ji,1)));
//--- check
if(tmp1<(double)(MathMax(abstol,MathMax(pivmin,reltol*tmp2))) || nab.Get(ji,1)>=nab.Get(ji,2))
{
//--- Converged -- Swap with position KFNEW,
//--- then increment KFNEW
if(ji>kfnew)
{
tmp1=ab.Get(ji,1);
tmp2=ab.Get(ji,2);
itmp1=nab.Get(ji,1);
itmp2=nab.Get(ji,2);
//--- change values
ab.Set(ji,1,ab.Get(kfnew,1));
ab.Set(ji,2,ab.Get(kfnew,2));
nab[ji].Set(1,nab.Get(kfnew,1));
nab[ji].Set(2,nab.Get(kfnew,2));
ab.Set(kfnew,1,tmp1);
ab.Set(kfnew,2,tmp2);
nab.Set(kfnew,1,itmp1);
nab.Set(kfnew,2,itmp2);
//--- check
if(ijob==3)
nval.Swap(ji,kfnew);
}
kfnew++;
}
}
kf=kfnew;
//--- Choose Midpoints
for(ji=kf; ji<=kl; ji++)
c.Set(ji,0.5*(ab.Get(ji,1)+ab.Get(ji,2)));
//--- If no more intervals to refine, quit.
if(kf>kl)
break;
}
//--- Converged
info=(int)MathMax(kl+1-kf,0);
mout=kl;
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee,Univ. of California Berkeley,NAG Ltd., |
//| Courant Institute,Argonne National Lab, and Rice University |
//| June 30,1999 |
//+------------------------------------------------------------------+
void CEigenVDetect::RMatrixInternalTREVC(CMatrixDouble &t,
int n,int side,int howmny,bool &vselect[],
CMatrixDouble &vl,CMatrixDouble &vr,int &m,int &info)
{
int i=0;
int j=0;
CMatrixDouble t1;
CMatrixDouble vl1;
CMatrixDouble vr1;
bool vselect1[];
m=0;
info=0;
//--- Allocate VL/VR, if needed
if(howmny==2 || howmny==3)
{
if(side==1 || side==3)
CApServ::RMatrixSetLengthAtLeast(vr,n,n);
if(side==2 || side==3)
CApServ::RMatrixSetLengthAtLeast(vl,n,n);
}
//--- ALGLIB version
t1.Resize(n+1,n+1);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
t1.Set(i+1,j+1,t.Get(i,j));
if(howmny==3)
ArrayCopy(vselect1,vselect,1,0,n);
if((side==2 || side==3) && howmny==1)
{
vl1.Resize(n+1,n+1);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
vl1.Set(i+1,j+1,vl.Get(i,j));
}
if((side==1 || side==3) && howmny==1)
{
vr1.Resize(n+1,n+1);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
vr1.Set(i+1,j+1,vr.Get(i,j));
}
InternalTREVC(t1,n,side,howmny,vselect1,vl1,vr1,m,info);
if(side!=1)
{
CApServ::RMatrixSetLengthAtLeast(vl,n,n);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
vl.Set(i,j,vl1.Get(i+1,j+1));
}
if(side!=2)
{
CApServ::RMatrixSetLengthAtLeast(vr,n,n);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
vr.Set(i,j,vr1.Get(i+1,j+1));
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee,Univ. of California Berkeley,NAG Ltd., |
//| Courant Institute,Argonne National Lab, and Rice University |
//| June 30,1999 |
//+------------------------------------------------------------------+
void CEigenVDetect::InternalTREVC(CMatrixDouble &t,const int n,const int side,
const int howmny,bool &cvselect[],CMatrixDouble &vl,
CMatrixDouble &vr,int &m,int &info)
{
//--- create variables
bool allv;
bool bothv;
bool leftv;
bool over;
bool pair;
bool rightv;
bool somev;
int i=0;
int ierr=0;
int ii=0;
int ip=0;
int iis=0;
int j=0;
int j1=0;
int j2=0;
int jnxt=0;
int k=0;
int ki=0;
int n2=0;
double beta=0;
double bignum=0;
double emax=0;
double ovfl=0;
double rec=0;
double remax=0;
double scl=0;
double smin=0;
double smlnum=0;
double ulp=0;
double unfl=0;
double vcrit=0;
double vmax=0;
double wi=0;
double wr=0;
double xnorm=0;
bool skipflag;
int k1=0;
int k2=0;
int k3=0;
int k4=0;
double vt=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble work;
CRowDouble temp;
bool rswap4[];
bool zswap4[];
CRowDouble civ4;
CRowDouble crv4;
//--- create matrix
CMatrixDouble x;
CMatrixDouble temp11;
CMatrixDouble temp22;
CMatrixDouble temp11b;
CMatrixDouble temp21b;
CMatrixDouble temp12b;
CMatrixDouble temp22b;
CMatrixInt ipivot44;
//--- create copy
bool vselect[];
ArrayCopy(vselect,cvselect);
//--- initialization
m=0;
info=0;
//--- allocation
x.Resize(3,3);
temp11.Resize(2,2);
temp11b.Resize(2,2);
temp21b.Resize(3,2);
temp12b.Resize(2,3);
temp22b.Resize(3,3);
temp22.Resize(3,3);
work.Resize(3*n+1);
temp.Resize(n+1);
ArrayResizeAL(rswap4,5);
ArrayResizeAL(zswap4,5);
civ4.Resize(5);
crv4.Resize(5);
ipivot44.Resize(5,5);
//--- check
if(howmny!=1)
{
//--- check
if(side==1 || side==3)
vr.Resize(n+1,n+1);
//--- check
if(side==2 || side==3)
vl.Resize(n+1,n+1);
}
//--- Decode and test the input parameters
bothv=side==3;
rightv=side==1 || bothv;
leftv=side==2 || bothv;
allv=howmny==2;
over=howmny==1;
somev=howmny==3;
info=0;
//--- check
if(n<0)
{
info=-2;
return;
}
//--- check
if(!rightv && !leftv)
{
info=-3;
return;
}
//--- check
if((!allv && !over) && !somev)
{
info=-4;
return;
}
//--- Set M to the number of columns required to store the selected
//--- eigenvectors, standardize the array SELECT if necessary, and
//--- test MM.
if(somev)
{
m=0;
pair=false;
for(j=1; j<=n; j++)
{
//--- check
if(pair)
{
pair=false;
vselect[j]=false;
}
else
{
//--- check
if(j<n)
{
//--- check
if(t.Get(j+1,j)==0.0)
{
//--- check
if(vselect[j])
m=m+1;
}
else
{
pair=true;
//--- check
if(vselect[j] || vselect[j+1])
{
vselect[j]=true;
m=m+2;
}
}
}
else
{
//--- check
if(vselect[n])
m=m+1;
}
}
}
}
else
m=n;
//--- Quick return if possible
if(n==0)
return;
//--- Set the constants to control overflow.
unfl=CMath::m_minrealnumber;
ovfl=1/unfl;
ulp=CMath::m_machineepsilon;
smlnum=unfl*(n/ulp);
bignum=(1-ulp)/smlnum;
//--- Compute 1-norm of each column of strictly upper triangular
//--- part of T to control overflow in triangular solver.
work.Set(1,0);
for(j=2; j<=n; j++)
{
work.Set(j,0);
for(i=1; i<j; i++)
work.Set(j,work[j]+MathAbs(t.Get(i,j)));
}
//--- Index IP is used to specify the real or complex eigenvalue:
//--- IP = 0, real eigenvalue,
//--- 1, first of conjugate complex pair: (wr,wi)
//--- -1, second of conjugate complex pair: (wr,wi)
n2=2*n;
//--- check
if(rightv)
{
//--- Compute right eigenvectors.
ip=0;
iis=m;
for(ki=n; ki>=1; ki--)
{
skipflag=false;
//--- check
if(ip==1)
skipflag=true;
else
{
//--- check
if(ki!=1)
{
//--- check
if(t.Get(ki,ki-1)!=0.0)
ip=-1;
}
//--- check
if(somev)
{
//--- check
if(ip==0)
{
//--- check
if(!vselect[ki])
skipflag=true;
}
else
{
//--- check
if(!vselect[ki-1])
skipflag=true;
}
}
}
//--- check
if(!skipflag)
{
//--- Compute the KI-th eigenvalue (WR,WI).
wr=t.Get(ki,ki);
wi=0;
//--- check
if(ip!=0)
wi=MathSqrt(MathAbs(t.Get(ki,ki-1)))*MathSqrt(MathAbs(t.Get(ki-1,ki)));
smin=MathMax(ulp*(MathAbs(wr)+MathAbs(wi)),smlnum);
//--- check
if(ip==0)
{
//--- Real right eigenvector
work.Set(ki+n,1);
//--- Form right-hand side
for(k=1; k<ki; k++)
work.Set(k+n,-t.Get(k,ki));
//--- Solve the upper quasi-triangular system:
//--- (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
jnxt=ki-1;
for(j=ki-1; j>=1; j--)
{
//--- check
if(j>jnxt)
continue;
j1=j;
j2=j;
jnxt=j-1;
//--- check
if(j>1)
{
//--- check
if(t.Get(j,j-1)!=0.0)
{
j1=j-1;
jnxt=j-2;
}
}
//--- check
if(j1==j2)
{
//--- 1-by-1 diagonal block
temp11.Set(1,1,t.Get(j,j));
temp11b.Set(1,1,work[j+n]);
//--- function call
InternalHsEVDLALN2(false,1,1,smin,1,temp11,1.0,1.0,temp11b,wr,0.0,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale X(1,1) to avoid overflow when updating
//--- the right-hand side.
if(xnorm>1.0)
{
//--- check
if(work[j]>bignum/xnorm)
{
x.Set(1,1,x.Get(1,1)/xnorm);
scl=scl/xnorm;
}
}
//--- Scale if necessary
if(scl!=1.0)
CAblasF::RMulVX(ki,scl,work,n+1);
work.Set(j+n,x.Get(1,1));
//--- Update right-hand side
k1=1+n;
k2=j-1+n;
k3=j-1;
vt=-x.Get(1,1);
i1_=1-k1;
for(i_=k1; i_<=k2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
}
else
{
//--- 2-by-2 diagonal block
temp22.Set(1,1,t.Get(j-1,j-1));
temp22.Set(1,2,t.Get(j-1,j));
temp22.Set(2,1,t.Get(j,j-1));
temp22.Set(2,2,t.Get(j,j));
temp21b.Set(1,1,work[j-1+n]);
temp21b.Set(2,1,work[j+n]);
//--- function call
InternalHsEVDLALN2(false,2,1,smin,1.0,temp22,1.0,1.0,temp21b,wr,0,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale X(1,1) and X(2,1) to avoid overflow when
//--- updating the right-hand side.
if(xnorm>1.0)
{
beta=MathMax(work[j-1],work[j]);
//--- check
if(beta>bignum/xnorm)
{
x.Set(1,1,x.Get(1,1)/xnorm);
x.Set(2,1,x.Get(2,1)/xnorm);
scl=scl/xnorm;
}
}
//--- Scale if necessary
if(scl!=1.0)
CAblasF::RMulVX(ki,scl,work,n+1);
work.Set(j-1+n,x.Get(1,1));
work.Set(j+n,x.Get(2,1));
//--- Update right-hand side
k1=1+n;
k2=j-2+n;
k3=j-2;
k4=j-1;
vt=-x.Get(1,1);
i1_=1-k1;
for(i_=k1; i_<=k2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,k4));
vt=-x.Get(2,1);
for(i_=k1; i_<=k2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
}
}
//--- Copy the vector x or Q*x to VR and normalize.
if(!over)
{
k1=1+n;
k2=ki+n;
i1_=k1-1;
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis,work[i_+i1_]);
//--- function call
ii=CBlas::ColumnIdxAbsMax(vr,1,ki,iis);
remax=1/MathAbs(vr.Get(ii,iis));
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis,remax*vr.Get(i_,iis));
for(k=ki+1; k<=n; k++)
vr.Set(k,iis,0);
}
else
{
//--- check
if(ki>1)
{
temp=vr.Col(ki)+0;
//--- function call
CBlas::MatrixVectorMultiply(vr,1,n,1,ki-1,false,work,1+n,ki-1+n,1.0,temp,1,n,work[ki+n]);
vr.Col(ki,temp.ToVector()+0);
}
//--- function call
ii=CBlas::ColumnIdxAbsMax(vr,1,n,ki);
remax=1/MathAbs(vr.Get(ii,ki));
vr.Col(ki,vr.Col(ki)*remax);
}
}
else
{
//--- Complex right eigenvector.
//--- Initial solve
//--- [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
//--- [ (T(KI,KI-1) T(KI,KI) ) ]
if(MathAbs(t.Get(ki-1,ki))>=MathAbs(t.Get(ki,ki-1)))
{
work.Set(ki-1+n,1);
work.Set(ki+n2,wi/t.Get(ki-1,ki));
}
else
{
work.Set(ki-1+n,-(wi/t.Get(ki,ki-1)));
work.Set(ki+n2,1);
}
work.Set(ki+n,0);
work.Set(ki-1+n2,0);
//--- Form right-hand side
for(k=1; k<=ki-2; k++)
{
work.Set(k+n,-(work[ki-1+n]*t.Get(k,ki-1)));
work.Set(k+n2,-(work[ki+n2]*t.Get(k,ki)));
}
//--- Solve upper quasi-triangular system:
//--- (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
jnxt=ki-2;
for(j=ki-2; j>=1; j--)
{
//--- check
if(j>jnxt)
continue;
j1=j;
j2=j;
jnxt=j-1;
//--- check
if(j>1)
{
//--- check
if(t.Get(j,j-1)!=0.0)
{
j1=j-1;
jnxt=j-2;
}
}
//--- check
if(j1==j2)
{
//--- 1-by-1 diagonal block
temp11.Set(1,1,t.Get(j,j));
temp12b.Set(1,1,work[j+n]);
temp12b.Set(1,2,work[j+n+n]);
//--- function call
InternalHsEVDLALN2(false,1,2,smin,1.0,temp11,1.0,1.0,temp12b,wr,wi,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale X(1,1) and X(1,2) to avoid overflow when
//--- updating the right-hand side.
if(xnorm>1.0)
{
//--- check
if(work[j]>bignum/xnorm)
{
x.Set(1,1,x.Get(1,1)/xnorm);
x.Set(1,2,x.Get(1,2)/xnorm);
scl=scl/xnorm;
}
}
//--- Scale if necessary
if(scl!=1.0)
{
CAblasF::RMulVX(ki,scl,work,n+1);
CAblasF::RMulVX(ki,scl,work,n2+1);
}
work.Set(j+n,x.Get(1,1));
work.Set(j+n2,x.Get(1,2));
//--- Update the right-hand side
k1=1+n;
k2=j-1+n;
k3=1;
k4=j-1;
vt=-x.Get(1,1);
i1_=k3-k1;
for(i_=k1; i_<=k2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
//--- change values
k1=1+n2;
k2=j-1+n2;
k3=1;
k4=j-1;
vt=-x.Get(1,2);
i1_=k3-k1;
for(i_=k1; i_<=k2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
}
else
{
//--- 2-by-2 diagonal block
temp22.Set(1,1,t.Get(j-1,j-1));
temp22.Set(1,2,t.Get(j-1,j));
temp22.Set(2,1,t.Get(j,j-1));
temp22.Set(2,2,t.Get(j,j));
temp22b.Set(1,1,work[j-1+n]);
temp22b.Set(1,2,work[j-1+n+n]);
temp22b.Set(2,1,work[j+n]);
temp22b.Set(2,2,work[j+n+n]);
//--- function call
InternalHsEVDLALN2(false,2,2,smin,1.0,temp22,1.0,1.0,temp22b,wr,wi,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale X to avoid overflow when updating
//--- the right-hand side.
if(xnorm>1.0)
{
beta=MathMax(work[j-1],work[j]);
//--- check
if(beta>bignum/xnorm)
{
rec=1/xnorm;
x.Set(1,1,x.Get(1,1)*rec);
x.Set(1,2,x.Get(1,2)*rec);
x.Set(2,1,x.Get(2,1)*rec);
x.Set(2,2,x.Get(2,2)*rec);
scl=scl*rec;
}
}
//--- Scale if necessary
if(scl!=1.0)
{
CAblasF::RMulVX(ki,scl,work,n+1);
CAblasF::RMulVX(ki,scl,work,n2+1);
}
//--- change values
work.Set(j-1+n,x.Get(1,1));
work.Set(j+n,x.Get(2,1));
work.Set(j-1+n2,x.Get(1,2));
work.Set(j+n2,x.Get(2,2));
//--- Update the right-hand side
vt=-x.Get(1,1);
i1_=-n;
for(i_=n+1; i_<=n+j-2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j-1));
vt=-x.Get(2,1);
i1_=-n;
for(i_=n+1; i_<=n+j-2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
vt=-x.Get(1,2);
i1_=-n2;
for(i_=n2+1; i_<=n2+j-2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j-1));
vt=-x.Get(2,2);
i1_=-n2;
for(i_=n2+1; i_<=n2+j-2; i_++)
work.Set(i_,work[i_]+vt*t.Get(i_+i1_,j));
}
}
//--- Copy the vector x or Q*x to VR and normalize.
if(!over)
{
i1_=n;
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis-1,work[i_+i1_]);
i1_=n2;
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis,work[i_+i1_]);
emax=0;
for(k=1; k<=ki; k++)
emax=MathMax(emax,MathAbs(vr.Get(k,iis-1))+MathAbs(vr.Get(k,iis)));
remax=1/emax;
//--- copy
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis-1,remax*vr.Get(i_,iis-1));
for(i_=1; i_<=ki; i_++)
vr.Set(i_,iis,remax*vr.Get(i_,iis));
for(k=ki+1; k<=n; k++)
{
vr.Set(k,iis-1,0);
vr.Set(k,iis,0);
}
}
else
{
//--- check
if(ki>2)
{
temp=vr.Col(ki-1)+0;
//--- function call
CBlas::MatrixVectorMultiply(vr,1,n,1,ki-2,false,work,1+n,ki-2+n,1.0,temp,1,n,work[ki-1+n]);
vr.Col(ki-1,temp.ToVector()+0);
temp=vr.Col(ki)+0;
//--- function call
CBlas::MatrixVectorMultiply(vr,1,n,1,ki-2,false,work,1+n2,ki-2+n2,1.0,temp,1,n,work[ki+n2]);
vr.Col(ki,temp);
}
else
{
vt=work[ki-1+n];
//--- copy
vr.Col(ki-1,vr.Col(ki-1)*vt);
vt=work[ki+n2];
vr.Col(ki,vr.Col(ki)*vt);
}
emax=0;
for(k=1; k<=n; k++)
emax=MathMax(emax,MathAbs(vr.Get(k,ki-1))+MathAbs(vr.Get(k,ki)));
remax=1/emax;
//--- copy
vr.Col(ki-1,vr.Col(ki-1)*remax);
vr.Col(ki,vr.Col(ki)*remax);
}
}
iis=iis-1;
//--- check
if(ip!=0)
iis=iis-1;
}
//--- check
if(ip==1)
ip=0;
//--- check
if(ip==-1)
ip=1;
}
}
//--- check
if(leftv)
{
//--- Compute left eigenvectors.
ip=0;
iis=1;
for(ki=1; ki<=n; ki++)
{
skipflag=false;
//--- check
if(ip==-1)
skipflag=true;
else
{
//--- check
if(ki!=n)
{
//--- check
if(t.Get(ki+1,ki)!=0.0)
ip=1;
}
//--- check
if(somev)
{
//--- check
if(!vselect[ki])
skipflag=true;
}
}
//--- check
if(!skipflag)
{
//--- Compute the KI-th eigenvalue (WR,WI).
wr=t.Get(ki,ki);
wi=0;
//--- check
if(ip!=0)
wi=MathSqrt(MathAbs(t.Get(ki,ki+1)))*MathSqrt(MathAbs(t.Get(ki+1,ki)));
smin=MathMax(ulp*(MathAbs(wr)+MathAbs(wi)),smlnum);
//--- check
if(ip==0)
{
//--- Real left eigenvector.
work.Set(ki+n,1);
//--- Form right-hand side
for(k=ki+1; k<=n; k++)
work.Set(k+n,-t.Get(ki,k));
//--- Solve the quasi-triangular system:
//--- (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK
vmax=1;
vcrit=bignum;
jnxt=ki+1;
for(j=ki+1; j<=n; j++)
{
//--- check
if(j<jnxt)
continue;
j1=j;
j2=j;
jnxt=j+1;
//--- check
if(j<n)
{
//--- check
if(t.Get(j+1,j)!=0.0)
{
j2=j+1;
jnxt=j+2;
}
}
//--- check
if(j1==j2)
{
//--- 1-by-1 diagonal block
//--- Scale if necessary to avoid overflow when forming
//--- the right-hand side.
if(work[j]>vcrit)
{
rec=1/vmax;
for(i_=ki+n; i_<=n+n; i_++)
work.Set(i_,rec*work[i_]);
vmax=1;
vcrit=bignum;
}
i1_=n;
vt=0.0;
for(i_=ki+1; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
work.Set(j+n,work[j+n]-vt);
//--- Solve (T(J,J)-WR)'*X = WORK
temp11.Set(1,1,t.Get(j,j));
temp11b.Set(1,1,work[j+n]);
InternalHsEVDLALN2(false,1,1,smin,1.0,temp11,1.0,1.0,temp11b,wr,0,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale if necessary
if(scl!=1.0)
CAblasF::RMulVX(n-ki+1,scl,work,n+ki);
work.Set(j+n,x.Get(1,1));
vmax=MathMax(MathAbs(work[j+n]),vmax);
vcrit=bignum/vmax;
}
else
{
//--- 2-by-2 diagonal block
//--- Scale if necessary to avoid overflow when forming
//--- the right-hand side.
beta=MathMax(work[j],work[j+1]);
//--- check
if(beta>vcrit)
{
rec=1/vmax;
CAblasF::RMulVX(n-ki+1,rec,work,n+ki);
vmax=1;
vcrit=bignum;
}
i1_=n;
vt=0.0;
for(i_=ki+1; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
//--- change values
work.Set(j+n,work[j+n]-vt);
i1_=n;
vt=0.0;
for(i_=ki+1; i_<j; i_++)
vt+=t.Get(i_,j+1)*work[i_+i1_];
work.Set(j+1+n,work[j+1+n]-vt);
//--- Solve
//--- [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 )
//--- [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
temp22.Set(1,1,t.Get(j,j));
temp22.Set(1,2,t.Get(j,j+1));
temp22.Set(2,1,t.Get(j+1,j));
temp22.Set(2,2,t.Get(j+1,j+1));
temp21b.Set(1,1,work[j+n]);
temp21b.Set(2,1,work[j+1+n]);
//--- function call
InternalHsEVDLALN2(true,2,1,smin,1.0,temp22,1.0,1.0,temp21b,wr,0,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale if necessary
if(scl!=1.0)
CAblasF::RMulVX(n-ki+1,scl,work,n+ki);
//--- change values
work.Set(j+n,x.Get(1,1));
work.Set(j+1+n,x.Get(2,1));
vmax=MathMax(MathAbs(work[j+n]),MathMax(MathAbs(work[j+1+n]),vmax));
vcrit=bignum/vmax;
}
}
//--- Copy the vector x or Q*x to VL and normalize.
if(!over)
{
i1_=n;;
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis,work[i_+i1_]);
//--- function call
ii=CBlas::ColumnIdxAbsMax(vl,ki,n,iis);
remax=1/MathAbs(vl.Get(ii,iis));
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis,remax*vl.Get(i_,iis));
for(k=1; k<=ki-1; k++)
vl.Set(k,iis,0);
}
else
{
//--- check
if(ki<n)
{
for(i_=1; i_<=n; i_++)
temp.Set(i_,vl.Get(i_,ki));
//--- function call
CBlas::MatrixVectorMultiply(vl,1,n,ki+1,n,false,work,ki+1+n,n+n,1.0,temp,1,n,work[ki+n]);
for(i_=1; i_<=n; i_++)
vl.Set(i_,ki,temp[i_]);
}
//--- function call
ii=CBlas::ColumnIdxAbsMax(vl,1,n,ki);
remax=1/MathAbs(vl.Get(ii,ki));
vl.Col(ki,vl.Col(ki)*remax);
}
}
else
{
//--- Complex left eigenvector.
//--- Initial solve:
//--- ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X = 0.
//--- ((T(KI+1,KI) T(KI+1,KI+1)) )
if(MathAbs(t.Get(ki,ki+1))>=MathAbs(t.Get(ki+1,ki)))
{
work.Set(ki+n,wi/t.Get(ki,ki+1));
work.Set(ki+1+n2,1);
}
else
{
work.Set(ki+n,1);
work.Set(ki+1+n2,-(wi/t.Get(ki+1,ki)));
}
work.Set(ki+1+n,0);
work.Set(ki+n2,0);
//--- Form right-hand side
for(k=ki+2; k<=n; k++)
{
work.Set(k+n,-(work[ki+n]*t.Get(ki,k)));
work.Set(k+n2,-(work[ki+1+n2]*t.Get(ki+1,k)));
}
//--- Solve complex quasi-triangular system:
//--- ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
vmax=1;
vcrit=bignum;
jnxt=ki+2;
for(j=ki+2; j<=n; j++)
{
//--- check
if(j<jnxt)
continue;
j1=j;
j2=j;
jnxt=j+1;
//--- check
if(j<n)
{
//--- check
if(t.Get(j+1,j)!=0.0)
{
j2=j+1;
jnxt=j+2;
}
}
//--- check
if(j1==j2)
{
//--- 1-by-1 diagonal block
//--- Scale if necessary to avoid overflow when
//--- forming the right-hand side elements.
if(work[j]>vcrit)
{
rec=1/vmax;
CAblasF::RMulVX(n-ki+1,rec,work,n+ki);
CAblasF::RMulVX(n-ki+1,rec,work,n2+ki);
vmax=1;
vcrit=bignum;
}
i1_=n;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
//--- calculation
work.Set(j+n,work[j+n]-vt);
i1_=n2;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
work.Set(j+n2,work[j+n2]-vt);
//--- Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
temp11.Set(1,1,t.Get(j,j));
temp12b.Set(1,1,work[j+n]);
temp12b.Set(1,2,work[j+n+n]);
//--- function call
InternalHsEVDLALN2(false,1,2,smin,1.0,temp11,1.0,1.0,temp12b,wr,-wi,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale if necessary
if(scl!=1.0)
{
CAblasF::RMulVX(n-ki+1,scl,work,n+ki);
CAblasF::RMulVX(n-ki+1,scl,work,n2+ki);
}
//--- change values
work.Set(j+n,x.Get(1,1));
work.Set(j+n2,x.Get(1,2));
vmax=MathMax(MathAbs(work[j+n]),MathMax(MathAbs(work[j+n2]),vmax));
vcrit=bignum/vmax;
}
else
{
//--- 2-by-2 diagonal block
//--- Scale if necessary to avoid overflow when forming
//--- the right-hand side elements.
beta=MathMax(work[j],work[j+1]);
//--- check
if(beta>vcrit)
{
rec=1/vmax;
CAblasF::RMulVX(n-ki+1,rec,work,n+ki);
CAblasF::RMulVX(n-ki+1,rec,work,n2+1);
vmax=1;
vcrit=bignum;
}
i1_=n;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
//--- calculation
work.Set(j+n,work[j+n]-vt);
i1_=n2;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j)*work[i_+i1_];
//--- calculation
work.Set(j+n2,work[j+n2]-vt);
i1_=n;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j+1)*work[i_+i1_];
//--- calculation
work.Set(j+1+n,work[j+1+n]-vt);
i1_=n2;
vt=0.0;
for(i_=ki+2; i_<j; i_++)
vt+=t.Get(i_,j+1)*work[i_+i1_];
work.Set(j+1+n2,work[j+1+n2]-vt);
//--- Solve 2-by-2 complex linear equation
//--- ([T(j,j) T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B
//--- ([T(j+1,j) T(j+1,j+1)] )
temp22.Set(1,1,t.Get(j,j));
temp22.Set(1,2,t.Get(j,j+1));
temp22.Set(2,1,t.Get(j+1,j));
temp22.Set(2,2,t.Get(j+1,j+1));
temp22b.Set(1,1,work[j+n]);
temp22b.Set(1,2,work[j+n+n]);
temp22b.Set(2,1,work[j+1+n]);
temp22b.Set(2,2,work[j+1+n+n]);
//--- function call
InternalHsEVDLALN2(true,2,2,smin,1.0,temp22,1.0,1.0,temp22b,wr,-wi,rswap4,zswap4,ipivot44,civ4,crv4,x,scl,xnorm,ierr);
//--- Scale if necessary
if(scl!=1.0)
{
CAblasF::RMulVX(n-ki+1,scl,work,n+ki);
CAblasF::RMulVX(n-ki+1,scl,work,n2+ki);
}
//--- change values
work.Set(j+n,x.Get(1,1));
work.Set(j+n2,x.Get(1,2));
work.Set(j+1+n,x.Get(2,1));
work.Set(j+1+n2,x.Get(2,2));
vmax=MathMax(MathAbs(x.Get(1,1)),vmax);
vmax=MathMax(MathAbs(x.Get(1,2)),vmax);
vmax=MathMax(MathAbs(x.Get(2,1)),vmax);
vmax=MathMax(MathAbs(x.Get(2,2)),vmax);
vcrit=bignum/vmax;
}
}
//--- Copy the vector x or Q*x to VL and normalize.
if(!over)
{
i1_=n;
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis,work[i_+i1_]);
i1_=n2;
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis+1,work[i_+i1_]);
emax=0;
for(k=ki; k<=n; k++)
emax=MathMax(emax,MathAbs(vl.Get(k,iis))+MathAbs(vl.Get(k,iis+1)));
remax=1/emax;
//--- copy
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis,remax*vl.Get(i_,iis));
for(i_=ki; i_<=n; i_++)
vl.Set(i_,iis+1,remax*vl.Get(i_,iis+1));
for(k=1; k<=ki-1; k++)
{
vl.Set(k,iis,0);
vl.Set(k,iis+1,0);
}
}
else
{
//--- check
if(ki<n-1)
{
temp=vl.Col(ki)+0;
//--- function call
CBlas::MatrixVectorMultiply(vl,1,n,ki+2,n,false,work,ki+2+n,n+n,1.0,temp,1,n,work[ki+n]);
vl.Col(ki,temp);
temp=vl.Col(ki+1)+0;
//--- function call
CBlas::MatrixVectorMultiply(vl,1,n,ki+2,n,false,work,ki+2+n2,n+n2,1.0,temp,1,n,work[ki+1+n2]);
vl.Col(ki+1,temp);
}
else
{
//--- copy
vt=work[ki+n];
vl.Col(ki,vl.Col(ki)*vt);
vt=work[ki+1+n2];
vl.Col(ki+1,vl.Col(ki+1)*vt);
}
emax=0;
for(k=1; k<=n; k++)
emax=MathMax(emax,MathAbs(vl.Get(k,ki))+MathAbs(vl.Get(k,ki+1)));
remax=1/emax;
//--- copy
vl.Col(ki,vl.Col(ki)*remax);
vl.Col(ki+1,vl.Col(ki+1)*remax);
}
}
iis=iis+1;
//--- check
if(ip!=0)
iis=iis+1;
}
//--- check
if(ip==-1)
ip=0;
//--- check
if(ip==1)
ip=-1;
}
}
}
//+------------------------------------------------------------------+
//| DLALN2 solves a system of the form (ca A - w D ) X = s B |
//| or (ca A'-w D) X=s B with possible scaling ("s") and |
//| perturbation of A. (A' means A-transpose.) |
//| A is an NA x NA real matrix, ca is a real scalar, D is an NA x |
//| NA real diagonal matrix, w is a real or complex value, and X and |
//| B are NA x 1 matrices -- real if w is real, complex if w is |
//| complex. NA may be 1 or 2. |
//| If w is complex, X and B are represented as NA x 2 matrices, |
//| the first column of each being the real part and the second |
//| being the imaginary part. |
//| "s" is a scaling factor (.LE. 1), computed by DLALN2, which is |
//| so chosen that X can be computed without overflow. X is further |
//| scaled if necessary to assure that norm(ca A - w D)*norm(X) is |
//| less than overflow. |
//| If both singular values of (ca A - w D) are less than SMIN, |
//| SMIN*identity will be used instead of (ca A - w D). If only one |
//| singular value is less than SMIN, one element of (ca A - w D) |
//| will be perturbed enough to make the smallest singular value |
//| roughly SMIN. If both singular values are at least SMIN, |
//| (ca A - w D) will not be perturbed. In any case, the |
//| perturbation will be at most some small multiple of max( SMIN, |
//| ulp*norm(ca A - w D) ). The singular values are computed by |
//| infinity-norm approximations, and thus will only be correct to a |
//| factor of 2 or so. |
//| Note: all input quantities are assumed to be smaller than |
//| overflow by a reasonable factor. (See BIGNUM.) |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void CEigenVDetect::InternalHsEVDLALN2(const bool ltrans,const int na,
const int nw,const double smin,
const double ca,CMatrixDouble &a,
const double d1,const double d2,
CMatrixDouble &b,const double wr,
const double wi,bool &rswap4[],
bool &zswap4[],CMatrixInt &ipivot44,
CRowDouble &civ4,CRowDouble &crv4,
CMatrixDouble &x,double &scl,
double &xnorm,int &info)
{
//--- create variables
int icmax=0;
int j=0;
double bbnd=0;
double bi1=0;
double bi2=0;
double bignum=0;
double bnorm=0;
double br1=0;
double br2=0;
double ci21=0;
double ci22=0;
double cmax=0;
double cnorm=0;
double cr21=0;
double cr22=0;
double csi=0;
double csr=0;
double li21=0;
double lr21=0;
double smini=0;
double smlnum=0;
double temp=0;
double u22abs=0;
double ui11=0;
double ui11r=0;
double ui12=0;
double ui12s=0;
double ui22=0;
double ur11=0;
double ur11r=0;
double ur12=0;
double ur12s=0;
double ur22=0;
double xi1=0;
double xi2=0;
double xr1=0;
double xr2=0;
double tmp1=0;
double tmp2=0;
//--- initialization
scl=0;
xnorm=0;
info=0;
zswap4[1]=false;
zswap4[2]=false;
zswap4[3]=true;
zswap4[4]=true;
rswap4[1]=false;
rswap4[2]=true;
rswap4[3]=false;
rswap4[4]=true;
ipivot44.Set(1,1,1);
ipivot44.Set(2,1,2);
ipivot44.Set(3,1,3);
ipivot44.Set(4,1,4);
ipivot44.Set(1,2,2);
ipivot44.Set(2,2,1);
ipivot44.Set(3,2,4);
ipivot44.Set(4,2,3);
ipivot44.Set(1,3,3);
ipivot44.Set(2,3,4);
ipivot44.Set(3,3,1);
ipivot44.Set(4,3,2);
ipivot44.Set(1,4,4);
ipivot44.Set(2,4,3);
ipivot44.Set(3,4,2);
ipivot44.Set(4,4,1);
smlnum=2*CMath::m_minrealnumber;
bignum=1/smlnum;
smini=MathMax(smin,smlnum);
//--- initialization
info=0;
scl=1;
//--- check
if(na==1)
{
//--- 1 x 1 (i.e., scalar) system C X = B
if(nw==1)
{
//--- Real 1x1 system.
//--- C = ca A - w D
csr=ca*a.Get(1,1)-wr*d1;
cnorm=MathAbs(csr);
//--- If | C | < SMINI, use C = SMINI
if(cnorm<smini)
{
csr=smini;
cnorm=smini;
info=1;
}
//--- Check scaling for X = B / C
bnorm=MathAbs(b.Get(1,1));
//--- check
if(cnorm<1.0 && bnorm>1.0)
{
//--- check
if(bnorm>bignum*cnorm)
scl=1/bnorm;
}
//--- Compute X
x.Set(1,1,b.Get(1,1)*scl/csr);
xnorm=MathAbs(x.Get(1,1));
}
else
{
//--- Complex 1x1 system (w is complex)
//--- C = ca A - w D
csr=ca*a.Get(1,1)-wr*d1;
csi=-(wi*d1);
cnorm=MathAbs(csr)+MathAbs(csi);
//--- If | C | < SMINI, use C = SMINI
if(cnorm<smini)
{
csr=smini;
csi=0;
cnorm=smini;
info=1;
}
//--- Check scaling for X = B / C
bnorm=MathAbs(b.Get(1,1))+MathAbs(b.Get(1,2));
//--- check
if(cnorm<1.0 && bnorm>1.0)
{
//--- check
if(bnorm>bignum*cnorm)
scl=1/bnorm;
}
//--- Compute X
InternalHsEVDLADIV(scl*b.Get(1,1),scl*b.Get(1,2),csr,csi,tmp1,tmp2);
x.Set(1,1,tmp1);
x.Set(1,2,tmp2);
xnorm=MathAbs(x.Get(1,1))+MathAbs(x.Get(1,2));
}
}
else
{
//--- 2x2 System
//--- Compute the real part of C = ca A - w D (or ca A' - w D )
crv4.Set(1,ca*a.Get(1,1)-wr*d1);
crv4.Set(2+2,ca*a.Get(2,2)-wr*d2);
//--- check
if(ltrans)
{
crv4.Set(1+2,ca*a.Get(2,1));
crv4.Set(2,ca*a.Get(1,2));
}
else
{
crv4.Set(2,ca*a.Get(2,1));
crv4.Set(1+2,ca*a.Get(1,2));
}
//--- check
if(nw==1)
{
//--- Real 2x2 system (w is real)
//--- Find the largest element in C
cmax=0;
icmax=0;
for(j=1; j<=4; j++)
{
//--- check
if(MathAbs(crv4[j])>cmax)
{
cmax=MathAbs(crv4[j]);
icmax=j;
}
}
//--- If norm(C) < SMINI, use SMINI*identity.
if(cmax<smini)
{
bnorm=MathMax(MathAbs(b.Get(1,1)),MathAbs(b.Get(2,1)));
//--- check
if(smini<1.0 && bnorm>1.0)
{
//--- check
if(bnorm>bignum*smini)
scl=1/bnorm;
}
//--- change values
temp=scl/smini;
x.Set(1,1,temp*b.Get(1,1));
x.Set(2,1,temp*b.Get(2,1));
xnorm=temp*bnorm;
info=1;
//--- exit the function
return;
}
//--- Gaussian elimination with complete pivoting.
ur11=crv4[icmax];
cr21=crv4[ipivot44.Get(2,icmax)];
ur12=crv4[ipivot44.Get(3,icmax)];
cr22=crv4[ipivot44.Get(4,icmax)];
ur11r=1/ur11;
lr21=ur11r*cr21;
ur22=cr22-ur12*lr21;
//--- If smaller pivot < SMINI, use SMINI
if(MathAbs(ur22)<smini)
{
ur22=smini;
info=1;
}
//--- check
if(rswap4[icmax])
{
br1=b.Get(2,1);
br2=b.Get(1,1);
}
else
{
br1=b.Get(1,1);
br2=b.Get(2,1);
}
br2=br2-lr21*br1;
bbnd=MathMax(MathAbs(br1*(ur22*ur11r)),MathAbs(br2));
//--- check
if(bbnd>1.0 && MathAbs(ur22)<1.0)
{
//--- check
if(bbnd>=bignum*MathAbs(ur22))
scl=1/bbnd;
}
xr2=br2*scl/ur22;
xr1=scl*br1*ur11r-xr2*(ur11r*ur12);
//--- check
if(zswap4[icmax])
{
x.Set(1,1,xr2);
x.Set(2,1,xr1);
}
else
{
x.Set(1,1,xr1);
x.Set(2,1,xr2);
}
xnorm=MathMax(MathAbs(xr1),MathAbs(xr2));
//--- Further scaling if norm(A) norm(X) > overflow
if(xnorm>1.0 && cmax>1.0)
{
//--- check
if(xnorm>bignum/cmax)
{
temp=cmax/bignum;
x.Set(1,1,temp*x.Get(1,1));
x.Set(2,1,temp*x.Get(2,1));
xnorm=temp*xnorm;
scl=temp*scl;
}
}
}
else
{
//--- Complex 2x2 system (w is complex)
//--- Find the largest element in C
civ4.Set(1,-(wi*d1));
civ4.Set(2,0);
civ4.Set(1+2,0);
civ4.Set(2+2,-(wi*d2));
cmax=0;
icmax=0;
for(j=1; j<=4; j++)
{
//--- check
if(MathAbs(crv4[j])+MathAbs(civ4[j])>cmax)
{
cmax=MathAbs(crv4[j])+MathAbs(civ4[j]);
icmax=j;
}
}
//--- If norm(C) < SMINI, use SMINI*identity.
if(cmax<smini)
{
bnorm=MathMax(MathAbs(b.Get(1,1))+MathAbs(b.Get(1,2)),MathAbs(b.Get(2,1))+MathAbs(b.Get(2,2)));
//--- check
if(smini<1.0 && bnorm>1.0)
{
//--- check
if(bnorm>bignum*smini)
scl=1/bnorm;
}
//--- change values
temp=scl/smini;
x.Set(1,1,temp*b.Get(1,1));
x.Set(2,1,temp*b.Get(2,1));
x.Set(1,2,temp*b.Get(1,2));
x.Set(2,2,temp*b.Get(2,2));
xnorm=temp*bnorm;
info=1;
//--- exit the function
return;
}
//--- Gaussian elimination with complete pivoting.
ur11=crv4[icmax];
ui11=civ4[icmax];
cr21=crv4[ipivot44.Get(2,icmax)];
ci21=civ4[ipivot44.Get(2,icmax)];
ur12=crv4[ipivot44.Get(3,icmax)];
ui12=civ4[ipivot44.Get(3,icmax)];
cr22=crv4[ipivot44.Get(4,icmax)];
ci22=civ4[ipivot44.Get(4,icmax)];
//--- check
if(icmax==1 || icmax==4)
{
//--- Code when off-diagonals of pivoted C are real
if(MathAbs(ur11)>MathAbs(ui11))
{
temp=ui11/ur11;
ur11r=1/(ur11*(1+CMath::Sqr(temp)));
ui11r=-(temp*ur11r);
}
else
{
temp=ur11/ui11;
ui11r=-(1/(ui11*(1+CMath::Sqr(temp))));
ur11r=-(temp*ui11r);
}
//--- change values
lr21=cr21*ur11r;
li21=cr21*ui11r;
ur12s=ur12*ur11r;
ui12s=ur12*ui11r;
ur22=cr22-ur12*lr21;
ui22=ci22-ur12*li21;
}
else
{
//--- Code when diagonals of pivoted C are real
ur11r=1/ur11;
ui11r=0;
lr21=cr21*ur11r;
li21=ci21*ur11r;
ur12s=ur12*ur11r;
ui12s=ui12*ur11r;
ur22=cr22-ur12*lr21+ui12*li21;
ui22=-(ur12*li21)-ui12*lr21;
}
u22abs=MathAbs(ur22)+MathAbs(ui22);
//--- If smaller pivot < SMINI, use SMINI
if(u22abs<smini)
{
ur22=smini;
ui22=0;
info=1;
}
//--- check
if(rswap4[icmax])
{
br2=b.Get(1,1);
br1=b.Get(2,1);
bi2=b.Get(1,2);
bi1=b.Get(2,2);
}
else
{
br1=b.Get(1,1);
br2=b.Get(2,1);
bi1=b.Get(1,2);
bi2=b.Get(2,2);
}
br2=br2-lr21*br1+li21*bi1;
bi2=bi2-li21*br1-lr21*bi1;
bbnd=MathMax((MathAbs(br1)+MathAbs(bi1))*(u22abs*(MathAbs(ur11r)+MathAbs(ui11r))),MathAbs(br2)+MathAbs(bi2));
//--- check
if(bbnd>1.0 && u22abs<1.0)
{
//--- check
if(bbnd>=bignum*u22abs)
{
//--- change values
scl=1/bbnd;
br1=scl*br1;
bi1=scl*bi1;
br2=scl*br2;
bi2=scl*bi2;
}
}
//--- function call
InternalHsEVDLADIV(br2,bi2,ur22,ui22,xr2,xi2);
xr1=ur11r*br1-ui11r*bi1-ur12s*xr2+ui12s*xi2;
xi1=ui11r*br1+ur11r*bi1-ui12s*xr2-ur12s*xi2;
//--- check
if(zswap4[icmax])
{
x.Set(1,1,xr2);
x.Set(2,1,xr1);
x.Set(1,2,xi2);
x.Set(2,2,xi1);
}
else
{
x.Set(1,1,xr1);
x.Set(2,1,xr2);
x.Set(1,2,xi1);
x.Set(2,2,xi2);
}
xnorm=MathMax(MathAbs(xr1)+MathAbs(xi1),MathAbs(xr2)+MathAbs(xi2));
//--- Further scaling if norm(A) norm(X) > overflow
if(xnorm>1.0 && cmax>1.0)
{
//--- check
if(xnorm>bignum/cmax)
{
//--- change values
temp=cmax/bignum;
x.Set(1,1,temp*x.Get(1,1));
x.Set(2,1,temp*x.Get(2,1));
x.Set(1,2,temp*x.Get(1,2));
x.Set(2,2,temp*x.Get(2,2));
xnorm=temp*xnorm;
scl=temp*scl;
}
}
}
}
}
//+------------------------------------------------------------------+
//| performs complex division in real arithmetic |
//| a + i*b |
//| p + i*q = --------- |
//| c + i*d |
//| The algorithm is due to Robert L. Smith and can be found |
//| in D. Knuth, The art of Computer Programming, Vol.2, p.195 |
//| -- LAPACK auxiliary routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1992 |
//+------------------------------------------------------------------+
void CEigenVDetect::InternalHsEVDLADIV(const double a,const double b,
const double c,const double d,
double &p,double &q)
{
//--- create variables
double e=0;
double f=0;
//--- initialization
p=0;
q=0;
//--- check
if(MathAbs(d)<MathAbs(c))
{
//--- get result
e=d/c;
f=c+d*e;
p=(a+b*e)/f;
q=(b-a*e)/f;
}
else
{
//--- get result
e=c/d;
f=d+c*e;
p=(b+a*e)/f;
q=(-a+b*e)/f;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
bool CEigenVDetect::NonSymmetricEVD(CMatrixDouble &ca,const int n,
const int vneeded,CRowDouble &wr,
CRowDouble &wi,CMatrixDouble &vl,
CMatrixDouble &vr)
{
//--- create variables
bool result;
int i=0;
int info=0;
int m=0;
int i_=0;
//--- create arrays
CRowDouble tau;
bool sel[];
//--- create matrix
CMatrixDouble s;
//--- create copy
CMatrixDouble a;
a=ca;
//--- check
if(!CAp::Assert(vneeded>=0 && vneeded<=3,__FUNCTION__+": incorrect VNeeded!"))
return(false);
//--- check
if(vneeded==0)
{
//--- Eigen values only
ToUpperHessenberg(a,n,tau);
//--- function call
CHsSchur::InternalSchurDecomposition(a,n,0,0,wr,wi,s,info);
//--- get result
result=info==0;
//--- return result
return(result);
}
//--- Eigen values and vectors
ToUpperHessenberg(a,n,tau);
//--- function call
UnpackQFromUpperHessenberg(a,n,tau,s);
//--- function call
CHsSchur::InternalSchurDecomposition(a,n,1,1,wr,wi,s,info);
//--- get result
result=info==0;
//--- check
if(!result)
return(result);
//--- check
if(vneeded==1 || vneeded==3)
{
vr.Resize(n+1,n+1);
for(i=1; i<=n; i++)
{
for(i_=1; i_<=n; i_++)
vr.Set(i,i_,s.Get(i,i_));
}
}
//--- check
if(vneeded==2 || vneeded==3)
{
vl.Resize(n+1,n+1);
for(i=1; i<=n; i++)
{
for(i_=1; i_<=n; i_++)
vl.Set(i,i_,s.Get(i,i_));
}
}
//--- function call
InternalTREVC(a,n,vneeded,1,sel,vl,vr,m,info);
//--- get result
result=info==0;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Upper Hessenberg form |
//+------------------------------------------------------------------+
void CEigenVDetect::ToUpperHessenberg(CMatrixDouble &a,const int n,CRowDouble &tau)
{
//--- create variables
int i=0;
int ip1=0;
int nmi=0;
double v=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble t;
CRowDouble work;
//--- check
if(!CAp::Assert(n>=0,__FUNCTION__+": incorrect N!"))
return;
//--- check
if(n<=1)
return;
//--- allocation
tau.Resize(n);
t.Resize(n+1);
work.Resize(n+1);
//--- calculations
for(i=1; i<n; i++)
{
//--- Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
ip1=i+1;
nmi=n-i;
i1_=ip1-1;
for(i_=1; i_<=nmi; i_++)
t.Set(i_,a.Get(i_+i1_,i));
//--- function call
CReflections::GenerateReflection(t,nmi,v);
i1_=1-ip1;
for(i_=ip1; i_<=n; i_++)
a.Set(i_,i,t[i_+i1_]);
tau.Set(i,v);
t.Set(1,1);
//--- Apply H(i) to A(1:ihi,i+1:ihi) from the right
CReflections::ApplyReflectionFromTheRight(a,v,t,1,n,i+1,n,work);
//--- Apply H(i) to A(i+1:ihi,i+1:n) from the left
CReflections::ApplyReflectionFromTheLeft(a,v,t,i+1,n,i+1,n,work);
}
}
//+------------------------------------------------------------------+
//| Unpack Q from the matrix of the upper Hessenberg form |
//+------------------------------------------------------------------+
void CEigenVDetect::UnpackQFromUpperHessenberg(CMatrixDouble &a,const int n,
CRowDouble &tau,CMatrixDouble &q)
{
//--- create variables
int i=0;
int j=0;
int ip1=0;
int nmi=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble v;
CRowDouble work;
//--- check
if(n==0)
return;
//--- allocation
q=matrix<double>::Identity(n+1,n+1);
v.Resize(n+1);
work.Resize(n+1);
//--- unpack Q
for(i=1; i<n; i++)
{
//--- Apply H(i)
ip1=i+1;
nmi=n-i;
i1_=ip1-1;
for(i_=1; i_<=nmi; i_++)
v.Set(i_,a.Get(i_+i1_,i));
v.Set(1,1);
//--- function call
CReflections::ApplyReflectionFromTheRight(q,tau[i],v,1,n,i+1,n,work);
}
}
//+------------------------------------------------------------------+
//| Random matrix generation |
//+------------------------------------------------------------------+
class CMatGen
{
public:
static void RMatrixRndOrthogonal(const int n,CMatrixDouble &a);
static void RMatrixRndCond(const int n,const double c,CMatrixDouble &a);
static void CMatrixRndOrthogonal(const int n,CMatrixComplex &a);
static void CMatrixRndCond(const int n,const double c,CMatrixComplex &a);
static void SMatrixRndCond(const int n,const double c,CMatrixDouble &a);
static void SPDMatrixRndCond(const int n,const double c,CMatrixDouble &a);
static void HMatrixRndCond(const int n,const double c,CMatrixComplex &a);
static void HPDMatrixRndCond(const int n,const double c,CMatrixComplex &a);
static void RMatrixRndOrthogonalFromTheRight(CMatrixDouble &a,const int m,const int n);
static void RMatrixRndOrthogonalFromTheLeft(CMatrixDouble &a,const int m,const int n);
static void CMatrixRndOrthogonalFromTheRight(CMatrixComplex &a,const int m,const int n);
static void CMatrixRndOrthogonalFromTheLeft(CMatrixComplex &a,const int m,const int n);
static void SMatrixRndMultiply(CMatrixDouble &a,const int n);
static void HMatrixRndMultiply(CMatrixComplex &a,const int n);
};
//+------------------------------------------------------------------+
//| Generation of a random uniformly distributed (Haar) orthogonal |
//| matrix |
//| INPUT PARAMETERS: |
//| N - matrix size, N>=1 |
//| OUTPUT PARAMETERS: |
//| A - orthogonal NxN matrix, array[0..N-1,0..N-1] |
//+------------------------------------------------------------------+
void CMatGen::RMatrixRndOrthogonal(const int n,CMatrixDouble &a)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return;
//--- allocation
a=matrix<double>::Identity(n,n);
//--- get result
RMatrixRndOrthogonalFromTheRight(a,n,n);
}
//+------------------------------------------------------------------+
//| Generation of random NxN matrix with given condition number and |
//| norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::RMatrixRndCond(const int n,const double c,CMatrixDouble &a)
{
//--- create variables
int i=0;
int j=0;
double l1=0;
double l2=0;
//--- check
if(!CAp::Assert(n>=1 && c>=1.0,__FUNCTION__+": N<1 or C<1!"))
return;
//--- allocation
a.Resize(n,n);
//--- check
if(n==1)
{
a.Set(0,0,2*CMath::RandomInteger(2)-1);
//--- exit the function
return;
}
//--- initialization
l1=0;
l2=MathLog(1/c);
for(i=0; i<n; i++)
{
for(j=0; j<n; j++)
a.Set(i,j,0);
}
//--- change a
a.Set(0,0,MathExp(l1));
for(i=1; i<n-1; i++)
a.Set(i,i,MathExp(CMath::RandomReal()*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- function call
RMatrixRndOrthogonalFromTheLeft(a,n,n);
//--- function call
RMatrixRndOrthogonalFromTheRight(a,n,n);
}
//+------------------------------------------------------------------+
//| Generation of a random Haar distributed orthogonal complex matrix|
//| INPUT PARAMETERS: |
//| N - matrix size, N>=1 |
//| OUTPUT PARAMETERS: |
//| A - orthogonal NxN matrix, array[0..N-1,0..N-1] |
//+------------------------------------------------------------------+
void CMatGen::CMatrixRndOrthogonal(const int n,CMatrixComplex &a)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return;
//--- allocation
a=matrix<complex>::Identity(n,n);
//--- get result
CMatrixRndOrthogonalFromTheRight(a,n,n);
}
//+------------------------------------------------------------------+
//| Generation of random NxN complex matrix with given condition |
//| number C and norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::CMatrixRndCond(const int n,const double c,CMatrixComplex &a)
{
//--- create variables
double l1=0;
double l2=0;
complex v=0;
//--- object of class
CHighQualityRandState state;
//--- check
if(!CAp::Assert(n>=1 && c>=1.0,__FUNCTION__+": N<1 or C<1!"))
return;
//--- allocation
a=matrix<complex>::Zeros(n,n);
//--- function call
CHighQualityRand::HQRndRandomize(state);
//--- check
if(n==1)
{
//--- function call
CHighQualityRand::HQRndUnit2(state,v.real,v.imag);
a.Set(0,0,v);
return;
}
//--- initialization
l1=0;
l2=MathLog(1/c);
//--- change values
a.Set(0,0,MathExp(l1));
for(int i=1; i<=n-2; i++)
a.Set(i,i,MathExp(CMath::RandomReal()*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- function call
CMatrixRndOrthogonalFromTheLeft(a,n,n);
//--- function call
CMatrixRndOrthogonalFromTheRight(a,n,n);
}
//+------------------------------------------------------------------+
//| Generation of random NxN symmetric matrix with given condition |
//| number and norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::SMatrixRndCond(const int n,const double c,CMatrixDouble &a)
{
//--- check
if(!CAp::Assert(n>=1 && c>=1.0,__FUNCTION__+": N<1 or C<1!"))
return;
//--- object of class
CHighQualityRandState state;
//--- allocation
a=matrix<double>::Zeros(n,n);
//--- check
if(n==1)
{
a.Set(0,0,2*CMath::RandomInteger(2)-1);
return;
}
//--- Prepare matrix
double l1=0;
double l2=MathLog(1/c);
//--- initialization
a.Set(0,0,MathExp(l1));
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(int i=1; i<=n-2; i++)
a.Set(i,i,(2*CHighQualityRand::HQRndUniformI(state,2)-1)*MathExp(CHighQualityRand::HQRndUniformR(state)*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- Multiply
SMatrixRndMultiply(a,n);
}
//+------------------------------------------------------------------+
//| Generation of random NxN symmetric positive definite matrix with |
//| given condition number and norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random SPD matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::SPDMatrixRndCond(const int n,const double c,CMatrixDouble &a)
{
//--- check
if(n<=0 || c<1.0)
return;
//--- allocation
a=matrix<double>::Zeros(n,n);
//--- check
if(n==1)
{
a.Set(0,0,1);
return;
}
//--- Prepare matrix
double l1=0;
double l2=MathLog(1/c);
//--- initialization
//--- object of class
CHighQualityRandState state;
//--- function call
CHighQualityRand::HQRndRandomize(state);
a.Set(0,0,MathExp(l1));
for(int i=1; i<=n-2; i++)
a.Set(i,i,MathExp(CHighQualityRand::HQRndUniformR(state)*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- Multiply
SMatrixRndMultiply(a,n);
}
//+------------------------------------------------------------------+
//| Generation of random NxN Hermitian matrix with given condition |
//| number and norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::HMatrixRndCond(const int n,const double c,CMatrixComplex &a)
{
//--- check
if(!CAp::Assert(n>=1 && c>=1.0,__FUNCTION__+": N<1 or C<1!"))
return;
//--- allocation
a=matrix<complex>::Zeros(n,n);
//--- check
if(n==1)
{
a.Set(0,0,2.0*CMath::RandomInteger(2)-1.0);
return;
}
//--- object of class
CHighQualityRandState state;
//--- function call
CHighQualityRand::HQRndRandomize(state);
//--- Prepare
double l1=0;
double l2=MathLog(1/c);
//--- initialization
a.Set(0,0,MathExp(l1));
for(int i=1; i<=n-2; i++)
a.Set(i,i,(2*CHighQualityRand::HQRndUniformI(state,2)-1)*MathExp(CHighQualityRand::HQRndUniformR(state)*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- Multiply
HMatrixRndMultiply(a,n);
//--- post-process to ensure that matrix diagonal is real
for(int i=0; i<n; i++)
a.SetIm(i,i,0);
}
//+------------------------------------------------------------------+
//| Generation of random NxN Hermitian positive definite matrix with |
//| given condition number and norm2(A)=1 |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| C - condition number (in 2-norm) |
//| OUTPUT PARAMETERS: |
//| A - random HPD matrix with norm2(A)=1 and cond(A)=C |
//+------------------------------------------------------------------+
void CMatGen::HPDMatrixRndCond(const int n,const double c,CMatrixComplex &a)
{
//--- check
if(n<=0 || c<1.0)
return;
//--- allocation
a=matrix<complex>::Zeros(n,n);
//--- check
if(n==1)
{
a.Set(0,0,1.0);
return;
}
//--- object of class
CHighQualityRandState state;
//--- function call
CHighQualityRand::HQRndRandomize(state);
//--- Prepare matrix
double l1=0;
double l2=MathLog(1/c);
//--- initialization
a.Set(0,0,MathExp(l1));
for(int i=1; i<=n-2; i++)
a.Set(i,i,MathExp(CHighQualityRand::HQRndUniformR(state)*(l2-l1)+l1));
a.Set(n-1,n-1,MathExp(l2));
//--- Multiply
HMatrixRndMultiply(a,n);
//--- post-process to ensure that matrix diagonal is real
for(int i=0; i<n; i++)
a.SetIm(i,i,0);
}
//+------------------------------------------------------------------+
//| Multiplication of MxN matrix by NxN random Haar distributed |
//| orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..M-1, 0..N-1] |
//| M, N- matrix size |
//| OUTPUT PARAMETERS: |
//| A - A*Q, where Q is random NxN orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::RMatrixRndOrthogonalFromTheRight(CMatrixDouble &a,const int m,
const int n)
{
//--- create variables
double tau=0;
double lambdav=0;
int s=0;
int i=0;
double u1=0;
double u2=0;
int i_=0;
//--- create arrays
CRowDouble w;
CRowDouble v;
//--- check
if(!CAp::Assert(n>=1 && m>=1,__FUNCTION__+": N<1 or M<1!"))
return;
//--- object of class
CHighQualityRandState state;
//--- check
if(n==1)
{
//--- Special case
tau=2*CMath::RandomInteger(2)-1;
for(i=0; i<m; i++)
a.Set(i,0,(a.Get(i,0)*tau));
//--- exit the function
return;
}
//--- General case.
//--- First pass.
w.Resize(m);
v.Resize(n+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=n; s++)
{
//--- Prepare random normal v
do
{
i=1;
while(i<=s)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,u1,u2);
v.Set(i,u1);
//--- check
if(i+1<=s)
v.Set(i+1,u2);
i=i+2;
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*v[i_];
}
while(lambdav==0.0);
//--- Prepare and apply reflection
CAblas::GenerateReflection(v,s,tau);
v.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheRight(a,tau,v,0,m-1,n-s,n-1,w);
}
//--- Second pass.
for(i=0; i<n; i++)
{
tau=2*CHighQualityRand::HQRndUniformI(state,2)-1;
a.Col(i,(a.Col(i)*tau));
}
}
//+------------------------------------------------------------------+
//| Multiplication of MxN matrix by MxM random Haar distributed |
//| orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..M-1, 0..N-1] |
//| M, N- matrix size |
//| OUTPUT PARAMETERS: |
//| A - Q*A, where Q is random MxM orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::RMatrixRndOrthogonalFromTheLeft(CMatrixDouble &a,const int m,
const int n)
{
//--- create variables
double tau=0;
double lambdav=0;
int s=0;
int i=0;
int j=0;
double u1=0;
double u2=0;
//--- create arrays
CRowDouble w;
CRowDouble v;
//--- object of class
CHighQualityRandState state;
int i_=0;
//--- check
if(!CAp::Assert(n>=1 && m>=1,__FUNCTION__+": N<1 or M<1!"))
return;
//--- check
if(m==1)
{
tau=2*CMath::RandomInteger(2)-1;
a.Row(0,(a[0]*tau));
//--- exit the function
return;
}
//--- General case.
//--- First pass.
w.Resize(n);
v.Resize(m+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=m; s++)
{
//--- Prepare random normal v
do
{
i=1;
while(i<=s)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,u1,u2);
v.Set(i,u1);
//--- check
if(i+1<=s)
v.Set(i+1,u2);
i=i+2;
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*v[i_];
}
while(lambdav==0.0);
//--- Prepare random normal v
CAblas::GenerateReflection(v,s,tau);
v.Set(1,1);
//--- function call
CAblas::ApplyReflectionFromTheLeft(a,tau,v,m-s,m-1,0,n-1,w);
}
//--- Second pass.
for(i=0; i<m; i++)
{
tau=2*CHighQualityRand::HQRndUniformI(state,2)-1;
a.Row(i,a[i]*tau);
}
}
//+------------------------------------------------------------------+
//| Multiplication of MxN complex matrix by NxN random Haar |
//| distributed complex orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..M-1, 0..N-1] |
//| M, N- matrix size |
//| OUTPUT PARAMETERS: |
//| A - A*Q, where Q is random NxN orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::CMatrixRndOrthogonalFromTheRight(CMatrixComplex &a,const int m,const int n)
{
//--- create variables
complex zero=0;
complex lambdav=0;
complex tau=0;
int s=0;
int i=0;
int i_=0;
//--- create arrays
CRowComplex w;
CRowComplex v;
//--- object of class
CHighQualityRandState state;
//--- check
if(!CAp::Assert(n>=1 && m>=1,__FUNCTION__+": N<1 or M<1!"))
return;
//--- check
if(n==1)
{
//--- function call
CHighQualityRand::HQRndRandomize(state);
//--- function call
CHighQualityRand::HQRndUnit2(state,tau.real,tau.imag);
for(i=0; i<m; i++)
a.Set(i,0,a.Get(i,0)*tau);
//--- exit the function
return;
}
//--- General case.
//--- First pass.
w.Resize(m);
v.Resize(n+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=n; s++)
{
//--- Prepare random normal v
do
{
for(i=1; i<=s; i++)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,tau.real,tau.imag);
v.Set(i,tau);
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*CMath::Conj(v[i_]);
}
while(lambdav==zero);
//--- Prepare and apply reflection
CComplexReflections::ComplexGenerateReflection(v,s,tau);
v.Set(1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheRight(a,tau,v,0,m-1,n-s,n-1,w);
}
//--- Second pass.
for(i=0; i<n; i++)
{
//--- function call
CHighQualityRand::HQRndUnit2(state,tau.real,tau.imag);
for(i_=0; i_<m; i_++)
a.Set(i_,i,tau*a.Get(i_,i));
}
}
//+------------------------------------------------------------------+
//| Multiplication of MxN complex matrix by MxM random Haar |
//| distributed complex orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..M-1, 0..N-1] |
//| M, N- matrix size |
//| OUTPUT PARAMETERS: |
//| A - Q*A, where Q is random MxM orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::CMatrixRndOrthogonalFromTheLeft(CMatrixComplex &a,const int m,
const int n)
{
//--- create variables
complex zero=0;
complex tau=0;
complex lambdav=0;
int s=0;
int i=0;
int j=0;
int i_=0;
//--- create arrays
CRowComplex w;
CRowComplex v;
//--- object of class
CHighQualityRandState state;
//--- check
if(!CAp::Assert(n>=1 && m>=1,__FUNCTION__+": N<1 or M<1!"))
return;
//--- check
if(m==1)
{
//--- function call
CHighQualityRand::HQRndRandomize(state);
//--- function call
CHighQualityRand::HQRndUnit2(state,tau.real,tau.imag);
for(j=0; j<n; j++)
a.Set(0,j,a.Get(0,j)*tau);
//--- exit the function
return;
}
//--- General case.
//--- First pass.
w.Resize(n);
v.Resize(m+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=m; s++)
{
//--- Prepare random normal v
do
{
for(i=1; i<=s; i++)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,tau.real,tau.imag);
v.Set(i,tau);
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*CMath::Conj(v[i_]);
}
while(lambdav==zero);
//--- Prepare and apply reflection
CComplexReflections::ComplexGenerateReflection(v,s,tau);
v.Set(1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheLeft(a,tau,v,m-s,m-1,0,n-1,w);
}
//--- Second pass.
for(i=0; i<m; i++)
{
//--- function call
CHighQualityRand::HQRndUnit2(state,tau.real,tau.imag);
for(j=0; j<n; j++)
a.Set(i,j,a.Get(i,j)*tau);
}
}
//+------------------------------------------------------------------+
//| Symmetric multiplication of NxN matrix by random Haar |
//| distributed orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..N-1, 0..N-1] |
//| N - matrix size |
//| OUTPUT PARAMETERS: |
//| A - Q'*A*Q, where Q is random NxN orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::SMatrixRndMultiply(CMatrixDouble &a,const int n)
{
//--- create variables
double tau=0;
double lambdav=0;
int s=0;
int i=0;
double u1=0;
double u2=0;
int i_=0;
//--- create arrays
CRowDouble w;
CRowDouble v;
//--- object of class
CHighQualityRandState state;
//--- General case.
w.Resize(n);
v.Resize(n+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=n; s++)
{
//--- Prepare random normal v
do
{
i=1;
while(i<=s)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,u1,u2);
v.Set(i,u1);
//--- check
if(i+1<=s)
v.Set(i+1,u2);
i=i+2;
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*v[i_];
}
while(lambdav==0.0);
//--- Prepare and apply reflection
CAblas::GenerateReflection(v,s,tau);
v.Set(1,1.0);
//--- function call
CAblas::ApplyReflectionFromTheRight(a,tau,v,0,n-1,n-s,n-1,w);
//--- function call
CAblas::ApplyReflectionFromTheLeft(a,tau,v,n-s,n-1,0,n-1,w);
}
//--- Second pass.
for(i=0; i<n; i++)
{
tau=2*CHighQualityRand::HQRndUniformI(state,2)-1;
for(i_=0; i_<n; i_++)
{
a.Set(i_,i,tau*a.Get(i_,i));
a.Set(i,i_,tau*a.Get(i,i_));
}
}
//--- Copy upper triangle to lower
for(i=0; i<n-1; i++)
for(i_=i+1; i_<n; i_++)
a.Set(i_,i,a.Get(i,i_));
}
//+------------------------------------------------------------------+
//| Hermitian multiplication of NxN matrix by random Haar distributed|
//| complex orthogonal matrix |
//| INPUT PARAMETERS: |
//| A - matrix, array[0..N-1, 0..N-1] |
//| N - matrix size |
//| OUTPUT PARAMETERS: |
//| A - Q^H*A*Q, where Q is random NxN orthogonal matrix |
//+------------------------------------------------------------------+
void CMatGen::HMatrixRndMultiply(CMatrixComplex &a,const int n)
{
//--- create variables
complex zero=0;
complex tau=0;
complex lambdav=0;
int s=0;
int i=0;
int i_=0;
//--- create arrays
CRowComplex w;
CRowComplex v;
//--- object of class
CHighQualityRandState state;
//--- General case.
w.Resize(n);
v.Resize(n+1);
//--- function call
CHighQualityRand::HQRndRandomize(state);
for(s=2; s<=n; s++)
{
//--- Prepare random normal v
do
{
for(i=1; i<=s; i++)
{
//--- function call
CHighQualityRand::HQRndNormal2(state,tau.real,tau.imag);
v.Set(i,tau);
}
//--- change values
lambdav=0.0;
for(i_=1; i_<=s; i_++)
lambdav+=v[i_]*CMath::Conj(v[i_]);
}
while(lambdav==zero);
//--- Prepare and apply reflection
CComplexReflections::ComplexGenerateReflection(v,s,tau);
v.Set(1,1.0);
//--- function call
CComplexReflections::ComplexApplyReflectionFromTheRight(a,tau,v,0,n-1,n-s,n-1,w);
//--- function call
complex conj=CMath::Conj(tau);
CComplexReflections::ComplexApplyReflectionFromTheLeft(a,conj,v,n-s,n-1,0,n-1,w);
}
//--- Second pass.
for(i=0; i<n; i++)
{
//--- function call
CHighQualityRand::HQRndUnit2(state,tau.real,tau.imag);
for(i_=0; i_<n; i_++)
a.Set(i_,i,tau*a.Get(i_,i));
tau=CMath::Conj(tau);
for(i_=0; i_<n; i_++)
a.Set(i,i_,tau*a.Get(i,i_));
}
//--- Change all values from lower triangle by complex-conjugate values
//--- from upper one
for(i=0; i<n-1; i++)
for(i_=i+1; i_<n; i_++)
a.Set(i_,i,a.Get(i,i_));
for(s=0; s<=n-2; s++)
for(i=s+1; i<n; i++)
a.SetIm(i,s,-a.Get(i,s).imag);
}
//+------------------------------------------------------------------+
//| This structure is used to store K sets of N possible integers |
//| each. |
//| The structure needs at least O(N) temporary memory. |
//+------------------------------------------------------------------+
struct CAmdKNSet
{
int m_K;
int m_N;
CRowInt m_FlagArray;
CRowInt m_VBegin;
CRowInt m_VAllocated;
CRowInt m_VCnt;
CRowInt m_Data;
int m_DataUsed;
int m_IterRow;
int m_IterIdx;
//---
CAmdKNSet(void) { Init(); }
~CAmdKNSet(void) {}
//--- methods
void Init(void);
void Copy(const CAmdKNSet &obj);
//--- overloading
void operator=(const CAmdKNSet &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdKNSet::Init(void)
{
m_K=0;
m_N=0;
m_DataUsed=0;
m_IterRow=0;
m_IterIdx=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdKNSet::Copy(const CAmdKNSet &obj)
{
m_K=obj.m_K;
m_N=obj.m_N;
m_FlagArray=obj.m_FlagArray;
m_VBegin=obj.m_VBegin;
m_VAllocated=obj.m_VAllocated;
m_VCnt=obj.m_VCnt;
m_Data=obj.m_Data;
m_DataUsed=obj.m_DataUsed;
m_IterRow=obj.m_IterRow;
m_IterIdx=obj.m_IterIdx;
}
//+------------------------------------------------------------------+
//| This structure is used to store set of N possible integers, in |
//| [0,N) range. |
//| The structure needs O(N) memory, independently from the actual |
//| set size. |
//| This structure allows external code to use following fields: |
//| * N - maximum set size |
//| * NStored - number of elements currently in the set |
//| * Items - first NStored elements are UNSORTED items |
//| * LocationOf - array[N] that allows quick access by key. If |
//| item I is present in the set, LocationOf[I]>=0 |
//| and stores position in Items[] of element I, |
//| i.e. Items[LocationOf[I]]=I. |
//| If item I is not present, LocationOf[I]<0. |
//+------------------------------------------------------------------+
struct CAmdNSet
{
int m_N;
int m_NStored;
CRowInt m_Items;
CRowInt m_LocationOf;
int m_IterIdx;
//---
CAmdNSet(void) { Init(); }
~CAmdNSet(void) {}
//--- methods
void Init(void);
void Copy(const CAmdNSet &obj);
//--- overloading
void operator=(const CAmdNSet &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdNSet::Init(void)
{
m_N=0;
m_NStored=0;
m_IterIdx=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdNSet::Copy(const CAmdNSet &obj)
{
m_N=obj.m_N;
m_NStored=obj.m_NStored;
m_Items=obj.m_Items;
m_LocationOf=obj.m_LocationOf;
m_IterIdx=obj.m_IterIdx;
}
//+------------------------------------------------------------------+
//| This structure is used to store vertex degrees, with ability to|
//| quickly (in O(1) time) select one with smallest degree |
//+------------------------------------------------------------------+
struct CAmdVertexSet
{
int m_N;
bool m_CheckExactDegrees;
int m_SmallestDegree;
CRowInt m_ApproxD;
CRowInt m_OptionalExactD;
bool m_IsVertex[];
CRowInt m_VBegin;
CRowInt m_VPrev;
CRowInt m_VNext;
//---
CAmdVertexSet(void) { Init(); }
void Init(void);
void Copy(const CAmdVertexSet &obj);
//--- overloading
void operator=(const CAmdVertexSet &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdVertexSet::Init(void)
{
m_N=0;
m_CheckExactDegrees=0;
m_SmallestDegree=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdVertexSet::Copy(const CAmdVertexSet &obj)
{
m_N=obj.m_N;
m_CheckExactDegrees=obj.m_CheckExactDegrees;
m_SmallestDegree=obj.m_SmallestDegree;
m_ApproxD=obj.m_ApproxD;
m_OptionalExactD=obj.m_OptionalExactD;
ArrayCopy(m_IsVertex,obj.m_IsVertex);
m_VBegin=obj.m_VBegin;
m_VPrev=obj.m_VPrev;
m_VNext=obj.m_VNext;
}
//+------------------------------------------------------------------+
//| This structure is used to store linked list NxN matrix. |
//| The fields are: |
//| * VBegin - array[2*N+1], stores first entries in each row |
//| (N values), col (N values), list of free entries|
//| (1 value), 2*N+1 in total |
//| * Entries - stores EntriesInitialized elements, each |
//| occupying llmEntrySize elements of array. These |
//| entries are organized into linked row and column|
//| list, with each entry belonging to both row list|
//| and column list. |
//+------------------------------------------------------------------+
struct CAmdLLMatrix
{
int m_N;
CRowInt m_VBegin;
CRowInt m_VColCnt;
CRowInt m_Entries;
int m_EntriesInitialized;
//--- constructor / destructor
CAmdLLMatrix(void) { Init(); }
~CAmdLLMatrix(void) {}
//--- methods
void Init(void);
void Copy(const CAmdLLMatrix &obj);
//--- overloading
void operator=(const CAmdLLMatrix &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdLLMatrix::Init(void)
{
m_N=0;
m_EntriesInitialized=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdLLMatrix::Copy(const CAmdLLMatrix &obj)
{
m_N=obj.m_N;
m_VBegin=obj.m_VBegin;
m_VColCnt=obj.m_VColCnt;
m_Entries=obj.m_Entries;
m_EntriesInitialized=obj.m_EntriesInitialized;
}
//+------------------------------------------------------------------+
//| This structure is used to store temporaries for AMD ordering |
//+------------------------------------------------------------------+
struct CAmdBuffer
{
int m_N;
bool m_ExtendedDebug;
bool m_CheckExactDegrees;
bool m_IsEliminated[];
bool m_IsSuperNode[];
CAmdKNSet m_SetSuper;
CAmdKNSet m_SetA;
CAmdKNSet m_SetE;
CAmdLLMatrix m_MtxL;
CAmdVertexSet m_VertexDegrees;
CAmdNSet m_SetQ;
CRowInt m_Perm;
CRowInt m_InvPerm;
CRowInt m_ColumnSwaps;
CAmdNSet m_SetP;
CAmdNSet m_Lp;
CAmdNSet m_SetRP;
CAmdNSet m_Ep;
CAmdNSet m_AdjI;
CAmdNSet m_AdjJ;
CRowInt m_Ls;
int m_LSCnt;
CAmdNSet m_SetQSuperCand;
CAmdNSet m_ExactDegreeTmp0;
CAmdKNSet m_HashBuckets;
CAmdNSet m_NonEmptyBuckets;
CRowInt m_SNCandidates;
CRowInt m_Tmp0;
CRowInt m_Arrwe;
CMatrixDouble m_Dbga;
//--- constructor / destructor
CAmdBuffer(void) { Init(); }
~CAmdBuffer(void) {}
//--- methods
void Init(void);
void Copy(const CAmdBuffer &obj);
//--- overloading
void operator=(const CAmdBuffer &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdBuffer::Init(void)
{
m_N=0;
m_ExtendedDebug=false;
m_CheckExactDegrees=false;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CAmdBuffer::Copy(const CAmdBuffer &obj)
{
m_N=obj.m_N;
m_ExtendedDebug=obj.m_ExtendedDebug;
m_CheckExactDegrees=obj.m_CheckExactDegrees;
ArrayCopy(m_IsEliminated,obj.m_IsEliminated);
ArrayCopy(m_IsSuperNode,obj.m_IsSuperNode);
m_SetSuper=obj.m_SetSuper;
m_SetA=obj.m_SetA;
m_SetE=obj.m_SetE;
m_MtxL=obj.m_MtxL;
m_VertexDegrees=obj.m_VertexDegrees;
m_SetQ=obj.m_SetQ;
m_Perm=obj.m_Perm;
m_InvPerm=obj.m_InvPerm;
m_ColumnSwaps=obj.m_ColumnSwaps;
m_SetP=obj.m_SetP;
m_Lp=obj.m_Lp;
m_SetRP=obj.m_SetRP;
m_Ep=obj.m_Ep;
m_AdjI=obj.m_AdjI;
m_AdjJ=obj.m_AdjJ;
m_Ls=obj.m_Ls;
m_LSCnt=obj.m_LSCnt;
m_SetQSuperCand=obj.m_SetQSuperCand;
m_ExactDegreeTmp0=obj.m_ExactDegreeTmp0;
m_HashBuckets=obj.m_HashBuckets;
m_NonEmptyBuckets=obj.m_NonEmptyBuckets;
m_SNCandidates=obj.m_SNCandidates;
m_Tmp0=obj.m_Tmp0;
m_Arrwe=obj.m_Arrwe;
m_Dbga=obj.m_Dbga;
}
//+------------------------------------------------------------------+
//| This structure is used to store preliminary analysis results for |
//| sparse Cholesky: elimination tree, factorization costs, etc. |
//+------------------------------------------------------------------+
struct CSpCholAnalysis
{
int m_TaskType;
int m_N;
int m_PermType;
bool m_UnitD;
int m_ModType;
double m_ModParam0;
double m_ModParam1;
double m_ModParam2;
double m_ModParam3;
bool m_ExtendedDebug;
bool m_Dotrace;
bool m_DotraceSupernodalStructure;
CRowInt m_ReferenceRIdx;
int m_NSuper;
CRowInt m_ParentSupernode;
CRowInt m_SuperColRange;
CRowInt m_SuperRowRIdx;
CRowInt m_SuperRowIdx;
CRowInt m_FillinPerm;
CRowInt m_InvFillinPerm;
CRowInt m_SuperPerm;
CRowInt m_InvSuperPerm;
CRowInt m_EffectivePerm;
CRowInt m_InvEffectivePerm;
bool m_IsTopologicalOrdering;
bool m_ApplyPermutationToOutput;
CRowInt m_LAdjPlusR;
CRowInt m_LAdjPlus;
CRowInt m_OutRowCounts;
CRowDouble m_InputStorage;
CRowDouble m_OutputStorage;
CRowInt m_RowStrides;
CRowInt m_RowOffSets;
CRowDouble m_DiagD;
CRowInt m_WrkRows;
bool m_FlagArray[];
bool m_Eligible[];
CRowInt m_CurPriorities;
CRowInt m_TmpParent;
CRowInt m_Node2Supernode;
CRowInt m_U2Smap;
CRowInt m_Raw2Smap;
CAmdBuffer m_AmdTmp;
CRowInt m_Tmp0;
CRowInt m_Tmp1;
CRowInt m_Tmp2;
CRowInt m_Tmp3;
CRowInt m_Tmp4;
CSparseMatrix m_TmpA;
CSparseMatrix m_TmpAt;
CSparseMatrix m_TmpA2;
CSparseMatrix m_TmpBottomT;
CSparseMatrix m_TmpUpdate;
CSparseMatrix m_TmpUpdateT;
CSparseMatrix m_TmpNewTailT;
CRowInt m_TmpPerm;
CRowInt m_InvTmpPerm;
CRowDouble m_TmpX;
CRowDouble m_SimdBuf;
//--- constructor / destructor
CSpCholAnalysis(void) { Init(); }
~CSpCholAnalysis(void) {}
//---
void Init(void);
void Copy(const CSpCholAnalysis &obj);
void Trace(void);
void SpCholAlloc(CSerializer &s);
void SpCholSerialize(CSerializer &s);
//--- overloading
void operator=(const CSpCholAnalysis &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Init |
//+------------------------------------------------------------------+
void CSpCholAnalysis::Init(void)
{
m_TaskType=0;
m_N=0;
m_PermType=0;
m_UnitD=false;
m_ModType=0;
m_ModParam0=0;
m_ModParam1=0;
m_ModParam2=0;
m_ModParam3=0;
m_ExtendedDebug=false;
m_Dotrace=false;
m_DotraceSupernodalStructure=false;
m_IsTopologicalOrdering=false;
m_ApplyPermutationToOutput=false;
}
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
void CSpCholAnalysis::Copy(const CSpCholAnalysis &obj)
{
m_TaskType=obj.m_TaskType;
m_N=obj.m_N;
m_PermType=obj.m_PermType;
m_UnitD=obj.m_UnitD;
m_ModType=obj.m_ModType;
m_ModParam0=obj.m_ModParam0;
m_ModParam1=obj.m_ModParam1;
m_ModParam2=obj.m_ModParam2;
m_ModParam3=obj.m_ModParam3;
m_ExtendedDebug=obj.m_ExtendedDebug;
m_Dotrace=obj.m_Dotrace;
m_DotraceSupernodalStructure=obj.m_DotraceSupernodalStructure;
m_ReferenceRIdx=obj.m_ReferenceRIdx;
m_NSuper=obj.m_NSuper;
m_ParentSupernode=obj.m_ParentSupernode;
m_SuperColRange=obj.m_SuperColRange;
m_SuperRowRIdx=obj.m_SuperRowRIdx;
m_SuperRowIdx=obj.m_SuperRowIdx;
m_FillinPerm=obj.m_FillinPerm;
m_InvFillinPerm=obj.m_InvFillinPerm;
m_SuperPerm=obj.m_SuperPerm;
m_InvSuperPerm=obj.m_InvSuperPerm;
m_EffectivePerm=obj.m_EffectivePerm;
m_InvEffectivePerm=obj.m_InvEffectivePerm;
m_IsTopologicalOrdering=obj.m_IsTopologicalOrdering;
m_ApplyPermutationToOutput=obj.m_ApplyPermutationToOutput;
m_LAdjPlusR=obj.m_LAdjPlusR;
m_LAdjPlus=obj.m_LAdjPlus;
m_OutRowCounts=obj.m_OutRowCounts;
m_InputStorage=obj.m_InputStorage;
m_OutputStorage=obj.m_OutputStorage;
m_RowStrides=obj.m_RowStrides;
m_RowOffSets=obj.m_RowOffSets;
m_DiagD=obj.m_DiagD;
m_WrkRows=obj.m_WrkRows;
ArrayCopy(m_FlagArray,obj.m_FlagArray);
ArrayCopy(m_Eligible,obj.m_Eligible);
m_CurPriorities=obj.m_CurPriorities;
m_TmpParent=obj.m_TmpParent;
m_Node2Supernode=obj.m_Node2Supernode;
m_U2Smap=obj.m_U2Smap;
m_Raw2Smap=obj.m_Raw2Smap;
m_AmdTmp=obj.m_AmdTmp;
m_Tmp0=obj.m_Tmp0;
m_Tmp1=obj.m_Tmp1;
m_Tmp2=obj.m_Tmp2;
m_Tmp3=obj.m_Tmp3;
m_Tmp4=obj.m_Tmp4;
m_TmpA=obj.m_TmpA;
m_TmpAt=obj.m_TmpAt;
m_TmpA2=obj.m_TmpA2;
m_TmpBottomT=obj.m_TmpBottomT;
m_TmpUpdate=obj.m_TmpUpdate;
m_TmpUpdateT=obj.m_TmpUpdateT;
m_TmpNewTailT=obj.m_TmpNewTailT;
m_TmpPerm=obj.m_TmpPerm;
m_InvTmpPerm=obj.m_InvTmpPerm;
m_TmpX=obj.m_TmpX;
m_SimdBuf=obj.m_SimdBuf;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSpCholAnalysis::Trace(void)
{
if(!m_Dotrace)
return;
//--- create a variable
CSerializer s;
//--- serialization start
s.Alloc_Start();
//--- function call
SpCholAlloc(s);
s.Alloc_Entry();
//--- serialization
s.SStart_Str();
SpCholSerialize(s);
s.Stop();
CAp::Trace(s.Get_String()+"\n");
CAp::Trace("------\n");
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSpCholAnalysis::SpCholAlloc(CSerializer &s)
{
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
s.Alloc_Entry();
CApServ::AllocIntegerArray(s,m_ReferenceRIdx);
s.Alloc_Entry();
CApServ::AllocIntegerArray(s,m_ParentSupernode);
CApServ::AllocIntegerArray(s,m_SuperColRange);
CApServ::AllocIntegerArray(s,m_SuperRowRIdx);
CApServ::AllocIntegerArray(s,m_SuperRowIdx);
CApServ::AllocIntegerArray(s,m_FillinPerm);
CApServ::AllocIntegerArray(s,m_InvFillinPerm);
CApServ::AllocIntegerArray(s,m_SuperPerm);
CApServ::AllocIntegerArray(s,m_InvSuperPerm);
CApServ::AllocIntegerArray(s,m_EffectivePerm);
CApServ::AllocIntegerArray(s,m_InvEffectivePerm);
s.Alloc_Entry();
s.Alloc_Entry();
CApServ::AllocIntegerArray(s,m_LAdjPlusR);
CApServ::AllocIntegerArray(s,m_LAdjPlus);
CApServ::AllocIntegerArray(s,m_OutRowCounts);
CApServ::AllocRealArray(s,m_InputStorage);
CApServ::AllocRealArray(s,m_OutputStorage);
CApServ::AllocIntegerArray(s,m_RowStrides);
CApServ::AllocIntegerArray(s,m_RowOffSets);
CApServ::AllocRealArray(s,m_DiagD);
CApServ::AllocIntegerArray(s,m_WrkRows);
CApServ::AllocBoolArray(s,m_FlagArray);
CApServ::AllocBoolArray(s,m_Eligible);
CApServ::AllocIntegerArray(s,m_CurPriorities);
CApServ::AllocIntegerArray(s,m_TmpParent);
CApServ::AllocIntegerArray(s,m_Node2Supernode);
CApServ::AllocIntegerArray(s,m_U2Smap);
CApServ::AllocIntegerArray(s,m_Raw2Smap);
CApServ::AllocIntegerArray(s,m_Tmp0);
CApServ::AllocIntegerArray(s,m_Tmp1);
CApServ::AllocIntegerArray(s,m_Tmp2);
CApServ::AllocIntegerArray(s,m_Tmp3);
CApServ::AllocIntegerArray(s,m_Tmp4);
CSparse::SparseAlloc(s,m_TmpA);
CSparse::SparseAlloc(s,m_TmpAt);
CSparse::SparseAlloc(s,m_TmpA2);
CSparse::SparseAlloc(s,m_TmpBottomT);
CSparse::SparseAlloc(s,m_TmpUpdate);
CSparse::SparseAlloc(s,m_TmpUpdateT);
CSparse::SparseAlloc(s,m_TmpNewTailT);
CApServ::AllocIntegerArray(s,m_TmpPerm);
CApServ::AllocIntegerArray(s,m_InvTmpPerm);
CApServ::AllocRealArray(s,m_TmpX);
CApServ::AllocRealArray(s,m_SimdBuf);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSpCholAnalysis::SpCholSerialize(CSerializer &s)
{
s.Serialize_Int(m_TaskType);
s.Serialize_Int(m_N);
s.Serialize_Int(m_PermType);
s.Serialize_Bool(m_UnitD);
s.Serialize_Int(m_ModType);
s.Serialize_Double(m_ModParam0);
s.Serialize_Double(m_ModParam1);
s.Serialize_Double(m_ModParam2);
s.Serialize_Double(m_ModParam3);
s.Serialize_Bool(m_ExtendedDebug);
s.Serialize_Bool(m_Dotrace);
s.Serialize_Bool(m_DotraceSupernodalStructure);
CApServ::SerializeIntegerArray(s,m_ReferenceRIdx);
s.Serialize_Int(m_NSuper);
CApServ::SerializeIntegerArray(s,m_ParentSupernode);
CApServ::SerializeIntegerArray(s,m_SuperColRange);
CApServ::SerializeIntegerArray(s,m_SuperRowRIdx);
CApServ::SerializeIntegerArray(s,m_SuperRowIdx);
CApServ::SerializeIntegerArray(s,m_FillinPerm);
CApServ::SerializeIntegerArray(s,m_InvFillinPerm);
CApServ::SerializeIntegerArray(s,m_SuperPerm);
CApServ::SerializeIntegerArray(s,m_InvSuperPerm);
CApServ::SerializeIntegerArray(s,m_EffectivePerm);
CApServ::SerializeIntegerArray(s,m_InvEffectivePerm);
s.Serialize_Bool(m_IsTopologicalOrdering);
s.Serialize_Bool(m_ApplyPermutationToOutput);
CApServ::SerializeIntegerArray(s,m_LAdjPlusR);
CApServ::SerializeIntegerArray(s,m_LAdjPlus);
CApServ::SerializeIntegerArray(s,m_OutRowCounts);
CApServ::SerializeRealArray(s,m_InputStorage);
CApServ::SerializeRealArray(s,m_OutputStorage);
CApServ::SerializeIntegerArray(s,m_RowStrides);
CApServ::SerializeIntegerArray(s,m_RowOffSets);
CApServ::SerializeRealArray(s,m_DiagD);
CApServ::SerializeIntegerArray(s,m_WrkRows);
CApServ::SerializeBoolArray(s,m_FlagArray);
CApServ::SerializeBoolArray(s,m_Eligible);
CApServ::SerializeIntegerArray(s,m_CurPriorities);
CApServ::SerializeIntegerArray(s,m_TmpParent);
CApServ::SerializeIntegerArray(s,m_Node2Supernode);
CApServ::SerializeIntegerArray(s,m_U2Smap);
CApServ::SerializeIntegerArray(s,m_Raw2Smap);
CApServ::SerializeIntegerArray(s,m_Tmp0);
CApServ::SerializeIntegerArray(s,m_Tmp1);
CApServ::SerializeIntegerArray(s,m_Tmp2);
CApServ::SerializeIntegerArray(s,m_Tmp3);
CApServ::SerializeIntegerArray(s,m_Tmp4);
CSparse::SparseSerialize(s,m_TmpA);
CSparse::SparseSerialize(s,m_TmpAt);
CSparse::SparseSerialize(s,m_TmpA2);
CSparse::SparseSerialize(s,m_TmpBottomT);
CSparse::SparseSerialize(s,m_TmpUpdate);
CSparse::SparseSerialize(s,m_TmpUpdateT);
CSparse::SparseSerialize(s,m_TmpNewTailT);
CApServ::SerializeIntegerArray(s,m_TmpPerm);
CApServ::SerializeIntegerArray(s,m_InvTmpPerm);
CApServ::SerializeRealArray(s,m_TmpX);
CApServ::SerializeRealArray(s,m_SimdBuf);
}
//+------------------------------------------------------------------+
//| An analysis of the sparse matrix decomposition, performed prior |
//| to actual numerical factorization. You should not directly access|
//| fields of this object - use appropriate ALGLIB functions to work |
//| with this object. |
//+------------------------------------------------------------------+
struct CSparseDecompositionAnalysis
{
int m_N;
int m_FactType;
int m_PermType;
CSpCholAnalysis m_Analysis;
CSparseMatrix m_WrkA;
CSparseMatrix m_WrkAT;
CSparseMatrix m_CrsA;
CSparseMatrix m_CrsAT;
//--- constructor / destructor
CSparseDecompositionAnalysis(void) { Init(); }
~CSparseDecompositionAnalysis(void) {}
void Init(void);
void Copy(const CSparseDecompositionAnalysis &obj);
//--- overloading
void operator=(const CSparseDecompositionAnalysis &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Init |
//+------------------------------------------------------------------+
void CSparseDecompositionAnalysis::Init(void)
{
m_N=0;
m_FactType=0;
m_PermType=0;
}
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
void CSparseDecompositionAnalysis::Copy(const CSparseDecompositionAnalysis &obj)
{
m_N=obj.m_N;
m_FactType=obj.m_FactType;
m_PermType=obj.m_PermType;
m_Analysis=obj.m_Analysis;
m_WrkA=obj.m_WrkA;
m_WrkAT=obj.m_WrkAT;
m_CrsA=obj.m_CrsA;
m_CrsAT=obj.m_CrsAT;
}
//+------------------------------------------------------------------+
//| Triangular factorizations |
//+------------------------------------------------------------------+
class CTrFac
{
private:
static bool HPDMatrixCholeskyRec(CMatrixComplex &A,const int Offs,const int n,const bool IsUpper,CRowComplex &tmp);
static bool HPDMatrixCholesky2(CMatrixComplex &AAA,const int Offs,const int n,const bool IsUpper,CRowComplex &tmp);
static bool SPDMatrixCholesky2(CMatrixDouble &AAA,const int Offs,const int n,const bool IsUpper,CRowDouble &tmp);
public:
static void RMatrixLU(CMatrixDouble &A,const int m,const int n,int &pivots[]);
static void RMatrixLU(CMatrixDouble &A,const int m,const int n,CRowInt &pivots);
static void CMatrixLU(CMatrixComplex &A,const int m,const int n,int &pivots[]);
static void CMatrixLU(CMatrixComplex &A,const int m,const int n,CRowInt &pivots);
static bool HPDMatrixCholesky(CMatrixComplex &A,const int n,const bool IsUpper);
static bool SPDMatrixCholesky(CMatrixDouble &A,const int n,const bool IsUpper);
static void SPDMatrixCholeskyUpdateAdd1(CMatrixDouble &A,int N,bool IsUpper,CRowDouble &U);
static void SPDMatrixCholeskyUpdateFix(CMatrixDouble &A,int n,bool IsUpper,bool &Fix[]);
static void SPDMatrixCholeskyUpdateAdd1Buf(CMatrixDouble &A,int n,bool IsUpper,CRowDouble &U,CRowDouble &BufR);
static void SPDMatrixCholeskyUpdateFixBuf(CMatrixDouble &A,int n,bool IsUpper,bool &fix[],CRowDouble &BufR);
static bool SparseLU(CSparseMatrix &A,int pivottype,CRowInt &P,CRowInt &Q);
static bool SparseCholeskySkyLine(CSparseMatrix &A,int n,bool IsUpper);
static bool SparseCholesky(CSparseMatrix &A,bool IsUpper);
static bool SparseCholeskyP(CSparseMatrix &A,bool IsUpper,CRowInt &p);
static bool SparseCholeskyAnalyze(CSparseMatrix &A,bool IsUpper,int facttype,int PermType,CSparseDecompositionAnalysis &Analysis);
static void SparseCholeskySetModType(CSparseDecompositionAnalysis &Analysis,int modstrategy,double p0,double p1,double p2,double p3);
static bool SparseCholeskyFactorize(CSparseDecompositionAnalysis &Analysis,bool NeedUpper,CSparseMatrix &A,CRowDouble &d,CRowInt &p);
static void SparseCholeskyReload(CSparseDecompositionAnalysis &Analysis,CSparseMatrix &A,bool IsUpper);
static void RMatrixLUP(CMatrixDouble &A,const int m,const int n,int &pivots[]);
static void RMatrixLUP(CMatrixDouble &A,const int m,const int n,CRowInt &pivots);
static void CMatrixLUP(CMatrixComplex &A,const int m,const int n,int &pivots[]);
static void CMatrixLUP(CMatrixComplex &A,const int m,const int n,CRowInt &pivots);
static void RMatrixPLU(CMatrixDouble &A,const int m,const int n,int &pivots[]);
static void RMatrixPLU(CMatrixDouble &A,const int m,const int n,CRowInt &pivots);
static void CMatrixPLU(CMatrixComplex &A,const int m,const int n,int &pivots[]);
static void CMatrixPLU(CMatrixComplex &A,const int m,const int n,CRowInt &pivots);
static bool SPDMatrixCholeskyRec(CMatrixDouble &A,const int Offs,const int n,const bool IsUpper,double &tmp[]);
static bool SPDMatrixCholeskyRec(CMatrixDouble &A,const int Offs,const int n,const bool IsUpper,CRowDouble &tmp);
};
//+------------------------------------------------------------------+
//| LU decomposition of a general real matrix with row pivoting |
//| A is represented as A = P*L*U, where: |
//| * L is lower unitriangular matrix |
//| * U is upper triangular matrix |
//| * P = P0*P1*...*PK, K=min(M,N)-1, |
//| Pi - permutation matrix for I and Pivots[I] |
//| This is cache-oblivous implementation of LU decomposition. |
//| It is optimized for square matrices. As for rectangular matrices:|
//| * best case - M>>N |
//| * worst case - N>>M, small M, large N, matrix does not fit in CPU|
//| cache |
//| INPUT PARAMETERS: |
//| A - array[0..M-1, 0..N-1]. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| OUTPUT PARAMETERS: |
//| A - matrices L and U in compact form: |
//| * L is stored under main diagonal |
//| * U is stored on and above main diagonal |
//| Pivots - permutation matrix in compact form. |
//| array[0..Min(M-1,N-1)]. |
//+------------------------------------------------------------------+
void CTrFac::RMatrixLU(CMatrixDouble &a,const int m,const int n,int &pivots[])
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- function call
RMatrixPLU(a,m,n,pivots);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CTrFac::RMatrixLU(CMatrixDouble &a,const int m,const int n,CRowInt &pivots)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- function call
RMatrixPLU(a,m,n,pivots);
}
//+------------------------------------------------------------------+
//| LU decomposition of a general complex matrix with row pivoting |
//| A is represented as A = P*L*U, where: |
//| * L is lower unitriangular matrix |
//| * U is upper triangular matrix |
//| * P = P0*P1*...*PK, K=min(M,N)-1, |
//| Pi - permutation matrix for I and Pivots[I] |
//| This is cache-oblivous implementation of LU decomposition. It is |
//| optimized for square matrices. As for rectangular matrices: |
//| * best case - M>>N |
//| * worst case - N>>M, small M, large N, matrix does not fit in CPU|
//| cache |
//| INPUT PARAMETERS: |
//| A - array[0..M-1, 0..N-1]. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| OUTPUT PARAMETERS: |
//| A - matrices L and U in compact form: |
//| * L is stored under main diagonal |
//| * U is stored on and above main diagonal |
//| Pivots - permutation matrix in compact form. |
//| array[0..Min(M-1,N-1)]. |
//+------------------------------------------------------------------+
void CTrFac::CMatrixLU(CMatrixComplex &a,const int m,const int n,int &pivots[])
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- function call
CMatrixPLU(a,m,n,pivots);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CTrFac::CMatrixLU(CMatrixComplex &A,const int m,const int n,CRowInt &pivots)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- function call
CMatrixPLU(A,m,n,pivots);
}
//+------------------------------------------------------------------+
//| Cache-oblivious Cholesky decomposition |
//| The algorithm computes Cholesky decomposition of a Hermitian |
//| positive - definite matrix. The result of an algorithm is a |
//| representation of 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. Contents of A is|
//| not determined in such case. |
//+------------------------------------------------------------------+
bool CTrFac::HPDMatrixCholesky(CMatrixComplex &a,const int n,const bool IsUpper)
{
//--- check
if(n<1)
return(false);
//--- create array
CRowComplex tmp;
//--- return result
return(HPDMatrixCholeskyRec(a,0,n,IsUpper,tmp));
}
//+------------------------------------------------------------------+
//| Cache-oblivious Cholesky decomposition |
//| The algorithm computes Cholesky decomposition of a symmetric |
//| positive - definite matrix. The result of an algorithm is a |
//| representation of A as A=U^T*U or A=L*L^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^T*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. Contents of A is|
//| not determined in such case. |
//+------------------------------------------------------------------+
bool CTrFac::SPDMatrixCholesky(CMatrixDouble &a,const int n,const bool IsUpper)
{
//--- check
if(n<1)
return(false);
//--- create array
CRowDouble tmp;
//--- return result
return(SPDMatrixCholeskyRec(a,0,n,IsUpper,tmp));
}
//+------------------------------------------------------------------+
//| Update of Cholesky decomposition: rank-1 update to original A. |
//| "Buffered" version which uses preallocated buffer which is saved |
//| between subsequent function calls. |
//| This function uses internally allocated buffer which is not saved|
//| between subsequent calls. So, if you perform a lot of subsequent |
//| updates, we recommend you to use "buffered" version of this |
//| function: SPDMatrixCholeskyUpdateAdd1Buf(). |
//| INPUT PARAMETERS: |
//| A - upper or lower Cholesky factor. array with elements|
//| [0..N-1, 0..N-1]. Exception is thrown if array size|
//| is too small. |
//| N - size of matrix A, N>0 |
//| IsUpper - if IsUpper=True, then A contains upper Cholesky |
//| factor; otherwise A contains a lower one. |
//| U - array[N], rank-1 update to A: A_mod = A + u*u' |
//| Exception is thrown if array size is too small. |
//| BufR - possibly preallocated buffer; automatically resized|
//| if needed. It is recommended to reuse this buffer |
//| if you perform a lot of subsequent decompositions. |
//| OUTPUT PARAMETERS: |
//| A - updated factorization. If IsUpper=True, then the |
//| upper triangle contains matrix U, and the elements |
//| below the main diagonal are not modified. Similarly|
//| if IsUpper = False. |
//| NOTE: this function always succeeds, so it does not return |
//| completion code |
//| NOTE: this function checks sizes of input arrays, but it does NOT|
//| checks for presence of infinities or NAN's. |
//+------------------------------------------------------------------+
void CTrFac::SPDMatrixCholeskyUpdateAdd1(CMatrixDouble &A,int N,
bool IsUpper,
CRowDouble &U)
{
//--- check
if(!CAp::Assert(N>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(A.Rows()>=N,__FUNCTION__+": Rows(A)<N"))
return;
if(!CAp::Assert(A.Cols()>=N,__FUNCTION__+": Cols(A)<N"))
return;
if(!CAp::Assert(CAp::Len(U)>=N,__FUNCTION__+": Length(U)<N"))
return;
//--- create variables
CRowDouble BufR;
SPDMatrixCholeskyUpdateAdd1Buf(A,N,IsUpper,U,BufR);
}
//+------------------------------------------------------------------+
//| Update of Cholesky decomposition: "fixing" some variables. |
//| This function uses internally allocated buffer which is not saved|
//| between subsequent calls. So, if you perform a lot of subsequent |
//| updates, we recommend you to use "buffered" version of this |
//| function: SPDMatrixCholeskyUpdateFixBuf(). |
//| "FIXING" EXPLAINED: |
//| Suppose we have N*N positive definite matrix A. "Fixing" some |
//| variable means filling corresponding row/column of A by zeros, |
//| and setting diagonal element to 1. |
//| For example, if we fix 2nd variable in 4 * 4 matrix A, it |
//| becomes Af: |
//| (A00 A01 A02 A03) (Af00 0 Af02 Af03) |
//| (A10 A11 A12 A13) ( 0 1 0 0 ) |
//| (A20 A21 A22 A23) => (Af20 0 Af22 Af23) |
//| (A30 A31 A32 A33) (Af30 0 Af32 Af33) |
//| If we have Cholesky decomposition of A, it must be recalculated|
//| after variables were fixed. However, it is possible to use |
//| efficient algorithm, which needs O(K*N^2) time to "fix" K |
//| variables, given Cholesky decomposition of original, "unfixed" |
//| A. |
//| INPUT PARAMETERS: |
//| A - upper or lower Cholesky factor. Array with elements|
//| [0..N - 1, 0..N - 1]. Exception is thrown if array |
//| size is too small. |
//| N - size of matrix A, N > 0 |
//| IsUpper - if IsUpper = True, then A contains upper Cholesky |
//| factor; otherwise A contains a lower one. |
//| Fix - array[N], I-th element is True if I-th variable |
//| must be fixed. Exception is thrown if array size is|
//| too small. |
//| BufR - possibly preallocated buffer; automatically resized|
//| if needed. It is recommended to reuse this buffer |
//| if you perform a lot of subsequent decompositions. |
//| OUTPUT PARAMETERS: |
//| A - updated factorization. If IsUpper=True, then the |
//| upper triangle contains matrix U, and the elements |
//| below the main diagonal are not modified. |
//| Similarly, if IsUpper=False. |
//| NOTE: this function always succeeds, so it does not return |
//| completion code |
//| NOTE: this function checks sizes of input arrays, but it does NOT|
//| checks for presence of infinities or NAN's. |
//| NOTE: this function is efficient only for moderate amount of |
//| updated variables - say, 0.1*N or 0.3*N. For larger amount |
//| of variables it will still work, but you may get better |
//| performance with straightforward Cholesky. |
//+------------------------------------------------------------------+
void CTrFac::SPDMatrixCholeskyUpdateFix(CMatrixDouble &A,int n,
bool IsUpper,bool &Fix[])
{
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(A.Rows()>=n,__FUNCTION__+": Rows(A)<N"))
return;
if(!CAp::Assert(A.Cols()>=n,__FUNCTION__+": Cols(A)<N"))
return;
if(!CAp::Assert(CAp::Len(Fix)>=n,__FUNCTION__+": Length(Fix)<N"))
return;
CRowDouble BufR;
SPDMatrixCholeskyUpdateFixBuf(A,n,IsUpper,Fix,BufR);
}
//+------------------------------------------------------------------+
//| Update of Cholesky decomposition: rank - 1 update to original A. |
//| "Buffered" version which uses preallocated buffer which is saved |
//| between subsequent function calls. |
//| See comments for SPDMatrixCholeskyUpdateAdd1() for more |
//| information. |
//| INPUT PARAMETERS: |
//| A - upper or lower Cholesky factor. array with elements|
//| [0..N - 1, 0..N - 1]. Exception is thrown if array |
//| size is too small. |
//| N - size of matrix A, N > 0 |
//| IsUpper - if IsUpper = True, then A contains upper Cholesky |
//| factor; otherwise A contains a lower one. |
//| U - array[N], rank - 1 update to A: A_mod = A + u * u' |
//| Exception is thrown if array size is too small. |
//| BufR - possibly preallocated buffer; automatically resized|
//| if needed. It is recommended to reuse this buffer |
//| if you perform a lot of subsequent decompositions. |
//| OUTPUT PARAMETERS: |
//| A - updated factorization. If IsUpper=True, then the |
//| upper triangle contains matrix U, and the elements |
//| below the main diagonal are not modified. |
//| Similarly, if IsUpper=False. |
//+------------------------------------------------------------------+
void CTrFac::SPDMatrixCholeskyUpdateAdd1Buf(CMatrixDouble &A,int n,
bool IsUpper,CRowDouble &U,
CRowDouble &BufR)
{
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(A.Rows()>=n,__FUNCTION__+": Rows(A)<N"))
return;
if(!CAp::Assert(A.Cols()>=n,__FUNCTION__+": Cols(A)<N"))
return;
if(!CAp::Assert(CAp::Len(U)>=n,__FUNCTION__+": Length(U)<N"))
return;
//--- create variables
int i=0;
int j=0;
int nz=n;
double cs=0;
double sn=0;
double v=0;
double vv=0;
//--- Find index of first non-zero entry in U
for(i=0; i<n; i++)
{
if(U[i]!=0.0)
{
nz=i;
break;
}
}
//--- Nothing to update
if(nz==n)
return;
//--- If working with upper triangular matrix
if(IsUpper)
{
//--- Perform a sequence of updates which fix variables one by one.
//--- This approach is different from one which is used when we work
//--- with lower triangular matrix.
CApServ::RVectorSetLengthAtLeast(BufR,n);
CAblasF::RCopyVX(n-nz+1,U,nz,BufR,nz);
for(i=nz; i<n; i++)
{
if(BufR[i]!=0.0)
{
CRotations::GenerateRotation(A.Get(i,i),BufR[i],cs,sn,v);
A.Set(i,i,v);
BufR.Set(i,0.0);
for(j=i+1; j<n; j++)
{
v=A.Get(i,j);
vv=BufR[j];
A.Set(i,j,cs*v+sn*vv);
BufR.Set(j,-(sn*v)+cs*vv);
}
}
}
}
else
{
//--- Calculate rows of modified Cholesky factor, row-by-row
//--- (updates performed during variable fixing are applied
//--- simultaneously to each row)
CApServ::RVectorSetLengthAtLeast(BufR,3*n);
CAblasF::RCopyVX(n-nz+1,U,nz,BufR,nz);
for(i=nz; i<n; i++)
{
//--- Update all previous updates [Idx+1...I-1] to I-th row
vv=BufR[i];
for(j=nz; j<i; j++)
{
cs=BufR[n+2*j+0];
sn=BufR[n+2*j+1];
v=A.Get(i,j);
A.Set(i,j,cs*v+sn*vv);
vv=-(sn*v)+cs*vv;
}
//--- generate rotation applied to I-th element of update vector
CRotations::GenerateRotation(A.Get(i,i),vv,cs,sn,v);
A.Set(i,i,v);
BufR.Set(n+2*i,cs);
BufR.Set(n+2*i+1,sn);
}
}
}
//+------------------------------------------------------------------+
//| Update of Cholesky decomposition: "fixing" some variables. |
//| "Buffered" version which uses preallocated buffer which is saved |
//| between subsequent function calls. See comments for |
//| SPDMatrixCholeskyUpdateFix() for more information. |
//| INPUT PARAMETERS: |
//| A - upper or lower Cholesky factor. Array with elements|
//| [0..N - 1, 0..N - 1]. Exception is thrown if array |
//| size is too small. |
//| N - size of matrix A, N > 0 |
//| IsUpper - if IsUpper = True, then A contains upper Cholesky |
//| factor; otherwise A contains a lower one. |
//| Fix - array[N], I-th element is True if I-th variable |
//| must be fixed. Exception is thrown if array size is|
//| too small. |
//| BufR - possibly preallocated buffer; automatically resized|
//| if needed. It is recommended to reuse this buffer |
//| if you perform a lot of subsequent decompositions. |
//| OUTPUT PARAMETERS: |
//| A - updated factorization. If IsUpper=True, then the |
//| upper triangle contains matrix U, and the elements |
//| below the main diagonal are not modified. |
//| Similarly, if IsUpper = False. |
//+------------------------------------------------------------------+
void CTrFac::SPDMatrixCholeskyUpdateFixBuf(CMatrixDouble &A,int n,
bool IsUpper,bool &Fix[],
CRowDouble &BufR)
{
//--- create variables
int i=0;
int j=0;
int k=0;
int nfix=0;
int idx=0;
double cs=0;
double sn=0;
double v=0;
double vv=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(A.Rows()>=n,__FUNCTION__+": Rows(A)<N"))
return;
if(!CAp::Assert(A.Cols()>=n,__FUNCTION__+": Cols(A)<N"))
return;
if(!CAp::Assert(CAp::Len(Fix)>=n,__FUNCTION__+": Length(Fix)<N"))
return;
//--- Count number of variables to fix.
//--- Quick exit if NFix=0 or NFix=N
for(i=0; i<n; i++)
{
if(Fix[i])
nfix++;
}
if(nfix==0)
//--- Nothing to fix
return;
if(nfix==n)
{
//-- All variables are fixed.
//--- Set A to identity and exit.
if(IsUpper)
{
for(i=0; i<n; i++)
{
A.Set(i,i,1);
for(j=i+1; j<n; j++)
A.Set(i,j,0);
}
}
else
{
for(i=0; i<n; i++)
{
A.Set(i,i,1);
for(j=0; j<i; j++)
A.Set(i,j,0);
}
}
return;
}
//--- If working with upper triangular matrix
if(IsUpper)
{
//--- Perform a sequence of updates which fix variables one by one.
//--- This approach is different from one which is used when we work
//--- with lower triangular matrix.
CApServ::RVectorSetLengthAtLeast(BufR,n);
for(k=0; k<n; k++)
{
if(Fix[k])
{
idx=k;
//--- Quick exit if it is last variable
if(idx==n-1)
{
A.Set(idx,idx,1.0);
for(i=0; i<idx; i++)
A.Set(i,idx,0.0);
continue;
}
//--- We have Cholesky decomposition of quadratic term in A,
//--- with upper triangle being stored as given below:
//--- ( U00 u01 U02 )
//--- U = ( u11 u12 )
//--- ( U22 )
//--- Here u11 is diagonal element corresponding to variable K. We
//--- want to fix this variable, and we do so by modifying U as follows:
//--- ( U00 0 U02 )
//--- U_mod = ( 1 0 )
//--- ( U_m )
//--- with U_m = CHOLESKY [ (U22^T)*U22 + (u12^T)*u12 ]
//---
//--- Of course, we can calculate U_m by calculating (U22^T)*U22 explicitly,
//--- modifying it and performing Cholesky decomposition of modified matrix.
//--- However, we can treat it as follows:
//--- * we already have CHOLESKY[(U22^T)*U22], which is equal to U22
//--- * we have rank-1 update (u12^T)*u12 applied to (U22^T)*U22
//--- * thus, we can calculate updated Cholesky with O(N^2) algorithm
//--- instead of O(N^3) one
for(j=idx+1; j<n; j++)
BufR.Set(j,A.Get(idx,j));
for(i=0; i<idx; i++)
A.Set(i,idx,0.0);
A.Set(idx,idx,1.0);
for(i=idx+1; i<n; i++)
A.Set(idx,i,0.0);
for(i=idx+1; i<n; i++)
{
if(BufR[i]!=0.0)
{
CRotations::GenerateRotation(A.Get(i,i),BufR[i],cs,sn,v);
A.Set(i,i,v);
BufR.Set(i,0.0);
for(j=i+1; j<n; j++)
{
v=A.Get(i,j);
vv=BufR[j];
A.Set(i,j,(cs*v+sn*vv));
BufR.Set(j,-(sn*v)+cs*vv);
}
}
}
}
}
}
else
{
//--- Calculate rows of modified Cholesky factor, row-by-row
//--- (updates performed during variable fixing are applied
//--- simultaneously to each row)
CApServ::RVectorSetLengthAtLeast(BufR,3*n);
for(k=0; k<n; k++)
{
if(Fix[k])
{
idx=k;
//--- Quick exit if it is last variable
if(idx==n-1)
{
for(i=0; i<idx; i++)
A.Set(idx,i,0.0);
A.Set(idx,idx,1.0);
continue;
}
//--- store column to buffer and clear row/column of A
for(j=idx+1; j<n; j++)
BufR.Set(j,A.Get(j,idx));
for(i=0; i<idx ; i++)
A.Set(idx,i,0.0);
A.Set(idx,idx,1.0);
for(i=idx+1; i<n; i++)
A.Set(i,idx,0.0);
//--- Apply update to rows of A
for(i=idx+1; i<n; i++)
{
//--- Update all previous updates [Idx+1...I-1] to I-th row
vv=BufR[i];
for(j=idx+1; j<i; j++)
{
cs=BufR[n+2*j+0];
sn=BufR[n+2*j+1];
v=A.Get(i,j);
A.Set(i,j,(cs*v+sn*vv));
vv=-(sn*v)+cs*vv;
}
//--- generate rotation applied to I-th element of update vector
CRotations::GenerateRotation(A.Get(i,i),vv,cs,sn,v);
A.Set(i,i,v);
BufR.Set(n+2*i,cs);
BufR.Set(n+2*i+1,sn);
}
}
}
}
}
//+------------------------------------------------------------------+
//| Sparse LU decomposition with column pivoting for sparsity and row|
//| pivoting for stability. Input must be square sparse matrix stored|
//| in CRS format. |
//| The algorithm computes LU decomposition of a general square |
//| matrix (rectangular ones are not supported). The result of an |
//| algorithm is a representation of A as A = P * L * U * Q, where: |
//| * L is lower unitriangular matrix |
//| * U is upper triangular matrix |
//| * P = P0 * P1 * ...*PK, K = N - 1, Pi - permutation matrix for |
//| I and P[I] |
//| * Q = QK * ...*Q1 * Q0, K = N - 1, Qi - permutation matrix for |
//| I and Q[I] |
//| This function pivots columns for higher sparsity, and then pivots|
//| rows for stability(larger element at the diagonal). |
//| INPUT PARAMETERS: |
//| A - sparse NxN matrix in CRS format. An exception is|
//| generated if matrix is non-CRS or non-square. |
//| PivotType - pivoting strategy: |
//| * 0 for best pivoting available (2 in current |
//| version) |
//| * 1 for row - only pivoting(NOT RECOMMENDED) |
//| * 2 for complete pivoting which produces most |
//| sparse outputs |
//| OUTPUT PARAMETERS: |
//| A - the result of factorization, matrices L and U |
//| stored in compact form using CRS sparse storage |
//| format: |
//| * lower unitriangular L is stored strictly under|
//| main diagonal |
//| * upper triangilar U is stored ON and ABOVE main|
//| diagonal |
//| P - row permutation matrix in compact form, array[N]|
//| Q - col permutation matrix in compact form, array[N]|
//| This function always succeeds, i.e. it ALWAYS returns valid |
//| factorization, but for your convenience it also returns boolean |
//| value which helps to detect symbolically degenerate matrices: |
//| * function returns TRUE, if the matrix was factorized AND |
//| symbolically non-degenerate |
//| * function returns FALSE, if the matrix was factorized but U |
//| has strictly zero elements at the diagonal(the factorization |
//| is returned anyway). |
//+------------------------------------------------------------------+
bool CTrFac::SparseLU(CSparseMatrix &A,int pivottype,CRowInt &P,
CRowInt &Q)
{
CSLUV2Buffer buf2;
//--- check
if(!CAp::Assert((pivottype==0 || pivottype==1) || pivottype==2,__FUNCTION__+": unexpected pivot type"))
return(false);
if(!CAp::Assert(CSparse::SparseIsCRS(A),__FUNCTION__+": A is not stored in CRS format"))
return(false);
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": non-square A"))
return(false);
//--- return result
return(CSpTrf::SpTrfLU(A,pivottype,P,Q,buf2));
}
//+------------------------------------------------------------------+
//| Sparse Cholesky decomposition for skyline matrixm using in-place |
//| algorithm without allocating additional storage. |
//| The algorithm computes Cholesky decomposition of a symmetric |
//| positive - definite sparse matrix. The result of an algorithm is |
//| a representation of A as A = U ^ T * U or A = L * L ^ T |
//| This function allows to perform very efficient decomposition of |
//| low - profile matrices(average bandwidth is ~5-10 elements). For |
//| larger matrices it is recommended to use supernodal Cholesky |
//| decomposition: SparseCholeskyP() or |
//| SparseCholeskyAnalyze() / SparseCholeskyFactorize(). |
//| INPUT PARAMETERS: |
//| A - sparse matrix in skyline storage(SKS) format. |
//| N - size of matrix A(can be smaller than actual size |
//| of A) |
//| IsUpper - if IsUpper = True, then factorization is performed |
//| on upper triangle. Another triangle is ignored (it |
//| may contant some data, but it is not changed). |
//| OUTPUT PARAMETERS: |
//| A - the result of factorization, stored in SKS. If |
//| IsUpper = True, then the upper triangle contains |
//| matrix U, such that A = U ^ T * U. Lower triangle |
//| is not changed. Similarly, if IsUpper = False. In |
//| this case L is returned, and we have A = L * (L^T).|
//| Note that THIS function does not perform permutation of rows to |
//| reduce bandwidth. |
//| RESULT: |
//| If the matrix is positive - definite, the function returns True|
//| Otherwise, the function returns False. Contents of A is not |
//| determined in such case. |
//| NOTE: for performance reasons this function does NOT check that |
//| input matrix includes only finite values. It is your |
//| responsibility to make sure that there are no infinite or |
//| NAN values in the matrix. |
//+------------------------------------------------------------------+
bool CTrFac::SparseCholeskySkyLine(CSparseMatrix &A,
int n,
bool IsUpper)
{
//--- create variables
int i=0;
int j=0;
int k=0;
int jnz=0;
int jnza=0;
int jnzl=0;
double v=0;
double vv=0;
double a12=0;
int nready=0;
int nadd=1;
int banda=0;
int offsa=0;
int offsl=0;
//--- check
if(!CAp::Assert(n>=0,__FUNCTION__+": N<0"))
return(false);
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)>=n,__FUNCTION__+": rows(A)<N"))
return(false);
if(!CAp::Assert(CSparse::SparseGetNCols(A)>=n,__FUNCTION__+": cols(A)<N"))
return(false);
if(!CAp::Assert(CSparse::SparseIsSKS(A),__FUNCTION__+": A is not stored in SKS format"))
return(false);
//--- transpose if needed
if(IsUpper)
CSparse::SparseTransposeSKS(A);
//--- Perform Cholesky decomposition:
//--- * we assume than leading NReady*NReady submatrix is done
//--- * having Cholesky decomposition of NReady*NReady submatrix we
//--- obtain decomposition of larger (NReady+NAdd)*(NReady+NAdd) one.
//--- Here is algorithm. At the start we have
//--- ( | )
//--- ( L | )
//--- S = ( | )
//--- (----------)
//--- ( A | B )
//--- with L being already computed Cholesky factor, A and B being
//--- unprocessed parts of the matrix. Of course, L/A/B are stored
//--- in SKS format.
//--- Then, we calculate A1:=(inv(L)*A')' and replace A with A1.
//--- Then, we calculate B1:=B-A1*A1' and replace B with B1
//--- Finally, we calculate small NAdd*NAdd Cholesky of B1 with
//--- dense solver. Now, L/A1/B1 are Cholesky decomposition of the
//--- larger (NReady+NAdd)*(NReady+NAdd) matrix.
while(nready<n)
{
//--- check
if(!CAp::Assert(nadd==1,__FUNCTION__+": internal error"))
return(false);
//--- Calculate A1:=(inv(L)*A')'
//--- Elements are calculated row by row (example below is given
//--- for NAdd=1):
//--- * first, we solve L[0,0]*A1[0]=A[0]
//--- * then, we solve L[1,0]*A1[0]+L[1,1]*A1[1]=A[1]
//--- * then, we move to next row and so on
//--- * during calculation of A1 we update A12 - squared norm of A1
//--- We extensively use sparsity of both A/A1 and L:
//--- * first, equations from 0 to BANDWIDTH(A1)-1 are completely zero
//--- * second, for I>=BANDWIDTH(A1), I-th equation is reduced from
//--- L[I,0]*A1[0] + L[I,1]*A1[1] + ... + L[I,I]*A1[I] = A[I]
//--- to
//--- L[I,JNZ]*A1[JNZ] + ... + L[I,I]*A1[I] = A[I]
//--- where JNZ = max(NReady-BANDWIDTH(A1),I-BANDWIDTH(L[i]))
//--- (JNZ is an index of the firts column where both A and L become
//--- nonzero).
//--- NOTE: we rely on details of SparseMatrix internal storage format.
//--- This is allowed by SparseMatrix specification.
a12=0;
if(A.m_DIdx[nready]>0)
{
banda=A.m_DIdx[nready];
for(i=nready-banda; i<nready; i++)
{
//--- Elements of A1[0:I-1] were computed:
//--- * A1[0:NReady-BandA-1] are zero (sparse)
//--- * A1[NReady-BandA:I-1] replaced corresponding elements of A
//--- Now it is time to get I-th one.
//--- First, we calculate:
//--- * JNZA - index of the first column where A become nonzero
//--- * JNZL - index of the first column where L become nonzero
//--- * JNZ - index of the first column where both A and L become nonzero
//--- * OffsA - offset of A[JNZ] in A.Vals
//--- * OffsL - offset of L[I,JNZ] in A.Vals
//--- Then, we solve SUM(A1[j]*L[I,j],j=JNZ..I-1) + A1[I]*L[I,I] = A[I],
//--- with A1[JNZ..I-1] already known, and A1[I] unknown.
jnza=nready-banda;
jnzl=i-A.m_DIdx[i];
jnz=MathMax(jnza,jnzl);
offsa=A.m_RIdx[nready]+(jnz-jnza);
offsl=A.m_RIdx[i]+(jnz-jnzl);
v=0.0;
k=i-1-jnz;
for(j=0; j<=k; j++)
v+=A.m_Vals[offsa+j]*A.m_Vals[offsl+j];
vv=(A.m_Vals[offsa+k+1]-v)/A.m_Vals[offsl+k+1];
A.m_Vals.Set(offsa+k+1,vv);
a12+=vv*vv;
}
}
//--- Calculate CHOLESKY(B-A1*A1')
offsa=A.m_RIdx[nready]+A.m_DIdx[nready];
v=A.m_Vals[offsa];
if(v<=a12)
return(false);
A.m_Vals.Set(offsa,MathSqrt(v-a12));
//--- Increase size of the updated matrix
nready++;
}
//--- transpose if needed
if(IsUpper)
CSparse::SparseTransposeSKS(A);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Sparse Cholesky decomposition for a matrix stored in any sparse |
//| storage, without rows/cols permutation. |
//| This function is the most convenient(less parameters to specify),|
//| although less efficient, version of sparse Cholesky. |
//| Internally it: |
//| * calls SparseCholeskyAnalyze() function to perform symbolic |
//| analysis phase with no permutation being configured. |
//| * calls SparseCholeskyFactorize() function to perform numerical|
//| phase of the factorization |
//| Following alternatives may result in better performance: |
//| * using SparseCholeskyP(), which selects best pivoting |
//| available, which almost always results in improved sparsity |
//| and cache locality |
//| * using SparseCholeskyAnalyze() and SparseCholeskyFactorize() |
//| functions directly, which may improve performance of |
//| repetitive factorizations with same sparsity patterns. |
//| The latter also allows one to perform LDLT factorization of |
//| indefinite matrix(one with strictly diagonal D, which is known to|
//| be stable only in few special cases, like quasi - definite |
//| matrices). |
//| INPUT PARAMETERS: |
//| A - a square NxN sparse matrix, stored in any storage |
//| format. |
//| IsUpper - if IsUpper=True, then factorization is performed on|
//| upper triangle. Another triangle is ignored on |
//| input, dropped on output. Similarly, if |
//| IsUpper=False, the lower triangle is processed. |
//| OUTPUT PARAMETERS: |
//| A - the result of factorization, stored in CRS format: |
//| * if IsUpper = True, then the upper triangle contains matrix|
//| U such that A = U ^ T * U and the lower triangle is empty.|
//| * similarly, if IsUpper = False, then lower triangular L is|
//| returned and we have A = L * (L^T). |
//| Note that THIS function does not perform permutation of the rows |
//| to reduce fill-in. |
//| RESULT: |
//| If the matrix is positive-definite, the function returns True. |
//| Otherwise, the function returns False. Contents of A is |
//| undefined in such case. |
//| NOTE: for performance reasons this function does NOT check that |
//| input matrix includes only finite values. It is your |
//| responsibility to make sure that there are no infinite or |
//| NAN values in the matrix. |
//+------------------------------------------------------------------+
bool CTrFac::SparseCholesky(CSparseMatrix &A,bool IsUpper)
{
//--- create variables
CSparseDecompositionAnalysis analysis;
int facttype=0;
int PermType=-1;
CRowInt priorities;
CRowDouble dummyd;
CRowInt dummyp;
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": A is not square"))
return(false);
//--- Quick exit
if(CSparse::SparseGetNRows(A)==0)
return(true);
//--- Choose factorization and permutation: vanilla Cholesky and no permutation,
//--- Priorities[] array is not set.
//--- Easy case - CRS matrix in lower triangle, no conversion or transposition is needed
if(CSparse::SparseIsCRS(A) && !IsUpper)
{
if(!CSpChol::SpSymmAnalyze(A,priorities,facttype,PermType,analysis.m_Analysis))
return(false);
if(!CSpChol::SpSymmFactorize(analysis.m_Analysis))
return(false);
CSpChol::SpSymmExtract(analysis.m_Analysis,A,dummyd,dummyp);
return(true);
}
//--- A bit more complex - we need conversion and/or transposition
if(IsUpper)
{
CSparse::SparseCopyToCRSBuf(A,analysis.m_WrkAT);
CSparse::SparseCopyTransposeCRSBuf(analysis.m_WrkAT,analysis.m_WrkA);
}
else
CSparse::SparseCopyToCRSBuf(A,analysis.m_WrkA);
if(!CSpChol::SpSymmAnalyze(analysis.m_WrkA,priorities,facttype,PermType,analysis.m_Analysis))
return(false);
if(!CSpChol::SpSymmFactorize(analysis.m_Analysis))
return(false);
CSpChol::SpSymmExtract(analysis.m_Analysis,analysis.m_WrkA,dummyd,dummyp);
if(IsUpper)
CSparse::SparseCopyTransposeCRSBuf(analysis.m_WrkA,A);
else
CSparse::SparseCopyBuf(analysis.m_WrkA,A);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Sparse Cholesky decomposition for a matrix stored in any sparse |
//| storage format, with performance - enhancing permutation of |
//| rows/cols. |
//| Present version is configured to perform supernodal permutation |
//| which sparsity reducing ordering. |
//| This function is a wrapper around generic sparse decomposition |
//| functions that internally : |
//| * calls SparseCholeskyAnalyze() function to perform symbolic |
//| analysis phase with best available permutation being |
//| configured. |
//| * calls SparseCholeskyFactorize() function to perform numerical|
//| phase of the factorization. |
//| NOTE: using SparseCholeskyAnalyze() and SparseCholeskyFactorize()|
//| directly may improve performance of repetitive |
//| factorizations with same sparsity patterns. It also allows |
//| one to perform LDLT factorization of indefinite matrix - a |
//| factorization with strictly diagonal D, which is known to |
//| be stable only in few special cases, like quasi - definite |
//| matrices. |
//| INPUT PARAMETERS: |
//| A - a square NxN sparse matrix, stored in any storage |
//| format. |
//| IsUpper - if IsUpper=True, then factorization is performed on|
//| upper triangle. Another triangle is ignored on |
//| input, dropped on output. Similarly, if |
//| IsUpper=False, the lower triangle is processed. |
//| OUTPUT PARAMETERS: |
//| A - the result of factorization, stored in CRS format: |
//| * if IsUpper = True, then the upper triangle contains matrix|
//| U such that A = U ^ T * U and the lower triangle is empty.|
//| * similarly, if IsUpper = False, then lower triangular L is|
//| returned and we have A = L * (L^T). |
//| P - a row / column permutation, a product of |
//| P0 * P1 * ...*Pk, k = N - 1, with Pi being |
//| permutation of rows / cols I and P[I] |
//| RESULT: |
//| If the matrix is positive-definite, the function returns True. |
//| Otherwise, the function returns False. Contents of A is |
//| undefined in such case. |
//| NOTE: for performance reasons this function does NOT check that |
//| input matrix includes only finite values. It is your |
//| responsibility to make sure that there are no infinite or |
//| NAN values in the matrix. |
//+------------------------------------------------------------------+
bool CTrFac::SparseCholeskyP(CSparseMatrix &A,
bool IsUpper,
CRowInt &p)
{
//--- create variables
CSparseDecompositionAnalysis analysis;
CRowDouble dummyd;
int facttype=0;
int PermType=0;
CRowInt priorities;
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": A is not square"))
return(false);
//--- Quick exit
if(CSparse::SparseGetNRows(A)==0)
return(true);
//--- Choose factorization and permutation: vanilla Cholesky and best permutation available.
//--- Priorities[] array is not set.
//--- Easy case - CRS matrix in lower triangle, no conversion or transposition is needed
if(CSparse::SparseIsCRS(A) && !IsUpper)
{
if(!CSpChol::SpSymmAnalyze(A,priorities,facttype,PermType,analysis.m_Analysis))
return(false);
if(!CSpChol::SpSymmFactorize(analysis.m_Analysis))
return(false);
CSpChol::SpSymmExtract(analysis.m_Analysis,A,dummyd,p);
return(true);
}
//--- A bit more complex - we need conversion and/or transposition
if(IsUpper)
{
CSparse::SparseCopyToCRSBuf(A,analysis.m_WrkAT);
CSparse::SparseCopyTransposeCRSBuf(analysis.m_WrkAT,analysis.m_WrkA);
}
else
{
CSparse::SparseCopyToCRSBuf(A,analysis.m_WrkA);
}
if(!CSpChol::SpSymmAnalyze(analysis.m_WrkA,priorities,facttype,PermType,analysis.m_Analysis))
return(false);
if(!CSpChol::SpSymmFactorize(analysis.m_Analysis))
return(false);
CSpChol::SpSymmExtract(analysis.m_Analysis,analysis.m_WrkA,dummyd,p);
if(IsUpper)
CSparse::SparseCopyTransposeCRSBuf(analysis.m_WrkA,A);
else
CSparse::SparseCopyBuf(analysis.m_WrkA,A);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Sparse Cholesky/LDLT decomposition: symbolic analysis phase. |
//| This function is a part of the 'expert' sparse Cholesky API: |
//| * SparseCholeskyAnalyze(), that performs symbolic analysis |
//| phase and loads matrix to be factorized into internal |
//| storage |
//| * SparseCholeskySetModType(), that allows to use modified |
//| Cholesky/LDLT with lower bounds on pivot magnitudes and |
//| additional overflow safeguards |
//| * SparseCholeskyFactorize(), that performs numeric |
//| factorization using precomputed symbolic analysis and |
//| internally stored matrix - and outputs result |
//| * SparseCholeskyReload(), that reloads one more matrix with |
//| same sparsity pattern into internal storage so one may |
//| reuse previously allocated temporaries and previously |
//| performed symbolic analysis |
//| This specific function performs preliminary analysis of the |
//| Cholesky/LDLT factorization. It allows to choose different |
//| permutation types and to choose between classic Cholesky and |
//| indefinite LDLT factorization(the latter is computed with |
//| strictly diagonal D, i.e. without Bunch-Kauffman pivoting). |
//| NOTE: L*D*LT family of factorization may be used to factorize |
//| indefinite matrices. However, numerical stability is |
//| guaranteed ONLY for a class of quasi - definite matrices. |
//| NOTE: all internal processing is performed with lower triangular |
//| matrices stored in CRS format. Any other storage formats |
//| and/or upper triangular storage means that one format |
//| conversion and/or one transposition will be performed |
//| internally for the analysis and factorization phases. Thus,|
//| highest performance is achieved when input is a lower |
//| triangular CRS matrix. |
//| INPUT PARAMETERS: |
//| A - sparse square matrix in any sparse storage format. |
//| IsUpper - whether upper or lower triangle is decomposed (the |
//| other one is ignored). |
//| FactType - factorization type: |
//| * 0 for traditional Cholesky of SPD matrix |
//| * 1 for LDLT decomposition with strictly diagonal D, which |
//| may have non - positive entries. |
//| PermType - permutation type: |
//| * -1 for absence of permutation |
//| * 0 for best fill - in reducing permutation available, |
//| which is 3 in the current version |
//| * 1 for supernodal ordering(improves locality and |
//| performance, does NOT change fill - in factor) |
//| * 2 for original AMD ordering |
//| * 3 for improved AMD(approximate minimum degree) |
//| ordering with better handling of matrices with dense |
//| rows/columns |
//| OUTPUT PARAMETERS: |
//| Analysis - contains: |
//| * symbolic analysis of the matrix structure which will be |
//| used later to guide numerical factorization. |
//| * specific numeric values loaded into internal memory |
//| waiting for the factorization to be performed |
//| This function fails if and only if the matrix A is symbolically |
//| degenerate i.e. has diagonal element which is exactly zero. In |
//| such case False is returned, contents of Analysis object is |
//| undefined. |
//+------------------------------------------------------------------+
bool CTrFac::SparseCholeskyAnalyze(CSparseMatrix &A,bool IsUpper,
int facttype,int PermType,
CSparseDecompositionAnalysis &Analysis)
{
//--- create variables
CRowInt priorities;
bool result;
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": A is not square"))
return(false);
if(!CAp::Assert(facttype==0 || facttype==1,__FUNCTION__+": unexpected FactType"))
return(false);
if(!CAp::Assert(MathAbs(PermType)<=3,__FUNCTION__+": unexpected PermType"))
return(false);
//--- Prepare wrapper object
Analysis.m_N=CSparse::SparseGetNRows(A);
Analysis.m_FactType=facttype;
Analysis.m_PermType=PermType;
//--- Prepare default priorities for the priority ordering
if(MathAbs(PermType)==3)
CAblasF::ISetAllocV(Analysis.m_N,0,priorities);
//--- Analyse
if(!CSparse::SparseIsCRS(A))
{
//--- The matrix is stored in non-CRS format. First, we have to convert
//--- it to CRS. Then we may need to transpose it in order to get lower
//--- triangular one (as supported by SPSymmAnalyze).
CSparse::SparseCopyToCRS(A,Analysis.m_CrsA);
if(IsUpper)
{
CSparse::SparseCopyTransposeCRSBuf(Analysis.m_CrsA,Analysis.m_CrsAT);
result=CSpChol::SpSymmAnalyze(Analysis.m_CrsAT,priorities,facttype,PermType,Analysis.m_Analysis);
}
else
result=CSpChol::SpSymmAnalyze(Analysis.m_CrsA,priorities,facttype,PermType,Analysis.m_Analysis);
}
else
{
//--- The matrix is stored in CRS format. However we may need to
//--- transpose it in order to get lower triangular one (as supported
//--- by SPSymmAnalyze).
if(IsUpper)
{
CSparse::SparseCopyTransposeCRSBuf(A,Analysis.m_CrsAT);
result=CSpChol::SpSymmAnalyze(Analysis.m_CrsAT,priorities,facttype,PermType,Analysis.m_Analysis);
}
else
{
result=CSpChol::SpSymmAnalyze(A,priorities,facttype,PermType,Analysis.m_Analysis);
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Allows to control stability - improving modification strategy for|
//| sparse Cholesky/LDLT decompositions. Modified Cholesky is more |
//| robust than its unmodified counterpart. |
//| This function is a part of the 'expert' sparse Cholesky API: |
//| * SparseCholeskyAnalyze(), that performs symbolic analysis |
//| phase and loads matrix to be factorized into internal storage|
//| * SparseCholeskySetModType(), that allows to use modified |
//| Cholesky/LDLT with lower bounds on pivot magnitudes and |
//| additional overflow safeguards |
//| * SparseCholeskyFactorize(), that performs numeric |
//| factorization using precomputed symbolic analysis and |
//| internally stored matrix - and outputs result |
//| * SparseCholeskyReload(), that reloads one more matrix with |
//| same sparsity pattern into internal storage so one may reuse |
//| previously allocated temporaries and previously performed |
//| symbolic analysis |
//| INPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure |
//| ModStrategy - modification type: |
//| * 0 for traditional Cholesky/LDLT(Cholesky fails when |
//| encounters nonpositive pivot, LDLT fails when zero pivot|
//| is encountered, no stability checks for overflows / |
//| underflows) |
//| * 1 for modified Cholesky with additional checks: |
//| * pivots less than ModParam0 are increased; (similar sign - |
//| preserving procedure is applied during LDLT) |
//| * if, at some moment, sum of absolute values of elements in |
//| column J will become greater than ModParam1, Cholesky/LDLT|
//| will treat it as failure and will stop immediately |
//| P0, P1, P2, P3 - modification parameters #0 #1, #2 and #3. |
//| Params #2 and #3 are ignored in current version.|
//| OUTPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure, new |
//| strategy |
//| Results will be seen with next SparseCholeskyFactorize() call. |
//+------------------------------------------------------------------+
void CTrFac::SparseCholeskySetModType(CSparseDecompositionAnalysis &Analysis,
int modstrategy,double p0,double p1,
double p2,double p3)
{
CSpChol::SpSymmSetModificationStrategy(Analysis.m_Analysis,modstrategy,p0,p1,p2,p3);
}
//+------------------------------------------------------------------+
//| Sparse Cholesky decomposition: numerical analysis phase. |
//| This function is a part of the 'expert' sparse Cholesky API: |
//| * SparseCholeskyAnalyze(), that performs symbolic analysis |
//| phase and loads matrix to be factorized into internal |
//| storage |
//| * SparseCholeskySetModType(), that allows to use modified |
//| Cholesky/LDLT with lower bounds on pivot magnitudes and |
//| additional overflow safeguards |
//| * SparseCholeskyFactorize(), that performs numeric |
//| factorization using precomputed symbolic analysis and |
//| internally stored matrix - and outputs result |
//| * SparseCholeskyReload(), that reloads one more matrix with |
//| same sparsity pattern into internal storage so one may |
//| reuse previously allocated temporaries and previously |
//| performed symbolic analysis |
//| Depending on settings specified during SparseCholeskyAnalyze() |
//| call it may produce classic Cholesky or L*D*LT decomposition |
//| (with strictly diagonal D), without permutation or with |
//| performance - enhancing permutation P. |
//| NOTE: all internal processing is performed with lower triangular |
//| matrices stored in CRS format. Any other storage formats |
//| and/or upper triangular storage means that one format |
//| conversion and/or one transposition will be performed |
//| internally for the analysis and factorization phases. Thus,|
//| highest performance is achieved when input is a lower |
//| triangular CRS matrix, and lower triangular output is |
//| requested. |
//| NOTE: L*D*LT family of factorization may be used to factorize |
//| indefinite matrices. However, numerical stability is |
//| guaranteed ONLY for a class of quasi - definite matrices. |
//| INPUT PARAMETERS: |
//| Analysis - prior analysis with internally stored matrix |
//| which will be factorized |
//| NeedUpper - whether upper triangular or lower triangular |
//| output is needed |
//| OUTPUT PARAMETERS: |
//| A - Cholesky decomposition of A stored in lower |
//| triangular CRS format, i.e. A = L * L' (or upper|
//| triangular CRS, with A = U'*U, depending on |
//| NeedUpper parameter). |
//| D - array[N], diagonal factor. If no diagonal factor|
//| was required during analysis phase, still |
//| returned but filled with 1's |
//| P - array[N], pivots. Permutation matrix P is a |
//| product of P(0) * P(1) * ...*P(N - 1), |
//| where P(i) is a permutation of row/col I and |
//| P[I] (with P[I] >= I). |
//| If no permutation was requested during analysis phase, still |
//| returned but filled with identity permutation. |
//| The function returns True when factorization resulted in |
//| nondegenerate matrix. False is returned when factorization fails |
//| (Cholesky factorization of indefinite matrix) or LDLT |
//| factorization has exactly zero elements at the diagonal. In the |
//| latter case contents of A, D and P is undefined. |
//| The analysis object is not changed during the factorization. |
//| Subsequent calls to SparseCholeskyFactorize() will result in same|
//| factorization being performed one more time. |
//+------------------------------------------------------------------+
bool CTrFac::SparseCholeskyFactorize(CSparseDecompositionAnalysis &Analysis,
bool NeedUpper,
CSparseMatrix &A,
CRowDouble &d,
CRowInt &p)
{
//--- check
if(!CSpChol::SpSymmFactorize(Analysis.m_Analysis))
return(false);
if(NeedUpper)
{
CSpChol::SpSymmExtract(Analysis.m_Analysis,Analysis.m_WrkA,d,p);
CSparse::SparseCopyTransposeCRSBuf(Analysis.m_WrkA,A);
}
else
{
CSpChol::SpSymmExtract(Analysis.m_Analysis,A,d,p);
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Sparse Cholesky decomposition: update internally stored matrix |
//| with another one with exactly same sparsity pattern. |
//| This function is a part of the 'expert' sparse Cholesky API: |
//| * SparseCholeskyAnalyze(), that performs symbolic analysis |
//| phase and loads matrix to be factorized into internal |
//| storage |
//| * SparseCholeskySetModType(), that allows to use modified |
//| Cholesky/LDLT with lower bounds on pivot magnitudes and |
//| additional overflow safeguards |
//| * SparseCholeskyFactorize(), that performs numeric |
//| factorization using precomputed symbolic analysis and |
//| internally stored matrix - and outputs result |
//| * SparseCholeskyReload(), that reloads one more matrix with |
//| same sparsity pattern into internal storage so one may |
//| reuse previously allocated temporaries and previously |
//| performed symbolic analysis |
//| This specific function replaces internally stored numerical |
//| values with ones from another sparse matrix (but having exactly |
//| same sparsity pattern as one that was used for initial |
//| SparseCholeskyAnalyze() call). |
//| NOTE: all internal processing is performed with lower triangular |
//| matrices stored in CRS format. Any other storage formats |
//| and/or upper triangular storage means that one format |
//| conversion and/or one transposition will be performed |
//| internally for the analysis and factorization phases. Thus,|
//| highest performance is achieved when input is a lower |
//| triangular CRS matrix. |
//| INPUT PARAMETERS: |
//| Analysis - analysis object |
//| A - sparse square matrix in any sparse storage format. |
//| It MUST have exactly same sparsity pattern as that |
//| of the matrix that was passed to |
//| SparseCholeskyAnalyze(). Any difference (missing |
//| elements or additional elements) may result in |
//| unpredictable and undefined behavior - an algorithm|
//| may fail due to memory access violation. |
//| IsUpper - whether upper or lower triangle is decomposed (the |
//| other one is ignored). |
//| OUTPUT PARAMETERS: |
//| Analysis - contains: |
//| * symbolic analysis of the matrix structure which will be |
//| used later to guide numerical factorization. |
//| * specific numeric values loaded into internal memory |
//| waiting for the factorization to be performed |
//+------------------------------------------------------------------+
void CTrFac::SparseCholeskyReload(CSparseDecompositionAnalysis &Analysis,
CSparseMatrix &A,
bool IsUpper)
{
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": A is not square"))
return;
if(!CAp::Assert(CSparse::SparseGetNRows(A)==Analysis.m_N,__FUNCTION__+": size of A does not match that stored in Analysis"))
return;
if(!CSparse::SparseIsCRS(A))
{
//--- The matrix is stored in non-CRS format. First, we have to convert
//--- it to CRS. Then we may need to transpose it in order to get lower
//--- triangular one (as supported by SPSymmAnalyze).
CSparse::SparseCopyToCRS(A,Analysis.m_CrsA);
if(IsUpper)
CSparse::SparseCopyTransposeCRSBuf(Analysis.m_CrsA,Analysis.m_CrsAT);
CSpChol::SpSymmReload(Analysis.m_Analysis,Analysis.m_CrsA);
}
else
{
//--- The matrix is stored in CRS format. However we may need to
//--- transpose it in order to get lower triangular one (as supported
//--- by SPSymmAnalyze).
if(IsUpper)
{
CSparse::SparseCopyTransposeCRSBuf(A,Analysis.m_CrsAT);
CSpChol::SpSymmReload(Analysis.m_Analysis,Analysis.m_CrsAT);
}
else
CSpChol::SpSymmReload(Analysis.m_Analysis,A);
}
}
//+------------------------------------------------------------------+
//| LUP decomposition of general real matrix |
//+------------------------------------------------------------------+
void CTrFac::RMatrixLUP(CMatrixDouble &A,const int m,const int n,int &pivots[])
{
CRowInt Pivots;
RMatrixLUP(A,m,n,Pivots);
Pivots.ToArray(pivots);
}
//+------------------------------------------------------------------+
//| LUP decomposition of general real matrix |
//+------------------------------------------------------------------+
void CTrFac::RMatrixLUP(CMatrixDouble &A,const int m,const int n,CRowInt &pivots)
{
//--- create variables
int i=0;
int j=0;
double mx=0;
double v=0;
int i_=0;
//--- create array
CRowDouble tmp;
//--- Internal LU decomposition subroutine.
//--- Never call it directly.
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- Scale matrix to avoid overflows,
//--- decompose it, then scale back.
mx=0;
for(i=0; i<m; i++)
mx=MathMax(mx,CAblasF::RMaxAbsR(n,A,i));
//--- check
if(mx!=0.0)
{
v=1/mx;
//--- change matrix
A*=v;
}
//--- allocation
pivots.Resize(MathMin(m,n));
tmp.Resize(2*MathMax(m,n));
//--- function call
CDLU::RMatrixLUPRec(A,0,m,n,pivots,tmp);
//--- check
if(mx!=0.0)
{
v=mx;
//--- get result
for(i=0; i<m; i++)
for(i_=0; i_<=MathMin(i,n-1); i_++)
A.Set(i,i_,v*A.Get(i,i_));
}
}
//+------------------------------------------------------------------+
//| LUP decomposition of general complex matrix |
//+------------------------------------------------------------------+
void CTrFac::CMatrixLUP(CMatrixComplex &a,const int m,const int n,int &pivots[])
{
CRowInt Pivots=pivots;
CMatrixLUP(a,m,n,Pivots);
Pivots.ToArray(pivots);
}
//+------------------------------------------------------------------+
//| LUP decomposition of general complex matrix |
//+------------------------------------------------------------------+
void CTrFac::CMatrixLUP(CMatrixComplex &a,const int m,const int n,CRowInt &pivots)
{
//--- create variables
int i=0;
int j=0;
double mx=0;
double v=0;
int i_=0;
//--- create array
CRowComplex tmp;
//--- Internal LU decomposition subroutine.
//--- Never call it directly.
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- Scale matrix to avoid overflows,
//--- decompose it, then scale back.
mx=0;
for(i=0; i<m; i++)
{
for(j=0; j<n; j++)
mx=MathMax(mx,CMath::AbsComplex(a.Get(i,j)));
}
//--- check
if(mx!=0.0)
{
v=1/mx;
//--- change matrix
a*=v;
}
//--- allocation
pivots.Resize(MathMin(m,n));
tmp.Resize(2*MathMax(m,n));
//--- function call
CDLU::CMatrixLUPRec(a,0,m,n,pivots,tmp);
//--- check
if(mx!=0.0)
{
v=mx;
//--- get result
for(i=0; i<m; i++)
{
for(i_=0; i_<=MathMin(i,n-1); i_++)
a.Set(i,i_,v*a.Get(i,i_));
}
}
}
//+------------------------------------------------------------------+
//| PLU decomposition of general real matrix |
//+------------------------------------------------------------------+
void CTrFac::RMatrixPLU(CMatrixDouble &a,const int m,const int n,int &pivots[])
{
CRowInt Pivots;
RMatrixPLU(a,m,n,Pivots);
Pivots.ToArray(pivots);
}
//+------------------------------------------------------------------+
//| PLU decomposition of general real matrix |
//+------------------------------------------------------------------+
void CTrFac::RMatrixPLU(CMatrixDouble &a,const int m,const int n,CRowInt &pivots)
{
//--- create variables
int i=0;
int j=0;
double mx=0;
int i_=0;
//--- create array
CRowDouble tmp;
//--- Internal LU decomposition subroutine.
//--- Never call it directly.
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- allocation
tmp.Resize(2*MathMax(m,n));
pivots.Resize(MathMin(m,n));
//--- Scale matrix to avoid overflows,
//--- decompose it, then scale back.
mx=0;
for(i=0; i<m; i++)
mx=MathMax(mx,CAblasF::RMaxAbsR(n,a,i));
//--- check
if(mx!=0.0)
{
//--- change matrix
double v=1.0/mx;
for(i=0; i<m; i++)
for(i_=0; i_<n; i_++)
a.Mul(i,i_,v);
}
//--- function call
CDLU::RMatrixPLURec(a,0,m,n,pivots,tmp);
//--- check
if(mx!=0.0)
{
//--- get result
for(i=0; i<MathMin(m,n); i++)
for(i_=i; i_<n; i_++)
a.Mul(i,i_,mx);
}
}
//+------------------------------------------------------------------+
//| PLU decomposition of general complex matrix |
//+------------------------------------------------------------------+
void CTrFac::CMatrixPLU(CMatrixComplex &a,const int m,const int n,int &pivots[])
{
CRowInt Pivots;
CMatrixPLU(a,m,n,Pivots);
Pivots.ToArray(pivots);
}
//+------------------------------------------------------------------+
//| PLU decomposition of general complex matrix |
//+------------------------------------------------------------------+
void CTrFac::CMatrixPLU(CMatrixComplex &a,const int m,const int n,CRowInt &pivots)
{
//--- create variables
int i=0;
int j=0;
double mx=0;
int i_=0;
//--- create array
CRowComplex tmp;
//--- Internal LU decomposition subroutine.
//--- Never call it directly.
if(!CAp::Assert(m>0,__FUNCTION__+": incorrect M!"))
return;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": incorrect N!"))
return;
//--- allocation
tmp.Resize(2*MathMax(m,n));
pivots.Resize(MathMin(m,n));
//--- Scale matrix to avoid overflows,
//--- decompose it, then scale back.
mx=0;
for(i=0; i<m; i++)
for(j=0; j<n; j++)
mx=MathMax(mx,CMath::AbsComplex(a.Get(i,j)));
//--- check
if(mx!=0.0)
//--- change matrix
for(i=0; i<m; i++)
for(j=0; j<n; j++)
a.Set(i,j,a.Get(i,j)/mx);
//--- function call
CDLU::CMatrixPLURec(a,0,m,n,pivots,tmp);
//--- check
if(mx!=0.0)
//--- get result
for(i=0; i<MathMin(m,n); i++)
for(i_=i; i_<n; i_++)
a.Mul(i,i_,mx);
}
//+------------------------------------------------------------------+
//| Recursive computational subroutine for SPDMatrixCholesky. |
//| INPUT PARAMETERS: |
//| A - matrix given by upper or lower triangle |
//| Offs - offset of diagonal block to decompose |
//| N - diagonal block size |
//| IsUpper - what half is given |
//| Tmp - temporary array; allocated by function, if its |
//| size is too small; can be reused on subsequent |
//| calls. |
//| OUTPUT PARAMETERS: |
//| A - upper (or lower) triangle contains Cholesky |
//| decomposition |
//| RESULT: |
//| True, on success |
//| False, on failure |
//+------------------------------------------------------------------+
bool CTrFac::SPDMatrixCholeskyRec(CMatrixDouble &a,const int Offs,const int n,
const bool IsUpper,double &tmp[])
{
CRowDouble Tmp;
if(!SPDMatrixCholeskyRec(a,Offs,n,IsUpper,Tmp))
return(false);
return(Tmp.ToArray(tmp));
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
bool CTrFac::SPDMatrixCholeskyRec(CMatrixDouble &a,const int Offs,const int n,
const bool IsUpper,CRowDouble &tmp)
{
//--- check
if(n<1)
return(false);
//--- create variables
bool result=false;
int n1=0;
int n2=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
//--- prepare bufer
CApServ::RVectorSetLengthAtLeast(tmp,2*n);
//--- Basecases
if(n==1)
{
//--- check
if(a.Get(Offs,Offs)>0.0)
{
a.Set(Offs,Offs,MathSqrt(a.Get(Offs,Offs)));
result=true;
}
//--- return result
return(result);
}
if(n<=tsa)
return(SPDMatrixCholesky2(a,Offs,n,IsUpper,tmp));
//--- Split task into smaller ones
if(n>tsb)
{
//--- Split leading B-sized block from the beginning (block-matrix approach)
n1=tsb;
n2=n-n1;
}
else
//--- Smaller than B-size, perform cache-oblivious split
CApServ::TiledSplit(n,tsa,n1,n2);
result=SPDMatrixCholeskyRec(a,Offs,n1,IsUpper,tmp);
if(!result)
return(result);
if(n2>0)
{
if(IsUpper)
{
CAblas::RMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,false,1,a,Offs,Offs+n1);
CAblas::RMatrixSyrk(n2,n1,-1.0,a,Offs,Offs+n1,1,1.0,a,Offs+n1,Offs+n1,IsUpper);
}
else
{
CAblas::RMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,false,1,a,Offs+n1,Offs);
CAblas::RMatrixSyrk(n2,n1,-1.0,a,Offs+n1,Offs,0,1.0,a,Offs+n1,Offs+n1,IsUpper);
}
result=SPDMatrixCholeskyRec(a,Offs+n1,n2,IsUpper,tmp);
if(!result)
return(result);
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
class CDLU
{
public:
static void CMatrixLUPRec(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp);
static void RMatrixLUPRec(CMatrixDouble &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowDouble &tmp);
static void CMatrixPLURec(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp);
static void RMatrixPLURec(CMatrixDouble &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowDouble &tmp);
private:
static void CMatrixLUP2(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp);
static void RMatrixLUP2(CMatrixDouble &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowDouble &tmp);
static void CMatrixPLU2(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp);
static void RMatrixPLU2(CMatrixDouble &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowDouble &tmp);
};
//+------------------------------------------------------------------+
//| Recurrent complex LU subroutine. |
//| Never call it directly. |
//+------------------------------------------------------------------+
void CDLU::CMatrixLUPRec(CMatrixComplex &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowComplex &tmp)
{
//--- create variables
int i=0;
int m1=0;
int m2=0;
int i_=0;
int i1_=0;
complex One(1.0,0.0);
complex _One(-1.0,0.0);
//--- Kernel case
if(MathMin(m,n)<=CAblas::AblasComplexBlockSize())
{
CMatrixLUP2(a,Offs,m,n,pivots,tmp);
//--- exit the function
return;
}
//--- Preliminary step, make N>=M
//--- ( A1 )
//--- A = ( ), where A1 is square
//--- ( A2 )
//--- Factorize A1, update A2
if(m>n)
{
//--- function call
CMatrixLUPRec(a,Offs,n,n,pivots,tmp);
for(i=0; i<n; i++)
{
i1_=Offs+n;
for(i_=0; i_<m-n; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+i));
//--- change matrix
for(i_=Offs+n; i_<Offs+m; i_++)
a.Set(i_,Offs+i,a.Get(i_,pivots[Offs+i]));
i1_=-(Offs+n);
for(i_=Offs+n; i_<Offs+m; i_++)
a.Set(i_,pivots[Offs+i],tmp[i_+i1_]);
}
//--- function call
CAblas::CMatrixRightTrsM(m-n,n,a,Offs,Offs,true,true,0,a,Offs+n,Offs);
//--- exit the function
return;
}
//--- Non-kernel case
CAblas::AblasComplexSplitLength(a,m,m1,m2);
//--- function call
CMatrixLUPRec(a,Offs,m1,n,pivots,tmp);
//--- check
if(m2>0)
{
for(i=0; i<m1; i++)
{
//--- check
if(Offs+i!=pivots[Offs+i])
{
i1_=Offs+m1;
for(i_=0; i_<m2; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+i));
//--- change matrix
for(i_=Offs+m1; i_<Offs+m; i_++)
a.Set(i_,Offs+i,a.Get(i_,pivots[Offs+i]));
i1_=-(Offs+m1);
for(i_=Offs+m1; i_<Offs+m; i_++)
a.Set(i_,pivots[Offs+i],tmp[i_+i1_]);
}
}
//--- function call
CAblas::CMatrixRightTrsM(m2,m1,a,Offs,Offs,true,true,0,a,Offs+m1,Offs);
//--- function call
CAblas::CMatrixGemm(m-m1,n-m1,m1,_One,a,Offs+m1,Offs,0,a,Offs,Offs+m1,0,One,a,Offs+m1,Offs+m1);
//--- function call
CMatrixLUPRec(a,Offs+m1,m-m1,n-m1,pivots,tmp);
for(i=0; i<m2; i++)
{
//--- check
if(Offs+m1+i!=pivots[Offs+m1+i])
{
i1_=Offs;
for(i_=0; i_<m1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+m1+i));
//--- change matrix
for(i_=Offs; i_<Offs+m1; i_++)
a.Set(i_,Offs+m1+i,a.Get(i_,pivots[Offs+m1+i]));
i1_=-Offs;
for(i_=Offs; i_<Offs+m1; i_++)
a.Set(i_,pivots[Offs+m1+i],tmp[i_+i1_]);
}
}
}
}
//+------------------------------------------------------------------+
//| Recurrent real LU subroutine. |
//| Never call it directly. |
//+------------------------------------------------------------------+
void CDLU::RMatrixLUPRec(CMatrixDouble &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowDouble &tmp)
{
//--- create variables
int i=0;
int m1=0;
int m2=0;
int i_=0;
int i1_=0;
//--- Kernel case
if(MathMin(m,n)<=CAblas::AblasBlockSize())
{
RMatrixLUP2(a,Offs,m,n,pivots,tmp);
//--- exit the function
return;
}
//--- Preliminary step, make N>=M
//--- ( A1 )
//--- A = ( ), where A1 is square
//--- ( A2 )
//--- Factorize A1, update A2
if(m>n)
{
//--- function call
RMatrixLUPRec(a,Offs,n,n,pivots,tmp);
for(i=0; i<n; i++)
{
//--- check
if(Offs+i!=pivots[Offs+i])
{
i1_=Offs+n;
for(i_=0; i_<m-n; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+i));
//--- change matrix
for(i_=Offs+n; i_<Offs+m; i_++)
a.Set(i_,Offs+i,a.Get(i_,pivots[Offs+i]));
i1_=-(Offs+n);
for(i_=Offs+n; i_<Offs+m; i_++)
a.Set(i_,pivots[Offs+i],tmp[i_+i1_]);
}
}
//--- function call
CAblas::RMatrixRightTrsM(m-n,n,a,Offs,Offs,true,true,0,a,Offs+n,Offs);
//--- exit the function
return;
}
//--- Non-kernel case
CAblas::AblasSplitLength(a,m,m1,m2);
//--- function call
RMatrixLUPRec(a,Offs,m1,n,pivots,tmp);
//--- check
if(m2>0)
{
for(i=0; i<m1; i++)
{
//--- check
if(Offs+i!=pivots[Offs+i])
{
i1_=Offs+m1;
for(i_=0; i_<m2; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+i));
//--- change matrix
for(i_=Offs+m1; i_<Offs+m; i_++)
a.Set(i_,Offs+i,a.Get(i_,pivots[Offs+i]));
i1_=-(Offs+m1);
for(i_=Offs+m1; i_<Offs+m; i_++)
a.Set(i_,pivots[Offs+i],tmp[i_+i1_]);
}
}
//--- function call
CAblas::RMatrixRightTrsM(m2,m1,a,Offs,Offs,true,true,0,a,Offs+m1,Offs);
//--- function call
CAblas::RMatrixGemm(m-m1,n-m1,m1,-1.0,a,Offs+m1,Offs,0,a,Offs,Offs+m1,0,1.0,a,Offs+m1,Offs+m1);
//--- function call
RMatrixLUPRec(a,Offs+m1,m-m1,n-m1,pivots,tmp);
for(i=0; i<m2; i++)
{
//--- check
if(Offs+m1+i!=pivots[Offs+m1+i])
{
i1_=Offs;
for(i_=0; i_<m1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+m1+i));
//--- change matrix
for(i_=Offs; i_<Offs+m1; i_++)
a.Set(i_,Offs+m1+i,a.Get(i_,pivots[Offs+m1+i]));
i1_=-Offs;
for(i_=Offs; i_<Offs+m1; i_++)
a.Set(i_,pivots[Offs+m1+i],tmp[i_+i1_]);
}
}
}
}
//+------------------------------------------------------------------+
//| Recurrent complex LU subroutine. |
//| Never call it directly. |
//+------------------------------------------------------------------+
void CDLU::CMatrixPLURec(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp)
{
//--- create variables
int i=0;
int n1=0;
int n2=0;
int i_=0;
int i1_=0;
complex One(1.0,0.0);
complex _One(-1.0,0.0);
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
//--- Kernel case
if(n<=tsa)
{
//--- function call
CMatrixPLU2(a,Offs,m,n,pivots,tmp);
//--- exit the function
return;
}
//--- Preliminary step, make M>=N.
//--- A = (A1 A2), where A1 is square
//--- Factorize A1, update A2
if(n>m)
{
//--- function call
CMatrixPLURec(a,Offs,m,m,pivots,tmp);
for(i=0; i<m; i++)
{
i1_=Offs+m;
for(i_=0; i_<n-m; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
//--- change matrix
for(i_=Offs+m; i_<Offs+n; i_++)
a.Set(Offs+i,i_,a.Get(pivots[Offs+i],i_));
i1_=-(Offs+m);
for(i_=Offs+m; i_<Offs+n; i_++)
a.Set(pivots[Offs+i],i_,tmp[i_+i1_]);
}
//--- function call
CAblas::CMatrixLeftTrsM(m,n-m,a,Offs,Offs,false,true,0,a,Offs,Offs+m);
//--- exit the function
return;
}
//--- Non-kernel case
if(n>tsb)
{
n1=tsb;
n2=n-n1;
}
else
{
CApServ::TiledSplit(n,tsa,n1,n2);
}
//--- function call
CMatrixPLURec(a,Offs,m,n1,pivots,tmp);
//--- check
if(n2>0)
{
for(i=0; i<n1; i++)
{
//--- check
if(Offs+i!=pivots[Offs+i])
{
i1_=Offs+n1;
for(i_=0; i_<n2; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
//--- change matrix
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(Offs+i,i_,a.Get(pivots[Offs+i],i_));
i1_=-(Offs+n1);
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(pivots[Offs+i],i_,tmp[i_+i1_]);
}
}
//--- function call
CAblas::CMatrixLeftTrsM(n1,n2,a,Offs,Offs,false,true,0,a,Offs,Offs+n1);
//--- function call
CAblas::CMatrixGemm(m-n1,n-n1,n1,_One,a,Offs+n1,Offs,0,a,Offs,Offs+n1,0,One,a,Offs+n1,Offs+n1);
//--- function call
CMatrixPLURec(a,Offs+n1,m-n1,n-n1,pivots,tmp);
for(i=0; i<n2; i++)
{
//--- check
if(Offs+n1+i!=pivots[Offs+n1+i])
{
i1_=Offs;
for(i_=0; i_<n1; i_++)
tmp.Set(i_,a.Get(Offs+n1+i,i_+i1_));
//--- change matrix
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(Offs+n1+i,i_,a.Get(pivots[Offs+n1+i],i_));
i1_=-Offs;
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(pivots[Offs+n1+i],i_,tmp[i_+i1_]);
}
}
}
}
//+------------------------------------------------------------------+
//| Recurrent real LU subroutine. |
//| Never call it directly. |
//+------------------------------------------------------------------+
void CDLU::RMatrixPLURec(CMatrixDouble &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowDouble &tmp)
{
//--- create variables
int i=0;
int n1=0;
int n2=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
//--- Kernel case
if(n<=tsa)
{
//--- function call
RMatrixPLU2(a,Offs,m,n,pivots,tmp);
//--- exit the function
return;
}
//--- Preliminary step, make M>=N.
//--- A = (A1 A2), where A1 is square
//--- Factorize A1, update A2
if(n>m)
{
//--- function call
RMatrixPLURec(a,Offs,m,m,pivots,tmp);
for(i=0; i<m; i++)
{
i1_=Offs+m;
for(i_=0; i_<n-m; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
//--- change matrix
for(i_=Offs+m; i_<Offs+n; i_++)
a.Set(Offs+i,i_,a.Get(pivots[Offs+i],i_));
i1_=-(Offs+m);
for(i_=Offs+m; i_<Offs+n; i_++)
a.Set(pivots[Offs+i],i_,tmp[i_+i1_]);
}
//--- function call
CAblas::RMatrixLeftTrsM(m,n-m,a,Offs,Offs,false,true,0,a,Offs,Offs+m);
//--- exit the function
return;
}
//--- Non-kernel case
if(n>tsb)
{
n1=tsb;
n2=n-n1;
}
else
{
CApServ::TiledSplit(n,tsa,n1,n2);
}
//--- function call
RMatrixPLURec(a,Offs,m,n1,pivots,tmp);
//--- check
if(n2>0)
{
for(i=0; i<n1; i++)
{
//--- check
if(Offs+i!=pivots[Offs+i])
{
i1_=Offs+n1;
for(i_=0; i_<n2; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
//--- change matrix
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(Offs+i,i_,a.Get(pivots[Offs+i],i_));
i1_=-(Offs+n1);
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(pivots[Offs+i],i_,tmp[i_+i1_]);
}
}
//--- function call
CAblas::RMatrixLeftTrsM(n1,n2,a,Offs,Offs,false,true,0,a,Offs,Offs+n1);
//--- function call
CAblas::RMatrixGemm(m-n1,n-n1,n1,-1.0,a,Offs+n1,Offs,0,a,Offs,Offs+n1,0,1.0,a,Offs+n1,Offs+n1);
//--- function call
RMatrixPLURec(a,Offs+n1,m-n1,n-n1,pivots,tmp);
for(i=0; i<n2; i++)
{
//--- check
if(Offs+n1+i!=pivots[Offs+n1+i])
{
i1_=Offs;
for(i_=0; i_<n1; i_++)
tmp.Set(i_,a.Get(Offs+n1+i,i_+i1_));
//--- change matrix
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(Offs+n1+i,i_,a.Get(pivots[Offs+n1+i],i_));
i1_=-Offs;
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(pivots[Offs+n1+i],i_,tmp[i_+i1_]);
}
}
}
}
//+------------------------------------------------------------------+
//| Complex LUP kernel |
//+------------------------------------------------------------------+
void CDLU::CMatrixLUP2(CMatrixComplex &a,const int Offs,const int m,const int n,CRowInt &pivots,CRowComplex &tmp)
{
//--- create variables
int i=0;
int j=0;
int jp=0;
complex s=0;
int i_=0;
int i1_=0;
complex zero=0;
complex One(1.0,0.0);
//--- check
if(m==0 || n==0)
return;
//--- main cycle
for(j=0; j<=MathMin(m-1,n-1); j++)
{
//--- Find pivot, swap columns
jp=j;
for(i=j+1; i<n; i++)
{
//--- check
if(CMath::AbsComplex(a.Get(Offs+j,Offs+i))>CMath::AbsComplex(a.Get(Offs+j,Offs+jp)))
jp=i;
}
pivots.Set(Offs+j,Offs+jp);
//--- check
if(jp!=j)
{
i1_=Offs;
for(i_=0; i_<m; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
//--- change matrix
for(i_=Offs; i_<Offs+m; i_++)
a.Set(i_,Offs+j,a.Get(i_,Offs+jp));
i1_=-Offs;
for(i_=Offs; i_<Offs+m; i_++)
a.Set(i_,Offs+jp,tmp[i_+i1_]);
}
//--- LU decomposition of 1x(N-J) matrix
if(a.Get(Offs+j,Offs+j)!=zero && j+1<=n-1)
{
s=One/a.Get(Offs+j,Offs+j);
for(i_=Offs+j+1; i_<Offs+n; i_++)
a.Set(Offs+j,i_,s*a.Get(Offs+j,i_));
}
//--- Update trailing (M-J-1)x(N-J-1) matrix
if(j<MathMin(m-1,n-1))
{
i1_=Offs+j+1;
for(i_=0; i_<m-j-1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
i1_=(Offs+j+1)-(m);
for(i_=m; i_<m+n-j-1; i_++)
tmp.Set(i_,-a.Get(Offs+j,i_+i1_));
//--- function call
CAblas::CMatrixRank1(m-j-1,n-j-1,a,Offs+j+1,Offs+j+1,tmp,0,tmp,m);
}
}
}
//+------------------------------------------------------------------+
//| Real LUP kernel |
//+------------------------------------------------------------------+
void CDLU::RMatrixLUP2(CMatrixDouble &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowDouble &tmp)
{
//--- create variables
int i=0;
int j=0;
int jp=0;
double s=0;
int i_=0;
int i1_=0;
//--- check
if(m==0 || n==0)
return;
//--- main cycle
for(j=0; j<=MathMin(m-1,n-1); j++)
{
//--- Find pivot, swap columns
jp=j;
for(i=j+1; i<n; i++)
{
if(MathAbs(a.Get(Offs+j,Offs+i))>MathAbs(a.Get(Offs+j,Offs+jp)))
jp=i;
}
pivots.Set(Offs+j,Offs+jp);
//--- check
if(jp!=j)
{
i1_=Offs;
for(i_=0; i_<m; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
//--- change matrix
for(i_=Offs; i_<Offs+m; i_++)
a.Set(i_,Offs+j,a.Get(i_,Offs+jp));
i1_=-Offs;
for(i_=Offs; i_<Offs+m; i_++)
a.Set(i_,Offs+jp,tmp[i_+i1_]);
}
//--- LU decomposition of 1x(N-J) matrix
if(a.Get(Offs+j,Offs+j)!=0.0 && j+1<=n-1)
{
s=1/a.Get(Offs+j,Offs+j);
for(i_=Offs+j+1; i_<Offs+n; i_++)
a.Set(Offs+j,i_,s*a.Get(Offs+j,i_));
}
//--- Update trailing (M-J-1)x(N-J-1) matrix
if(j<MathMin(m-1,n-1))
{
i1_=Offs+j+1;
for(i_=0; i_<m-j-1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
i1_=(Offs+j+1)-(m);
for(i_=m; i_<m+n-j-1; i_++)
tmp.Set(i_,-a.Get(Offs+j,i_+i1_));
//--- function call
CAblas::RMatrixRank1(m-j-1,n-j-1,a,Offs+j+1,Offs+j+1,tmp,0,tmp,m);
}
}
}
//+------------------------------------------------------------------+
//| Complex PLU kernel |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee,Univ. of California Berkeley,NAG Ltd., |
//| Courant Institute,Argonne National Lab,and Rice University |
//| June 30,1992 |
//+------------------------------------------------------------------+
void CDLU::CMatrixPLU2(CMatrixComplex &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowComplex &tmp)
{
//--- create variables
int i=0;
int j=0;
int jp=0;
complex s=0;
complex zero=0;
complex One(1.0,0.0);
int i_=0;
int i1_=0;
//--- check
if(m==0 || n==0)
return;
for(j=0; j<=MathMin(m-1,n-1); j++)
{
//--- Find pivot and test for singularity.
jp=j;
for(i=j+1; i<m; i++)
{
//--- check
if(CMath::AbsComplex(a.Get(Offs+i,Offs+j))>CMath::AbsComplex(a.Get(Offs+jp,Offs+j)))
jp=i;
}
pivots.Set(Offs+j,Offs+jp);
if(a.Get(Offs+jp,Offs+j)!=zero)
{
//--- Apply the interchange to rows
if(jp!=j)
{
for(i=0; i<n; i++)
{
s=a.Get(Offs+j,Offs+i);
a.Set(Offs+j,Offs+i,a.Get(Offs+jp,Offs+i));
a.Set(Offs+jp,Offs+i,s);
}
}
//--- Compute elements J+1:M of J-th column.
if(j+1<=m-1)
{
s=One/a.Get(Offs+j,Offs+j);
for(i_=Offs+j+1; i_<Offs+m; i_++)
a.Set(i_,Offs+j,s*a.Get(i_,Offs+j));
}
}
//--- check
if(j<MathMin(m,n)-1)
{
//--- Update trailing submatrix.
i1_=Offs+j+1;
for(i_=0; i_<m-j-1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
i1_=(Offs+j+1)-(m);
for(i_=m; i_<m+n-j-1; i_++)
tmp.Set(i_,-a.Get(Offs+j,i_+i1_));
//--- function call
CAblas::CMatrixRank1(m-j-1,n-j-1,a,Offs+j+1,Offs+j+1,tmp,0,tmp,m);
}
}
}
//+------------------------------------------------------------------+
//| Real PLU kernel |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee,Univ. of California Berkeley,NAG Ltd., |
//| Courant Institute,Argonne National Lab,and Rice University |
//| June 30,1992 |
//+------------------------------------------------------------------+
void CDLU::RMatrixPLU2(CMatrixDouble &a,const int Offs,const int m,
const int n,CRowInt &pivots,CRowDouble &tmp)
{
//--- create variables
int i=0;
int j=0;
int jp=0;
double s=0;
int i_=0;
int i1_=0;
//--- check
if(m==0 || n==0)
return;
for(j=0; j<=MathMin(m-1,n-1); j++)
{
//--- Find pivot and test for singularity.
jp=j;
for(i=j+1; i<m; i++)
{
//--- check
if(MathAbs(a.Get(Offs+i,Offs+j))>MathAbs(a.Get(Offs+jp,Offs+j)))
jp=i;
}
pivots.Set(Offs+j,Offs+jp);
//--- check
if(a.Get(Offs+jp,Offs+j)!=0.0)
{
//--- Apply the interchange to rows
if(jp!=j)
{
for(i=0; i<n; i++)
{
s=a.Get(Offs+j,Offs+i);
a.Set(Offs+j,Offs+i,a.Get(Offs+jp,Offs+i));
a.Set(Offs+jp,Offs+i,s);
}
}
//--- Compute elements J+1:M of J-th column.
if(j+1<=m-1)
{
s=1/a.Get(Offs+j,Offs+j);
for(i_=Offs+j+1; i_<Offs+m; i_++)
a.Set(i_,Offs+j,s*a.Get(i_,Offs+j));
}
}
//--- check
if(j<MathMin(m,n)-1)
{
//--- Update trailing submatrix.
i1_=Offs+j+1;
for(i_=0; i_<m-j-1; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+j));
i1_=(Offs+j+1)-(m);
for(i_=m; i_<m+n-j-1; i_++)
tmp.Set(i_,-a.Get(Offs+j,i_+i1_));
//--- function call
CAblas::RMatrixRank1(m-j-1,n-j-1,a,Offs+j+1,Offs+j+1,tmp,0,tmp,m);
}
}
}
//+------------------------------------------------------------------+
//| Recursive computational subroutine for HPDMatrixCholesky |
//+------------------------------------------------------------------+
bool CTrFac::HPDMatrixCholeskyRec(CMatrixComplex &a,const int Offs,const int n,
const bool IsUpper,CRowComplex &tmp)
{
//--- check
if(n<1)
return(false);
//--- create variables
bool result=false;
int n1=0;
int n2=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
//--- prepare bufer
if(tmp.Size()<2*n)
tmp.Resize(2*n);
//--- Basecases
//--- NOTE: we do not use MKL for basecases because their price is only
//--- minor part of overall running time for N>256.
if(n==1)
{
//--- check
if(a.Get(Offs,Offs).real>0.0)
{
a.Set(Offs,Offs,MathSqrt(a.Get(Offs,Offs).real));
result=true;
}
//--- return result
return(result);
}
//--- check
if(n<=tsa)
return(HPDMatrixCholesky2(a,Offs,n,IsUpper,tmp));
//--- Split task into smaller ones
if(n>tsb)
{
//--- Split leading B-sized block from the beginning (block-matrix approach)
n1=tsb;
n2=n-n1;
}
else
//--- Smaller than B-size, perform cache-oblivious split
CApServ::TiledSplit(n,tsa,n1,n2);
result=HPDMatrixCholeskyRec(a,Offs,n1,IsUpper,tmp);
if(!result)
return(result);
if(n2>0)
{
if(IsUpper)
{
CAblas::CMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,false,2,a,Offs,Offs+n1);
CAblas::CMatrixHerk(n2,n1,-1.0,a,Offs,Offs+n1,2,1.0,a,Offs+n1,Offs+n1,IsUpper);
}
else
{
CAblas::CMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,false,2,a,Offs+n1,Offs);
CAblas::CMatrixHerk(n2,n1,-1.0,a,Offs+n1,Offs,0,1.0,a,Offs+n1,Offs+n1,IsUpper);
}
result=HPDMatrixCholeskyRec(a,Offs+n1,n2,IsUpper,tmp);
if(!result)
return(result);
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Level-2 Hermitian Cholesky subroutine. |
//| -- 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 CTrFac::HPDMatrixCholesky2(CMatrixComplex &AAA,const int Offs,
const int n,const bool IsUpper,CRowComplex &tmp)
{
//--- check
if(n<0)
return(false);
//--- check
if(n==0)
return(true);
//--- create variables
bool result=true;
int i=0;
int j=0;
double ajj=0;
complex v=0;
double r=0;
int i_=0;
int i1_=0;
//--- check
if(IsUpper)
{
//--- Compute the Cholesky factorization A = U'*U.
for(j=0; j<n; j++)
{
//--- Compute U(J,J) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=CMath::Conj(AAA.Get(i_,Offs+j))*AAA.Get(i_,Offs+j);
ajj=(AAA.Get(Offs+j,Offs+j)-v).real;
//--- check
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
//--- return result
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N-1 of row J.
if(j<n-1)
{
//--- check
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Set(i_,-CMath::Conj(AAA.Get(i_+i1_,Offs+j)));
//--- function call
CAblas::CMatrixMVect(n-j-1,j,AAA,Offs,Offs+j+1,1,tmp,0,tmp,n);
i1_=(n)-(Offs+j+1);
for(i_=Offs+j+1; i_<Offs+n; i_++)
AAA.Set(Offs+j,i_,AAA.Get(Offs+j,i_)+tmp[i_+i1_]);
}
//--- change matrix
for(i_=Offs+j+1; i_<Offs+n; i_++)
AAA.Set(Offs+j,i_,AAA.Get(Offs+j,i_)/ajj);
}
}
}
else
{
//--- Compute the Cholesky factorization A = L*L'.
for(j=0; j<n; j++)
{
//--- Compute L(J+1,J+1) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=CMath::Conj(AAA.Get(Offs+j,i_))*AAA.Get(Offs+j,i_);
ajj=(AAA.Get(Offs+j,Offs+j)-v).real;
//--- check
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
//--- return result
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N of column J.
if(j<n-1)
{
//--- check
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Set(i_,CMath::Conj(AAA.Get(Offs+j,i_+i1_)));
//--- function call
CAblas::CMatrixMVect(n-j-1,j,AAA,Offs+j+1,Offs,0,tmp,0,tmp,n);
for(i=0; i<n-j-1; i++)
AAA.Set(Offs+j+1+i,Offs+j,(AAA.Get(Offs+j+1+i,Offs+j)-tmp[n+i])/ajj);
}
else
{
for(i=0; i<n-j-1; i++)
AAA.Set(Offs+j+1+i,Offs+j,AAA.Get(Offs+j+1+i,Offs+j)/ajj);
}
}
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Level-2 Cholesky subroutine |
//| -- 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 CTrFac::SPDMatrixCholesky2(CMatrixDouble &AAA,const int Offs,const int n,
const bool IsUpper,CRowDouble &tmp)
{
//--- check
if(n<0)
return(false);
//--- check
if(n==0)
return(true);
//--- create variables
bool result=true;
int i=0;
int j=0;
double ajj=0;
double v=0;
double r=0;
int i_=0;
int i1_=0;
//--- check
if(IsUpper)
{
//--- Compute the Cholesky factorization A = U'*U.
for(j=0; j<n; j++)
{
//--- Compute U(J,J) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=AAA.Get(i_,Offs+j)*AAA.Get(i_,Offs+j);
ajj=AAA.Get(Offs+j,Offs+j)-v;
//--- check
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
//--- return result
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N-1 of row J.
if(j<n-1)
{
//--- check
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Set(i_,-AAA.Get(i_+i1_,Offs+j));
//--- function call
CAblas::RMatrixMVect(n-j-1,j,AAA,Offs,Offs+j+1,1,tmp,0,tmp,n);
i1_=(n)-(Offs+j+1);
for(i_=Offs+j+1; i_<Offs+n; i_++)
AAA.Set(Offs+j,i_,AAA.Get(Offs+j,i_)+tmp[i_+i1_]);
}
//--- change matrix
for(i_=Offs+j+1; i_<Offs+n; i_++)
AAA.Set(Offs+j,i_,AAA.Get(Offs+j,i_)/ajj);
}
}
}
else
{
//--- Compute the Cholesky factorization A = L*L'.
for(j=0; j<n; j++)
{
//--- Compute L(J+1,J+1) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=AAA.Get(Offs+j,i_)*AAA.Get(Offs+j,i_);
ajj=AAA.Get(Offs+j,Offs+j)-v;
//--- check
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
//--- return result
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N of column J.
if(j<n-1)
{
//--- check
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Set(i_,AAA.Get(Offs+j,i_+i1_));
//--- function call
CAblas::RMatrixMVect(n-j-1,j,AAA,Offs+j+1,Offs,0,tmp,0,tmp,n);
for(i=0; i<n-j-1; i++)
AAA.Set(Offs+j+1+i,Offs+j,(AAA.Get(Offs+j+1+i,Offs+j)-tmp[n+i])/ajj);
}
else
{
for(i=0; i<n-j-1; i++)
AAA.Set(Offs+j+1+i,Offs+j,AAA.Get(Offs+j+1+i,Offs+j)/ajj);
}
}
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Estimate of a matrix condition number |
//+------------------------------------------------------------------+
class CRCond
{
public:
static double RMatrixRCond1(CMatrixDouble &ca,const int n);
static double RMatrixRCondInf(CMatrixDouble &ca,const int n);
static double SPDMatrixRCond(CMatrixDouble &ca,const int n,const bool IsUpper);
static double RMatrixTrRCond1(CMatrixDouble &a,const int n,const bool IsUpper,const bool IsUnit);
static double RMatrixTrRCondInf(CMatrixDouble &a,const int n,const bool IsUpper,const bool IsUnit);
static double RMatrixLURCond1(CMatrixDouble &lua,const int n);
static double RMatrixLURCondInf(CMatrixDouble &lua,const int n);
static double SPDMatrixCholeskyRCond(CMatrixDouble &a,const int n,const bool IsUpper);
static double HPDMatrixRCond(CMatrixComplex &ca,const int n,const bool IsUpper);
static double CMatrixRCond1(CMatrixComplex &ca,const int n);
static double CMatrixRCondInf(CMatrixComplex &ca,const int n);
static double HPDMatrixCholeskyRCond(CMatrixComplex &a,const int n,const bool IsUpper);
static double CMatrixLURCond1(CMatrixComplex &lua,const int n);
static double CMatrixLURCondInf(CMatrixComplex &lua,const int n);
static double CMatrixTrRCond1(CMatrixComplex &a,const int n,const bool IsUpper,const bool IsUnit);
static double CMatrixTrRCondInf(CMatrixComplex &a,const int n,const bool IsUpper,const bool IsUnit);
static double RCondThreshold(void);
private:
static void RMatrixRCondTrInternal(CMatrixDouble &a,const int n,const bool IsUpper,const bool IsUnit,const bool onenorm,double anorm,double &rc);
static void CMatrixRCondTrInternal(CMatrixComplex &a,const int n,const bool IsUpper,const bool IsUnit,const bool onenorm,double anorm,double &rc);
static void SPDMatrixRCondCholeskyInternal(CMatrixDouble &cha,const int n,const bool IsUpper,const bool isnormprovided,double anorm,double &rc);
static void HPDMatrixRCondCholeskyInternal(CMatrixComplex &cha,const int n,const bool IsUpper,const bool isnormprovided,double anorm,double &rc);
static void RMatrixRCondLUInternal(CMatrixDouble &lua,const int n,const bool onenorm,const bool isanormprovided,double anorm,double &rc);
static void CMatrixRCondLUInternal(CMatrixComplex &lua,const int n,const bool onenorm,const bool isanormprovided,double anorm,double &rc);
static void RMatrixEstimateNorm(const int n,CRowDouble &v,CRowDouble &x,CRowInt &isgn,double &est,int &kase);
static void CMatrixEstimateNorm(const int n,CRowComplex &v,CRowComplex &x,double &est,int &kase,CRowInt &isave,CRowDouble &rsave);
static double InternalComplexRCondScSum1(CRowComplex &x,const int n);
static int InternalComplexRCondIcMax1(CRowComplex &x,const int n);
static void InternalComplexRCondSaveAll(CRowInt &isave,CRowDouble &rsave,int &i,int &iter,int &j,int &jlast,int &jump,double &absxi,double &altsgn,double &estold,double &temp);
static void InternalComplexRCondLoadAll(CRowInt &isave,CRowDouble &rsave,int &i,int &iter,int &j,int &jlast,int &jump,double &absxi,double &altsgn,double &estold,double &temp);
};
//+------------------------------------------------------------------+
//| Estimate of a matrix condition number (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::RMatrixRCond1(CMatrixDouble &ca,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
//--- create arrays
CRowInt pivots;
CRowDouble t;
//--- create copy
CMatrixDouble a=ca;
//--- fiiling array
t=(a.Abs()+0).Sum(0);
if(t.Size()>n)
t.Resize(n);
//--- change values
nrm=t.Max();
//--- function call
CTrFac::RMatrixLU(a,n,n,pivots);
//--- function call
RMatrixRCondLUInternal(a,n,true,true,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of a matrix condition number (infinity-norm). |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::RMatrixRCondInf(CMatrixDouble &ca,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
//--- create array
CRowInt pivots;
//--- create copy
CMatrixDouble a=ca;
a.Resize(n,n);
//--- change values
nrm=(a.Abs()+0).CumSum(1).Col(n-1).Max();
//--- function call
CTrFac::RMatrixLU(a,n,n,pivots);
//--- function call
RMatrixRCondLUInternal(a,n,false,true,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Condition number estimate of a symmetric positive definite |
//| matrix. |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| It should be noted that 1-norm and inf-norm of condition numbers |
//| of symmetric matrices are equal, so the algorithm doesn't take |
//| into account the differences between these types of norms. |
//| Input parameters: |
//| A - symmetric positive definite matrix which is given|
//| by its upper or lower triangle depending on the |
//| value of IsUpper. Array with elements |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - storage format. |
//| Result: |
//| 1/LowerBound(cond(A)), if matrix A is positive definite, |
//| -1, if matrix A is not positive definite, and its condition |
//| number could not be found by this algorithm. |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::SPDMatrixRCond(CMatrixDouble &ca,const int n,const bool IsUpper)
{
//--- create variables
double result=0;
int i=0;
int j=0;
int j1=0;
int j2=0;
double v=0;
double nrm=0;
//--- create array
CRowDouble t;
//--- create copy
CMatrixDouble a=ca;
//--- allocation
t=vector<double>::Zeros(n);
//--- fiiling array
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
//--- change t
for(j=j1; j<=j2; j++)
{
t.Set(i,t[i]+MathAbs(a.Get(i,j)));
//--- check
if(i!=j)
t.Set(j,t[j]+MathAbs(a.Get(i,j)));
}
}
//--- change values
nrm=t.Max();
//--- check
if(CTrFac::SPDMatrixCholesky(a,n,IsUpper))
{
//--- function call
SPDMatrixRCondCholeskyInternal(a,n,IsUpper,true,nrm,v);
//--- get result
result=v;
}
else
result=-1;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Triangular matrix: estimate of a condition number (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array[0..N-1, 0..N-1]. |
//| N - size of A. |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - True, if the matrix has a unit diagonal. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::RMatrixTrRCond1(CMatrixDouble &a,const int n,
const bool IsUpper,const bool IsUnit)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
int j1=0;
int j2=0;
//--- create arrays
CRowInt pivots;
CRowDouble t;
//--- allocation
t=vector<double>::Zeros(n);
//--- fiiling array
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change t
for(j=j1; j<=j2; j++)
t.Set(j,t[j]+MathAbs(a.Get(i,j)));
//--- check
if(IsUnit)
t.Set(i,t[i]+1);
else
t.Set(i,t[i]+MathAbs(a.Get(i,i)));
}
//--- change values
nrm=t.Max();
//--- function call
RMatrixRCondTrInternal(a,n,IsUpper,IsUnit,true,nrm,v);
//--- return result
return(v);
}
//+-------------------------------------------------------------------+
//| Triangular matrix: estimate of a matrix condition number |
//| (infinity-norm). |
//| The algorithm calculates a lower bound of the condition number. In|
//| this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - True, if the matrix has a unit diagonal. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+-------------------------------------------------------------------+
double CRCond::RMatrixTrRCondInf(CMatrixDouble &a,const int n,
const bool IsUpper,const bool IsUnit)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
int j1=0;
int j2=0;
//--- create array
CRowInt pivots;
//--- change values
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change v
v=0;
for(j=j1; j<=j2; j++)
v+=MathAbs(a.Get(i,j));
//--- check
if(IsUnit)
v++;
else
v+=MathAbs(a.Get(i,i));
nrm=MathMax(nrm,v);
}
//--- function call
RMatrixRCondTrInternal(a,n,IsUpper,IsUnit,false,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Condition number estimate of a Hermitian positive definite |
//| matrix. |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| It should be noted that 1-norm and inf-norm of condition numbers |
//| of symmetric matrices are equal, so the algorithm doesn't take |
//| into account the differences between these types of norms. |
//| Input parameters: |
//| A - Hermitian positive definite matrix which is given|
//| by its upper or lower triangle depending on the |
//| value of IsUpper. Array with elements |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - storage format. |
//| Result: |
//| 1/LowerBound(cond(A)), if matrix A is positive definite, |
//| -1, if matrix A is not positive definite, and its condition |
//| number could not be found by this algorithm. |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::HPDMatrixRCond(CMatrixComplex &ca,const int n,const bool IsUpper)
{
//--- create variables
double result=0;
int i=0;
int j=0;
int j1=0;
int j2=0;
double v=0;
double nrm=0;
//--- create array
CRowDouble t;
//--- create copy
CMatrixComplex a=ca;
//--- allocation
t=vector<double>::Zeros(n);
//--- fiiling array
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i;
j2=n-1;
}
else
{
j1=0;
j2=i;
}
//--- change t
for(j=j1; j<=j2; j++)
{
t.Set(i,t[i]+CMath::AbsComplex(a.Get(i,j)));
//--- check
if(i!=j)
t.Set(j,t[j]+CMath::AbsComplex(a.Get(i,j)));
}
}
//--- change values
nrm=0;
for(i=0; i<n; i++)
nrm=MathMax(nrm,t[i]);
//--- check
if(CTrFac::HPDMatrixCholesky(a,n,IsUpper))
{
//--- function call
HPDMatrixRCondCholeskyInternal(a,n,IsUpper,true,nrm,v);
//--- get result
result=v;
}
else
result=-1;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Estimate of a matrix condition number (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixRCond1(CMatrixComplex &ca,const int n)
{
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
//--- create arrays
CRowDouble t;
CRowInt pivots;
//--- create copy
CMatrixComplex a=ca;
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- allocation
t=vector<double>::Zeros(n);
//--- fiiling array
for(i=0; i<n; i++)
{
for(j=0; j<n; j++)
t.Set(j,t[j]+CMath::AbsComplex(a.Get(i,j)));
}
//--- change values
nrm=t.Max();
//--- function call
CTrFac::CMatrixLU(a,n,n,pivots);
//--- function call
CMatrixRCondLUInternal(a,n,true,true,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of a matrix condition number (infinity-norm). |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixRCondInf(CMatrixComplex &ca,const int n)
{
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
//--- create array
CRowInt pivots;
//--- create copy
CMatrixComplex a=ca;
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- change values
nrm=0;
for(i=0; i<n; i++)
{
v=0;
for(j=0; j<n; j++)
v+=CMath::AbsComplex(a.Get(i,j));
nrm=MathMax(nrm,v);
}
//--- function call
CTrFac::CMatrixLU(a,n,n,pivots);
//--- function call
CMatrixRCondLUInternal(a,n,false,true,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of the condition number of a matrix given by its LU |
//| decomposition (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| LUA - LU decomposition of a matrix in compact form.|
//| Output of the RMatrixLU subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::RMatrixLURCond1(CMatrixDouble &lua,const int n)
{
//--- create a variable
double v=0;
//--- function call
RMatrixRCondLUInternal(lua,n,true,false,0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of the condition number of a matrix given by its LU |
//| decomposition (infinity norm). |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| LUA - LU decomposition of a matrix in compact form. |
//| Output of the RMatrixLU subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::RMatrixLURCondInf(CMatrixDouble &lua,const int n)
{
//--- create a variable
double v=0;
//--- function call
RMatrixRCondLUInternal(lua,n,false,false,0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Condition number estimate of a symmetric positive definite matrix|
//| given by Cholesky decomposition. |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| It should be noted that 1-norm and inf-norm condition numbers of |
//| symmetric matrices are equal, so the algorithm doesn't take into |
//| account the differences between these types of norms. |
//| Input parameters: |
//| CD - Cholesky decomposition of matrix A, |
//| output of SMatrixCholesky subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::SPDMatrixCholeskyRCond(CMatrixDouble &a,const int n,
const bool IsUpper)
{
//--- create a variable
double v=0;
//--- function call
SPDMatrixRCondCholeskyInternal(a,n,IsUpper,false,0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Condition number estimate of a Hermitian positive definite matrix|
//| given by Cholesky decomposition. |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| It should be noted that 1-norm and inf-norm condition numbers of |
//| symmetric matrices are equal, so the algorithm doesn't take into |
//| account the differences between these types of norms. |
//| Input parameters: |
//| CD - Cholesky decomposition of matrix A, |
//| output of SMatrixCholesky subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::HPDMatrixCholeskyRCond(CMatrixComplex &a,const int n,
const bool IsUpper)
{
//--- create a variable
double v=0;
//--- function call
HPDMatrixRCondCholeskyInternal(a,n,IsUpper,false,0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of the condition number of a matrix given by its LU |
//| decomposition (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| LUA - LU decomposition of a matrix in compact form.|
//| Output of the CMatrixLU subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixLURCond1(CMatrixComplex &lua,const int n)
{
//--- create a variable
double v=0;
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- function call
CMatrixRCondLUInternal(lua,n,true,false,0.0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Estimate of the condition number of a matrix given by its LU |
//| decomposition (infinity norm). |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| LUA - LU decomposition of a matrix in compact form. |
//| Output of the CMatrixLU subroutine. |
//| N - size of matrix A. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixLURCondInf(CMatrixComplex &lua,const int n)
{
//--- create a variable
double v=0;
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- function call
CMatrixRCondLUInternal(lua,n,false,false,0.0,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Triangular matrix: estimate of a condition number (1-norm) |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array[0..N-1, 0..N-1]. |
//| N - size of A. |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - True, if the matrix has a unit diagonal. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixTrRCond1(CMatrixComplex &a,const int n,
const bool IsUpper,const bool IsUnit)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
int j1=0;
int j2=0;
//--- create arrays
CRowInt pivots;
CRowDouble t;
//--- allocation
t=vector<double>::Zeros(n);
//--- fiiling array
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change t
for(j=j1; j<=j2; j++)
t.Set(j,t[j]+CMath::AbsComplex(a.Get(i,j)));
//--- check
if(IsUnit)
t.Set(i,t[i]+1);
else
t.Set(i,t[i]+CMath::AbsComplex(a.Get(i,i)));
}
//--- change values
nrm=t.Max();
//--- function call
CMatrixRCondTrInternal(a,n,IsUpper,IsUnit,true,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Triangular matrix: estimate of a matrix condition number |
//| (infinity-norm). |
//| The algorithm calculates a lower bound of the condition number. |
//| In this case, the algorithm does not return a lower bound of the |
//| condition number, but an inverse number (to avoid an overflow in |
//| case of a singular matrix). |
//| Input parameters: |
//| A - matrix. Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - True, if the matrix has a unit diagonal. |
//| Result: 1/LowerBound(cond(A)) |
//| NOTE: |
//| if k(A) is very large, then matrix is assumed degenerate, |
//| k(A)=INF, 0.0 is returned in such cases. |
//+------------------------------------------------------------------+
double CRCond::CMatrixTrRCondInf(CMatrixComplex &a,const int n,
const bool IsUpper,const bool IsUnit)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
//--- create variables
int i=0;
int j=0;
double v=0;
double nrm=0;
int j1=0;
int j2=0;
//--- create array
CRowInt pivots;
//--- change values
nrm=0;
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change v
v=0;
for(j=j1; j<=j2; j++)
v+=CMath::AbsComplex(a.Get(i,j));
//--- check
if(IsUnit)
v ++;
else
v+=CMath::AbsComplex(a.Get(i,i));
nrm=MathMax(nrm,v);
}
//--- function call
CMatrixRCondTrInternal(a,n,IsUpper,IsUnit,false,nrm,v);
//--- return result
return(v);
}
//+------------------------------------------------------------------+
//| Threshold for rcond: matrices with condition number beyond this |
//| threshold are considered singular. |
//| Threshold must be far enough from underflow, at least |
//| Sqr(Threshold) must be greater than underflow. |
//+------------------------------------------------------------------+
double CRCond::RCondThreshold(void)
{
return(MathSqrt(MathSqrt(CMath::m_minrealnumber)));
}
//+------------------------------------------------------------------+
//| Internal subroutine for condition number estimation |
//| -- 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 |
//+------------------------------------------------------------------+
void CRCond::RMatrixRCondTrInternal(CMatrixDouble &a,const int n,
const bool IsUpper,const bool IsUnit,
const bool onenorm,double anorm,
double &rc)
{
//--- create variables
int i=0;
int j=0;
int kase=0;
int kase1=0;
int j1=0;
int j2=0;
double ainvnm=0;
double maxgrowth=0;
double s=0;
//--- RC=0 if something happens
rc=0;
//--- create arrays
CRowDouble ex;
CRowDouble ev;
CRowInt iwork;
CRowDouble tmp;
//--- check
if(onenorm)
kase1=1;
else
kase1=2;
//--- allocation
iwork.Resize(n+1);
tmp.Resize(n);
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change s
for(j=j1; j<=j2; j++)
s=MathMax(s,MathAbs(a.Get(i,j)));
//--- check
if(IsUnit)
s=MathMax(s,1);
else
s=MathMax(s,MathAbs(a.Get(i,i)));
}
//--- check
if(s==0.0)
s=1;
s=1/s;
//--- Scale according to S
anorm*=s;
//--- Quick return if possible
//--- We assume that ANORM<>0 after this block
if(anorm==0.0)
return;
//--- check
if(n==1)
{
rc=1;
return;
}
//--- Estimate the norm of inv(A).
while(true)
{
//--- function call
RMatrixEstimateNorm(n,ev,ex,iwork,ainvnm,kase);
//--- check
if(kase==0)
break;
//--- from 1-based array to 0-based
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- multiply by inv(A) or inv(A')
if(kase==kase1)
{
//--- multiply by inv(A)
if(!CSafeSolve::RMatrixScaledTrSafeSolve(a,s,n,ex,IsUpper,0,IsUnit,maxgrowth))
return;
}
else
{
//--- multiply by inv(A')
if(!CSafeSolve::RMatrixScaledTrSafeSolve(a,s,n,ex,IsUpper,1,IsUnit,maxgrowth))
return;
}
//--- from 0-based array to 1-based
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
rc=1/ainvnm;
rc=rc/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Condition number estimation |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| March 31, 1993 |
//+------------------------------------------------------------------+
void CRCond::CMatrixRCondTrInternal(CMatrixComplex &a,const int n,
const bool IsUpper,const bool IsUnit,
const bool onenorm,double anorm,
double &rc)
{
//--- check
if(n<=0)
return;
//--- check
if(n==0)
{
rc=1;
return;
}
//--- create variables
int kase=0;
int kase1=0;
double ainvnm=0;
int i=0;
int j=0;
int j1=0;
int j2=0;
double s=0;
double maxgrowth=0;
//--- create arrays
CRowComplex ex;
CRowComplex cwork2;
CRowComplex cwork3;
CRowComplex cwork4;
CRowInt isave;
CRowDouble rsave;
//--- initialization
rc=0;
//--- allocation
cwork2.Resize(n+1);
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
s=0;
for(i=0; i<n; i++)
{
//--- check
if(IsUpper)
{
j1=i+1;
j2=n-1;
}
else
{
j1=0;
j2=i-1;
}
//--- change s
for(j=j1; j<=j2; j++)
s=MathMax(s,CMath::AbsComplex(a.Get(i,j)));
//--- check
if(IsUnit)
s=MathMax(s,1);
else
s=MathMax(s,CMath::AbsComplex(a.Get(i,i)));
}
//--- check
if(s==0.0)
s=1;
s=1/s;
//--- Scale according to S
anorm*=s;
if(anorm==0.0)
return;
//--- Estimate the norm of inv(A).
ainvnm=0;
//--- check
if(onenorm)
kase1=1;
else
kase1=2;
while(true)
{
//--- function call
CMatrixEstimateNorm(n,cwork4,ex,ainvnm,kase,isave,rsave);
//--- check
if(kase==0)
break;
//--- from 1-based array to 0-based
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- multiply by inv(A) or inv(A')
if(kase==kase1)
{
//--- multiply by inv(A)
if(!CSafeSolve::CMatrixScaledTrSafeSolve(a,s,n,ex,IsUpper,0,IsUnit,maxgrowth))
return;
}
else
{
//--- multiply by inv(A')
if(!CSafeSolve::CMatrixScaledTrSafeSolve(a,s,n,ex,IsUpper,2,IsUnit,maxgrowth))
return;
}
//--- from 0-based array to 1-based
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
rc=1/ainvnm;
rc=rc/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine for condition number estimation |
//| -- 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 |
//+------------------------------------------------------------------+
void CRCond::SPDMatrixRCondCholeskyInternal(CMatrixDouble &cha,const int n,
const bool IsUpper,
const bool isnormprovided,
double anorm,double &rc)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<=0"))
return;
//--- create variables
int i=0;
int j=0;
int kase=0;
double ainvnm=0;
double sa=0;
double v=0;
double maxgrowth=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble ex;
CRowDouble ev;
CRowDouble tmp;
CRowInt iwork;
//--- allocation
tmp.Resize(n);
//--- initialization
rc=0;
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
//--- check
if(IsUpper)
{
for(i=0; i<n; i++)
for(j=i; j<n; j++)
sa=MathMax(sa,CMath::AbsComplex(cha.Get(i,j)));
}
else
{
for(i=0; i<n; i++)
for(j=0; j<=i; j++)
sa=MathMax(sa,CMath::AbsComplex(cha.Get(i,j)));
}
//--- check
if(sa==0.0)
sa=1;
sa=1/sa;
//--- Estimate the norm of A
if(!isnormprovided)
{
anorm=0;
while(true)
{
//--- function call
RMatrixEstimateNorm(n,ev,ex,iwork,anorm,kase);
//--- check
if(kase==0)
break;
//--- check
if(IsUpper)
{
//--- Multiply by U
for(i=1; i<=n; i++)
{
i1_=1;
v=0.0;
for(i_=i-1; i_<n; i_++)
v+=cha.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
CAblasF::RMulVX(n,sa,ex,1);
//--- Multiply by U'
tmp=vector<double>::Zeros(n);
for(i=0; i<n; i++)
{
v=ex[i+1];
for(i_=i; i_<n; i_++)
tmp.Set(i_,tmp[i_]+v*cha.Get(i,i_));
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*tmp[i_+i1_]);
}
else
{
//--- Multiply by L''
tmp=vector<double>::Zeros(n);
for(i=0; i<n; i++)
{
v=ex[i+1];
for(i_=0; i_<=i; i_++)
tmp.Set(i_,tmp[i_]+v*cha.Get(i,i_));
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*tmp[i_+i1_]);
//--- Multiply by L'
for(i=n; i>=1; i--)
{
i1_=1;
v=0.0;
for(i_=0; i_<i; i_++)
v+=cha.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*ex[i_]);
}
}
}
//--- check
if(anorm==0.0)
return;
//--- check
if(n==1)
{
rc=1;
return;
}
//--- Estimate the 1-norm of inv(A).
kase=0;
while(true)
{
//--- function call
RMatrixEstimateNorm(n,ev,ex,iwork,ainvnm,kase);
//--- check
if(kase==0)
break;
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- check
if(IsUpper)
{
//--- Multiply by inv(U')
if(!CSafeSolve::RMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,1,false,maxgrowth))
return;
//--- Multiply by inv(U)
if(!CSafeSolve::RMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,0,false,maxgrowth))
return;
}
else
{
//--- Multiply by inv(L)
if(!CSafeSolve::RMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,0,false,maxgrowth))
return;
//--- Multiply by inv(L')
if(!CSafeSolve::RMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,1,false,maxgrowth))
return;
}
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
v=1/ainvnm;
rc=v/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine for condition number estimation |
//| -- 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 |
//+------------------------------------------------------------------+
void CRCond::HPDMatrixRCondCholeskyInternal(CMatrixComplex &cha,const int n,
const bool IsUpper,
const bool isnormprovided,
double anorm,double &rc)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<=0"))
return;
//--- create variables
complex Csa;
int kase=0;
double ainvnm=0;
complex v=0;
int i=0;
int j=0;
double sa=0;
double maxgrowth=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowInt isave;
CRowDouble rsave;
CRowComplex ex;
CRowComplex ev;
CRowComplex tmp;
//--- allocation
tmp.Resize(n);
//--- initialization
rc=0;
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
//--- check
if(IsUpper)
{
for(i=0; i<n; i++)
for(j=i; j<n; j++)
sa=MathMax(sa,CMath::AbsComplex(cha.Get(i,j)));
}
else
{
for(i=0; i<n; i++)
for(j=0; j<=i; j++)
sa=MathMax(sa,CMath::AbsComplex(cha.Get(i,j)));
}
//--- check
if(sa==0.0)
sa=1;
sa=1/sa;
//--- Estimate the norm of A
if(!isnormprovided)
{
anorm=0;
while(true)
{
//--- function call
CMatrixEstimateNorm(n,ev,ex,anorm,kase,isave,rsave);
//--- check
if(kase==0)
break;
//--- check
if(IsUpper)
{
//--- Multiply by U
for(i=1; i<=n; i++)
{
i1_=1;
v=0.0;
for(i_=i-1; i_<n; i_++)
v+=cha.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*ex[i_]);
//--- Multiply by U'
tmp=vector<complex>::Full(n,0);
for(i=0; i<n; i++)
{
v=ex[i+1];
for(i_=i; i_<n; i_++)
tmp.Set(i_,tmp[i_]+v*CMath::Conj(cha.Get(i,i_)));
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*tmp[i_+i1_]);
}
else
{
//--- Multiply by L''
tmp=vector<complex>::Full(n,0);
for(i=0; i<n; i++)
{
v=ex[i+1];
for(i_=0; i_<=i; i_++)
tmp.Set(i_,tmp[i_]+v*CMath::Conj(cha.Get(i,i_)));
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*tmp[i_+i1_]);
//--- Multiply by L'
for(i=n; i>=1; i--)
{
i1_=1;
v=0.0;
for(i_=0; i_<i; i_++)
v+=cha.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
for(i_=1; i_<=n; i_++)
ex.Set(i_,sa*ex[i_]);
}
}
}
//--- Quick return if possible
//--- After this block we assume that ANORM<>0
if(anorm==0.0)
return;
//--- check
if(n==1)
{
rc=1;
return;
}
//--- Estimate the norm of inv(A).
ainvnm=0;
kase=0;
while(true)
{
//--- function call
CMatrixEstimateNorm(n,ev,ex,ainvnm,kase,isave,rsave);
//--- check
if(kase==0)
break;
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- check
if(IsUpper)
{
//--- Multiply by inv(U')
if(!CSafeSolve::CMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,2,false,maxgrowth))
return;
//--- Multiply by inv(U)
if(!CSafeSolve::CMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,0,false,maxgrowth))
return;
}
else
{
//--- Multiply by inv(L)
if(!CSafeSolve::CMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,0,false,maxgrowth))
return;
//--- Multiply by inv(L')
if(!CSafeSolve::CMatrixScaledTrSafeSolve(cha,sa,n,ex,IsUpper,2,false,maxgrowth))
return;
}
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
rc=1/ainvnm;
rc=rc/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine for condition number estimation |
//| -- 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 |
//+------------------------------------------------------------------+
void CRCond::RMatrixRCondLUInternal(CMatrixDouble &lua,const int n,
const bool onenorm,
const bool isanormprovided,
double anorm,double &rc)
{
//--- create variables
double v=0;
int i=0;
int j=0;
int kase=0;
int kase1=0;
double ainvnm=0;
double maxgrowth=0;
double su=0;
double sl=1;
bool mupper=true;
bool mtrans=true;
bool munit=true;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble ex;
CRowDouble ev;
CRowInt iwork;
CRowDouble tmp;
//--- check
if(onenorm)
kase1=1;
else
kase1=2;
//--- initialization
rc=0;
//--- allocation
iwork.Resize(n+1);
tmp.Resize(n);
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
for(i=0; i<n; i++)
{
for(j=0; j<i; j++)
sl=MathMax(sl,MathAbs(lua.Get(i,j)));
for(j=i; j<n; j++)
su=MathMax(su,MathAbs(lua.Get(i,j)));
}
//--- check
if(su==0.0)
su=1;
su=1/su;
sl=1/sl;
//--- Estimate the norm of A
if(!isanormprovided)
{
kase=0;
anorm=0;
while(true)
{
//--- function call
RMatrixEstimateNorm(n,ev,ex,iwork,anorm,kase);
//--- check
if(kase==0)
break;
//--- check
if(kase==kase1)
{
//--- Multiply by U
for(i=1; i<=n; i++)
{
i1_=1;
v=0.0;
for(i_=i-1; i_<n; i_++)
v+=lua.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
//--- Multiply by L
for(i=n; i>=1; i--)
{
//--- check
if(i>1)
{
i1_=1;
v=0.0;
for(i_=0; i_<=i-2; i_++)
v+=lua.Get(i-1,i_)*ex[i_+i1_];
}
else
continue;
ex.Set(i,ex[i]+v);
}
}
else
{
//--- Multiply by L'
tmp=vector<double>::Zeros(n);
for(i=0; i<n; i++)
{
v=ex[i+1];
//--- check
if(i>=1)
{
for(i_=0; i_<i; i_++)
tmp.Set(i_,tmp[i_]+v*lua.Get(i,i_));
}
tmp.Set(i,tmp[i]+v);
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,tmp[i_+i1_]);
//--- Multiply by U'
tmp=vector<double>::Zeros(n);
for(i=0; i<n; i++)
{
v=ex[i+1];
for(i_=i; i_<n; i_++)
tmp.Set(i_,tmp[i_]+v*lua.Get(i,i_));
}
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
ex.Set(i_,tmp[i_+i1_]);
}
}
}
//--- Scale according to SU/SL
anorm*=su*sl;
//--- Quick return if possible
//--- We assume that ANORM<>0 after this block
if(anorm==0.0)
return;
//--- check
if(n==1)
{
rc=1;
return;
}
//--- Estimate the norm of inv(A).
ainvnm=0;
kase=0;
while(true)
{
//--- function call
RMatrixEstimateNorm(n,ev,ex,iwork,ainvnm,kase);
//--- check
if(kase==0)
break;
//--- from 1-based array to 0-based
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- multiply by inv(A) or inv(A')
if(kase==kase1)
{
//--- Multiply by inv(L)
if(!CSafeSolve::RMatrixScaledTrSafeSolve(lua,sl,n,ex,!mupper,0,munit,maxgrowth))
return;
//--- Multiply by inv(U)
if(!CSafeSolve::RMatrixScaledTrSafeSolve(lua,su,n,ex,mupper,0,!munit,maxgrowth))
return;
}
else
{
//--- Multiply by inv(U')
if(!CSafeSolve::RMatrixScaledTrSafeSolve(lua,su,n,ex,mupper,1,!munit,maxgrowth))
return;
//--- Multiply by inv(L')
if(!CSafeSolve::RMatrixScaledTrSafeSolve(lua,sl,n,ex,!mupper,1,munit,maxgrowth))
return;
}
//--- from 0-based array to 1-based
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
rc=1/ainvnm;
rc=rc/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Condition number estimation |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| March 31, 1993 |
//+------------------------------------------------------------------+
void CRCond::CMatrixRCondLUInternal(CMatrixComplex &lua,const int n,
const bool onenorm,
const bool isanormprovided,
double anorm,double &rc)
{
//--- check
if(n==0)
{
rc=1;
return;
}
//--- create variables
int kase=0;
int kase1=0;
double ainvnm=0;
complex v=0;
int i=0;
int j=0;
double su=0;
double sl=0;
double maxgrowth=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowComplex ex;
CRowComplex cwork2;
CRowComplex cwork3;
CRowComplex cwork4;
CRowInt isave;
CRowDouble rsave;
//--- check
if(n<=0)
return;
//--- allocation
cwork2.Resize(n+1);
//--- initialization
rc=0;
//--- prepare parameters for triangular solver
maxgrowth=1/RCondThreshold();
su=0;
sl=1;
for(i=0; i<n; i++)
{
for(j=0; j<i; j++)
sl=MathMax(sl,CMath::AbsComplex(lua.Get(i,j)));
for(j=i; j<n; j++)
su=MathMax(su,CMath::AbsComplex(lua.Get(i,j)));
}
//--- check
if(su==0.0)
su=1;
su=1/su;
sl=1/sl;
//--- Estimate the norm of SU*SL*A
if(!isanormprovided)
{
anorm=0;
//--- check
if(onenorm)
kase1=1;
else
kase1=2;
kase=0;
do
{
//--- function call
CMatrixEstimateNorm(n,cwork4,ex,anorm,kase,isave,rsave);
//--- check
if(kase!=0)
{
//--- check
if(kase==kase1)
{
//--- Multiply by U
for(i=1; i<=n; i++)
{
i1_=1;
v=0.0;
for(i_=i-1; i_<n; i_++)
v+=lua.Get(i-1,i_)*ex[i_+i1_];
ex.Set(i,v);
}
//--- Multiply by L
for(i=n; i>=1; i--)
{
v=0;
//--- check
if(i>1)
{
i1_=1;
v=0.0;
for(i_=0; i_<=i-2; i_++)
v+=lua.Get(i-1,i_)*ex[i_+i1_];
}
ex.Set(i,v+ex[i]);
}
}
else
{
//--- Multiply by L'
cwork2=vector<complex>::Full(n+1,0);
for(i=1; i<=n; i++)
{
v=ex[i];
//--- check
if(i>1)
{
i1_=-1;
for(i_=1; i_<i; i_++)
cwork2.Set(i_,cwork2[i_]+v*CMath::Conj(lua.Get(i-1,i_+i1_)));
}
cwork2.Set(i,cwork2[i]+v);
}
//--- Multiply by U'
ex=vector<complex>::Full(n+1,0);
for(i=1; i<=n; i++)
{
v=cwork2[i];
i1_=-1;
for(i_=i; i_<=n; i_++)
ex.Set(i_,ex[i_]+v*CMath::Conj(lua.Get(i-1,i_+i1_)));
}
}
}
}
while(kase!=0);
}
//--- Scale according to SU/SL
anorm*=su*sl;
//--- check
if(anorm==0.0)
return;
//--- Estimate the norm of inv(A).
ainvnm=0;
//--- check
if(onenorm)
kase1=1;
else
kase1=2;
kase=0;
while(true)
{
//--- function call
CMatrixEstimateNorm(n,cwork4,ex,ainvnm,kase,isave,rsave);
//--- check
if(kase==0)
break;
//--- from 1-based array to 0-based
for(i=0; i<n; i++)
ex.Set(i,ex[i+1]);
//--- multiply by inv(A) or inv(A')
if(kase==kase1)
{
//--- Multiply by inv(L)
if(!CSafeSolve::CMatrixScaledTrSafeSolve(lua,sl,n,ex,false,0,true,maxgrowth))
{
rc=0;
//--- exit the function
return;
}
//--- Multiply by inv(U)
if(!CSafeSolve::CMatrixScaledTrSafeSolve(lua,su,n,ex,true,0,false,maxgrowth))
{
rc=0;
//--- exit the function
return;
}
}
else
{
//--- Multiply by inv(U')
if(!CSafeSolve::CMatrixScaledTrSafeSolve(lua,su,n,ex,true,2,false,maxgrowth))
{
rc=0;
//--- exit the function
return;
}
//--- Multiply by inv(L')
if(!CSafeSolve::CMatrixScaledTrSafeSolve(lua,sl,n,ex,false,2,true,maxgrowth))
{
rc=0;
//--- exit the function
return;
}
}
//--- from 0-based array to 1-based
for(i=n-1; i>=0; i--)
ex.Set(i+1,ex[i]);
}
//--- Compute the estimate of the reciprocal condition number.
if(ainvnm!=0.0)
{
rc=1/ainvnm;
rc=rc/anorm;
//--- check
if(rc<RCondThreshold())
rc=0;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine for matrix norm estimation |
//| -- 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 CRCond::RMatrixEstimateNorm(const int n,CRowDouble &v,CRowDouble &x,
CRowInt &isgn,double &est,int &kase)
{
//--- create variables
int itmax=5;
int i=0;
double t=0;
bool flg;
int positer=n+1;
int posj=n+2;
int posjlast=n+3;
int posjump=n+4;
int posaltsgn=n+1;
int posestold=n+2;
int postemp=n+3;
int i_=0;
//--- check
if(kase==0)
{
//--- allocation
v=vector<double>::Zeros(n+4);
isgn.Resize(n+5);
isgn.Fill(0);
//--- change values
t=1.0/(double)n;
x=vector<double>::Full(n+1,t);
x.Set(0,0);
kase=1;
isgn.Set(posjump,1);
//--- exit the function
return;
}
switch(isgn[posjump])
{
case 1:
//--- ................ entry (jump = 1)
//--- first iteration. x has been overwritten by a*x.
//--- check
if(n==1)
{
v.Set(1,x[1]);
est=MathAbs(v[1]);
kase=0;
//--- exit the function
return;
}
//--- change value
est=0;
for(i=1; i<=n; i++)
{
est+=MathAbs(x[i]);
//--- check
if(x[i]>=0.0)
x.Set(i,1);
else
x.Set(i,-1);
isgn.Set(i,(int)x[i]);
}
kase=2;
isgn.Set(posjump,2);
break;
case 2:
//--- ................ entry (jump = 2)
//--- first iteration. x has been overwritten by trandpose(a)*x.
isgn.Set(posj,1);
for(i=2; i<=n; i++)
{
//--- check
if(MathAbs(x[i])>MathAbs(x[isgn[posj]]))
isgn.Set(posj,i);
}
isgn.Set(positer,2);
//--- main loop - iterations 2,3,...,itmax.
x=vector<double>::Zeros(n+1);
x.Set(isgn[posj],1);
kase=1;
isgn.Set(posjump,3);
break;
case 3:
//--- ................ entry (jump = 3)
//--- x has been overwritten by a*x.
for(i_=1; i_<=n; i_++)
v.Set(i_,x[i_]);
v.Set(posestold,est);
//--- change value
est=0;
flg=false;
for(i=1; i<=n; i++)
{
est+=MathAbs(v[i]);
if(((x[i]>=0.0) && (isgn[i]<0)) || ((x[i]<0.0) && (isgn[i]>=0)))
flg=true;
}
//--- repeated sign vector detected, hence algorithm has converged.
//--- or may be cycling.
if(!flg || est<=v[posestold])
{
v.Set(posaltsgn,1);
for(i=1; i<=n; i++)
{
x.Set(i,v[posaltsgn]*(1+(double)(i-1)/(double)(n-1)));
v.Set(posaltsgn,-v[posaltsgn]);
}
kase=1;
isgn.Set(posjump,5);
//--- exit the function
break;
}
for(i=1; i<=n; i++)
{
//--- check
if(x[i]>=0.0)
{
x.Set(i,1);
isgn.Set(i,1);
}
else
{
x.Set(i,-1);
isgn.Set(i,-1);
}
}
kase=2;
isgn.Set(posjump,4);
break;
case 4:
//--- ................ entry (jump = 4)
//--- x has been overwritten by trandpose(a)*x.
isgn.Set(posjlast,isgn[posj]);
isgn.Set(posj,1);
for(i=2; i<=n; i++)
{
//--- check
if(MathAbs(x[i])>MathAbs(x[isgn[posj]]))
isgn.Set(posj,i);
}
//--- check
if(x[isgn[posjlast]]!=MathAbs(x[isgn[posj]]) && isgn[positer]<itmax)
{
isgn.Set(positer,isgn[positer]+1);
x=vector<double>::Zeros(n+1);
x.Set(isgn[posj],1);
kase=1;
isgn.Set(posjump,3);
//--- exit the function
break;
}
//--- iteration complete. final stage.
v.Set(posaltsgn,1);
for(i=1; i<=n; i++)
{
x.Set(i,v[posaltsgn]*(1+(double)(i-1)/(double)(n-1)));
v.Set(posaltsgn,-v[posaltsgn]);
}
kase=1;
isgn.Set(posjump,5);
//--- exit the function
break;
case 5:
//--- ................ entry (jump = 5)
//--- x has been overwritten by a*x.
v.Set(postemp,0);
for(i=1; i<=n; i++)
v.Add(postemp,MathAbs(x[i]));
v.Mul(postemp,2.0/(3.0*n));
//--- check
if(v[postemp]>est)
{
for(i_=1; i_<=n; i_++)
v.Set(i_,x[i_]);
est=v[postemp];
}
kase=0;
//--- exit the function
break;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CRCond::CMatrixEstimateNorm(const int n,CRowComplex &v,CRowComplex &x,
double &est,int &kase,CRowInt &isave,
CRowDouble &rsave)
{
//--- create variables
int itmax=5;
int i=0;
int iter=0;
int j=0;
int jlast=0;
int jump=0;
double absxi=0;
double altsgn=0;
double estold=0;
double safmin=CMath::m_minrealnumber;
double temp=0;
int i_=0;
//--- check
if(kase==0)
{
//--- allocation
v.Resize(n+1);
x=vector<complex>::Full(n+1,(1.0/(double)n));
x.Set(0,0.0);
isave.Resize(5);
rsave.Resize(4);
kase=1;
jump=1;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
return;
}
//--- function call
InternalComplexRCondLoadAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
switch(jump)
{
case 1:
//--- entry (jump = 1)
//--- first iteration. x has been overwritten by a*x.
//--- check
if(n==1)
{
v.Set(1,x[1]);
//--- function call
est=CMath::AbsComplex(v[1]);
kase=0;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
return;
}
//--- function call
est=InternalComplexRCondScSum1(x,n);
for(i=1; i<=n; i++)
{
//--- function call
absxi=CMath::AbsComplex(x[i]);
//--- check
if(absxi>safmin)
x.Set(i,x[i]/absxi);
else
x.Set(i,1.0);
}
kase=2;
jump=2;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
case 2:
//--- entry (jump = 2)
//--- first iteration. x has been overwritten by ctrans(a)*x.
j=InternalComplexRCondIcMax1(x,n);
iter=2;
//--- main loop - iterations 2,3,...,itmax.
x=vector<complex>::Full(n+1,0);
x.Set(j,1.0);
kase=1;
jump=3;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
case 3:
//--- entry (jump = 3)
//--- x has been overwritten by a*x.
v=x;
estold=est;
//--- function call
est=InternalComplexRCondScSum1(v,n);
//--- test for cycling.
if(est<=estold)
{
//--- iteration complete. final stage.
altsgn=1;
for(i=1; i<=n; i++)
{
x.Set(i,altsgn*(1+(double)(i-1)/(double)(n-1)));
altsgn=-altsgn;
}
kase=1;
jump=5;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
}
for(i=1; i<=n; i++)
{
absxi=CMath::AbsComplex(x[i]);
//--- check
if(absxi>safmin)
x.Set(i,x[i]/absxi);
else
x.Set(i,1.0);
}
kase=2;
jump=4;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
case 4:
//--- entry (jump = 4)
//--- x has been overwritten by ctrans(a)*x.
jlast=j;
j=InternalComplexRCondIcMax1(x,n);
//--- check
if(CMath::AbsComplex(x[jlast])!=CMath::AbsComplex(x[j]) && iter<itmax)
{
iter ++;
//--- main loop - iterations 2,3,...,itmax.
x=vector<complex>::Full(n+1,0);
x.Set(j,1.0);
kase=1;
jump=3;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
}
//--- iteration complete. final stage.
altsgn=1;
for(i=1; i<=n; i++)
{
x.Set(i,altsgn*(1+(double)(i-1)/(double)(n-1)));
altsgn=-altsgn;
}
kase=1;
jump=5;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
case 5:
//--- entry (jump = 5)
//--- x has been overwritten by a*x.
temp=2*(InternalComplexRCondScSum1(x,n)/(3*n));
//--- check
if(temp>est)
{
v=x;
est=temp;
}
kase=0;
//--- function call
InternalComplexRCondSaveAll(isave,rsave,i,iter,j,jlast,jump,absxi,altsgn,estold,temp);
//--- exit the function
break;
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
double CRCond::InternalComplexRCondScSum1(CRowComplex &x,const int n)
{
double result=0;
//--- get result
for(int i=1; i<=n; i++)
result=result+CMath::AbsComplex(x[i]);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
int CRCond::InternalComplexRCondIcMax1(CRowComplex &x,const int n)
{
//--- create variables
int result=1;
double m=CMath::AbsComplex(x[1]);
//--- get result
for(int i=2; i<=n; i++)
{
//--- check
if(CMath::AbsComplex(x[i])>m)
{
result=i;
m=CMath::AbsComplex(x[i]);
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CRCond::InternalComplexRCondSaveAll(CRowInt &isave,CRowDouble &rsave,
int &i,int &iter,int &j,
int &jlast,int &jump,
double &absxi,double &altsgn,
double &estold,double &temp)
{
//--- copy
isave.Set(0,i);
isave.Set(1,iter);
isave.Set(2,j);
isave.Set(3,jlast);
isave.Set(4,jump);
//--- copy
rsave.Set(0,absxi);
rsave.Set(1,altsgn);
rsave.Set(2,estold);
rsave.Set(3,temp);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CRCond::InternalComplexRCondLoadAll(CRowInt &isave,
CRowDouble &rsave,int &i,
int &iter,int &j,int &jlast,
int &jump,double &absxi,
double &altsgn,double &estold,
double &temp)
{
//--- get
i=isave[0];
iter=isave[1];
j=isave[2];
jlast=isave[3];
jump=isave[4];
//--- get
absxi=rsave[0];
altsgn=rsave[1];
estold=rsave[2];
temp=rsave[3];
}
//+------------------------------------------------------------------+
//| Matrix inverse report: |
//| * R1 reciprocal of condition number in 1-norm |
//| * RInf reciprocal of condition number in inf-norm |
//+------------------------------------------------------------------+
class CMatInvReport
{
public:
double m_r1;
double m_rinf;
//--- constructor, destructor
CMatInvReport(void) { m_r1=0; m_rinf=0; }
~CMatInvReport(void) {}
//---
void Copy(const CMatInvReport &obj);
//--- overloading
void operator=(const CMatInvReport &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
void CMatInvReport::Copy(const CMatInvReport &obj)
{
m_r1=obj.m_r1;
m_rinf=obj.m_rinf;
}
//+------------------------------------------------------------------+
//| Matrix inverse report: |
//| * R1 reciprocal of condition number in 1-norm |
//| * RInf reciprocal of condition number in inf-norm |
//+------------------------------------------------------------------+
class CMatInvReportShell
{
private:
CMatInvReport m_innerobj;
public:
//--- constructors, destructor
CMatInvReportShell(void) {}
CMatInvReportShell(CMatInvReport &obj);
~CMatInvReportShell(void) {}
//--- methods
double GetR1(void);
void SetR1(double r);
double GetRInf(void);
void SetRInf(double r);
CMatInvReport *GetInnerObj(void);
};
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
CMatInvReportShell::CMatInvReportShell(CMatInvReport &obj)
{
m_innerobj.m_r1=obj.m_r1;
m_innerobj.m_rinf=obj.m_rinf;
}
//+------------------------------------------------------------------+
//| Returns the value of the variable r1 |
//+------------------------------------------------------------------+
double CMatInvReportShell::GetR1(void)
{
return(m_innerobj.m_r1);
}
//+------------------------------------------------------------------+
//| Changing the value of the variable r1 |
//+------------------------------------------------------------------+
void CMatInvReportShell::SetR1(double r)
{
m_innerobj.m_r1=r;
}
//+------------------------------------------------------------------+
//| Returns the value of the variable rinf |
//+------------------------------------------------------------------+
double CMatInvReportShell::GetRInf(void)
{
return(m_innerobj.m_rinf);
}
//+------------------------------------------------------------------+
//| Changing the value of the variable rint |
//+------------------------------------------------------------------+
void CMatInvReportShell::SetRInf(double r)
{
m_innerobj.m_rinf=r;
}
//+------------------------------------------------------------------+
//| Return object of class |
//+------------------------------------------------------------------+
CMatInvReport *CMatInvReportShell::GetInnerObj(void)
{
return(GetPointer(m_innerobj));
}
//+------------------------------------------------------------------+
//| Inverse matrix |
//+------------------------------------------------------------------+
class CMatInv
{
public:
static void RMatrixLUInverse(CMatrixDouble &a,int &pivots[],const int n,int &info,CMatInvReport &rep);
static void RMatrixLUInverse(CMatrixDouble &a,CRowInt &pivots,const int n,int &info,CMatInvReport &rep);
static void RMatrixInverse(CMatrixDouble &a,const int n,int &info,CMatInvReport &rep);
static void SPDMatrixCholeskyInverse(CMatrixDouble &a,const int n,const bool IsUpper,int &info,CMatInvReport &rep);
static void SPDMatrixInverse(CMatrixDouble &a,const int n,const bool IsUpper,int &info,CMatInvReport &rep);
static void RMatrixTrInverse(CMatrixDouble &a,const int n,const bool IsUpper,const bool IsUnit,int &info,CMatInvReport &rep);
static void CMatrixLUInverse(CMatrixComplex &a,int &pivots[],const int n,int &info,CMatInvReport &rep);
static void CMatrixLUInverse(CMatrixComplex &a,CRowInt &pivots,const int n,int &info,CMatInvReport &rep);
static void CMatrixInverse(CMatrixComplex &a,const int n,int &info,CMatInvReport &rep);
static void HPDMatrixCholeskyInverse(CMatrixComplex &a,const int n,const bool IsUpper,int &info,CMatInvReport &rep);
static void HPDMatrixInverse(CMatrixComplex &a,const int n,const bool IsUpper,int &info,CMatInvReport &rep);
static void CMatrixTrInverse(CMatrixComplex &a,const int n,const bool IsUpper,const bool IsUnit,int &info,CMatInvReport &rep);
static void SPDMatrixCholeskyInverseRec(CMatrixDouble &a,const int Offs,const int n,const bool IsUpper,CRowDouble &tmp);
private:
static void RMatrixTrInverseRec(CMatrixDouble &a,const int Offs,const int n,const bool IsUpper,const bool IsUnit,CRowDouble &tmp,int &info);
static void CMatrixTrInverseRec(CMatrixComplex &a,const int Offs,const int n,const bool IsUpper,const bool IsUnit,CRowComplex &tmp,int &info);
static void RMatrixLUInverseRec(CMatrixDouble &a,const int Offs,const int n,CRowDouble &work,int &info,CMatInvReport &rep);
static void CMatrixLUInverseRec(CMatrixComplex &a,const int Offs,const int n,CRowComplex &work,int &info,CMatInvReport &rep);
static void HPDMatrixCholeskyInverseRec(CMatrixComplex &a,const int Offs,const int n,const bool IsUpper,CRowComplex &tmp);
};
//+------------------------------------------------------------------+
//| Inversion of a matrix given by its LU decomposition. |
//| INPUT PARAMETERS: |
//| A - LU decomposition of the matrix |
//| (output of RMatrixLU subroutine). |
//| Pivots - table of permutations |
//| (the output of RMatrixLU subroutine). |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| OUTPUT PARAMETERS: |
//| Info - return code: |
//| * -3 A is singular, or VERY close to singular.|
//| it is filled by zeros in such cases. |
//| * 1 task is solved (but matrix A may be |
//| ill-conditioned, check R1/RInf parameters|
//| for condition numbers). |
//| Rep - solver report, see below for more info |
//| A - inverse of matrix A. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| SOLVER REPORT |
//| Subroutine sets following fields of the Rep structure: |
//| * R1 reciprocal of condition number: 1/cond(A), 1-norm. |
//| * RInf reciprocal of condition number: 1/cond(A), inf-norm. |
//+------------------------------------------------------------------+
void CMatInv::RMatrixLUInverse(CMatrixDouble &a,int &pivots[],
const int n,int &info,CMatInvReport &rep)
{
//--- create variables
CRowInt Pivots=pivots;
RMatrixLUInverse(a,Pivots,n,info,rep);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CMatInv::RMatrixLUInverse(CMatrixDouble &a,CRowInt &pivots,
const int n,int &info,CMatInvReport &rep)
{
//--- create variables
int i=0;
int j=0;
int k=0;
double v=0;
//--- create array
CRowDouble work;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CAp::Len(pivots)>=n,__FUNCTION__+": len(Pivots)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
for(i=0; i<n; i++)
{
//--- check
if(pivots[i]>n-1 || pivots[i]<i)
info=-1;
}
//--- check
if(!CAp::Assert(info>0,__FUNCTION__+": incorrect Pivots array!"))
return;
//--- calculate condition numbers
rep.m_r1=CRCond::RMatrixLURCond1(a,n);
rep.m_rinf=CRCond::RMatrixLURCondInf(a,n);
//--- check
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
a.Fill(0,n,n);
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Call cache-oblivious code
work.Resize(n);
RMatrixLUInverseRec(a,0,n,work,info,rep);
//--- apply permutations
for(i=0; i<n; i++)
{
for(j=n-2; j>=0; j--)
{
k=pivots[j];
v=a.Get(i,j);
a.Set(i,j,a.Get(i,k));
a.Set(i,k,v);
}
}
}
//+------------------------------------------------------------------+
//| Inversion of a general matrix. |
//| Input parameters: |
//| A - matrix. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//| Result: |
//| True, if the matrix is not singular. |
//| False, if the matrix is singular. |
//+------------------------------------------------------------------+
void CMatInv::RMatrixInverse(CMatrixDouble &a,const int n,int &info,
CMatInvReport &rep)
{
//--- create array
CRowInt pivots;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
//--- check
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
//--- check
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
//--- check
if(!CAp::Assert(CApServ::IsFiniteMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- function call
CTrFac::RMatrixLU(a,n,n,pivots);
//--- function call
RMatrixLUInverse(a,pivots,n,info,rep);
}
//+------------------------------------------------------------------+
//| Inversion of a matrix given by its LU decomposition. |
//| INPUT PARAMETERS: |
//| A - LU decomposition of the matrix |
//| (output of CMatrixLU subroutine). |
//| Pivots - table of permutations |
//| (the output of CMatrixLU subroutine). |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| OUTPUT PARAMETERS: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::CMatrixLUInverse(CMatrixComplex &a,int &pivots[],
const int n,int &info,CMatInvReport &rep)
{
CRowInt Pivots=pivots;
CMatrixLUInverse(a,Pivots,n,info,rep);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CMatInv::CMatrixLUInverse(CMatrixComplex &a,CRowInt &pivots,
const int n,int &info,CMatInvReport &rep)
{
//--- create variables
int i=0;
int j=0;
int k=0;
complex v=0;
//--- create array
CRowComplex work;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CAp::Len(pivots)>=n,__FUNCTION__+": len(Pivots)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteComplexMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
for(i=0; i<n; i++)
{
//--- check
if(pivots[i]>n-1 || pivots[i]<i)
info=-1;
}
//--- check
if(!CAp::Assert(info>0,__FUNCTION__+": incorrect Pivots array!"))
return;
//--- calculate condition numbers
rep.m_r1=CRCond::CMatrixLURCond1(a,n);
rep.m_rinf=CRCond::CMatrixLURCondInf(a,n);
//--- check
double check=CRCond::RCondThreshold();
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
a=matrix<complex>::Zeros(n,n);
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Call cache-oblivious code
work.Resize(n);
CMatrixLUInverseRec(a,0,n,work,info,rep);
//--- apply permutations
for(i=0; i<n; i++)
{
for(j=n-2; j>=0; j--)
{
k=pivots[j];
v=a.Get(i,j);
a.Set(i,j,a.Get(i,k));
a.Set(i,k,v);
}
}
}
//+------------------------------------------------------------------+
//| Inversion of a general matrix. |
//| Input parameters: |
//| A - matrix |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::CMatrixInverse(CMatrixComplex &a,const int n,int &info,
CMatInvReport &rep)
{
//--- create array
CRowInt pivots;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteComplexMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- function call
CTrFac::CMatrixLU(a,n,n,pivots);
//--- function call
CMatrixLUInverse(a,pivots,n,info,rep);
}
//+------------------------------------------------------------------+
//| Inversion of a symmetric positive definite matrix which is given |
//| by Cholesky decomposition. |
//| Input parameters: |
//| A - Cholesky decomposition of the matrix to be |
//| inverted: A=U?*U or A = L*L'. |
//| Output of SPDMatrixCholesky subroutine. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - storage type (optional): |
//| * if True, symmetric matrix A is given by its |
//| upper triangle, and the lower triangle isn?t |
//| used/changed by function |
//| * if False, symmetric matrix A is given by its |
//| lower triangle, and the upper triangle isn?t |
//| used/changed by function |
//| * if not given, lower half is used. |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::SPDMatrixCholeskyInverse(CMatrixDouble &a,const int n,
const bool IsUpper,int &info,
CMatInvReport &rep)
{
//--- create array
CRowDouble tmp;
//--- object of class
CMatInvReport rep2;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
//--- initialization
info=1;
bool f=true;
for(int i=0; i<n; i++)
f=f && CMath::IsFinite(a.Get(i,i));
//--- check
if(!CAp::Assert(f,__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- calculate condition numbers
rep.m_r1=CRCond::SPDMatrixCholeskyRCond(a,n,IsUpper);
rep.m_rinf=rep.m_r1;
//--- check
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
//--- check
if(IsUpper)
a=a.TriL(-1)+0;
else
a=a.TriU(1)+0;
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Inverse
tmp.Resize(n);
SPDMatrixCholeskyInverseRec(a,0,n,IsUpper,tmp);
}
//+------------------------------------------------------------------+
//| Inversion of a symmetric positive definite matrix. |
//| Given an upper or lower triangle of a symmetric positive definite|
//| matrix, the algorithm generates matrix A^-1 and saves the upper |
//| or lower triangle depending on the input. |
//| Input parameters: |
//| A - matrix to be inverted (upper or lower triangle). |
//| Array with elements [0..N-1,0..N-1]. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - storage type (optional): |
//| * if True, symmetric matrix A is given by its |
//| upper triangle, and the lower triangle isn?t |
//| used/changed by function |
//| * if False, symmetric matrix A is given by its |
//| lower triangle, and the upper triangle isn?t |
//| used/changed by function |
//| * if not given, both lower and upper triangles |
//| must be filled. |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::SPDMatrixInverse(CMatrixDouble &a,const int n,
const bool IsUpper,int &info,
CMatInvReport &rep)
{
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteRTrMatrix(a,n,IsUpper),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
//--- check
if(CTrFac::SPDMatrixCholesky(a,n,IsUpper))
SPDMatrixCholeskyInverse(a,n,IsUpper,info,rep);
else
info=-3;
}
//+------------------------------------------------------------------+
//| Inversion of a Hermitian positive definite matrix which is given |
//| by Cholesky decomposition. |
//| Input parameters: |
//| A - Cholesky decomposition of the matrix to be |
//| inverted: A=U?*U or A = L*L'. |
//| Output of HPDMatrixCholesky subroutine. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - storage type (optional): |
//| * if True, symmetric matrix A is given by its |
//| upper triangle, and the lower triangle isn?t |
//| used/changed by function |
//| * if False, symmetric matrix A is given by its |
//| lower triangle, and the upper triangle isn?t |
//| used/changed by function |
//| * if not given, lower half is used. |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::HPDMatrixCholeskyInverse(CMatrixComplex &a,const int n,
const bool IsUpper,int &info,
CMatInvReport &rep)
{
//--- create variables
int i=0;
int j=0;
bool f;
//--- create array
CRowComplex tmp;
//--- object of class
CMatInvReport rep2;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
//--- initialization
f=true;
for(i=0; i<n; i++)
f=(f && CMath::IsFinite(a.Get(i,i).real)) && CMath::IsFinite(a.Get(i,i).imag);
//--- check
if(!CAp::Assert(f,__FUNCTION__+": A contains infinite or NaN values!"))
return;
info=1;
//--- calculate condition numbers
rep.m_r1=CRCond::HPDMatrixCholeskyRCond(a,n,IsUpper);
rep.m_rinf=rep.m_r1;
//--- check
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
//--- check
if(IsUpper)
a=a.TriL(-1)+0;
else
a=a.TriU(1)+0;
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Inverse
tmp.Resize(n);
HPDMatrixCholeskyInverseRec(a,0,n,IsUpper,tmp);
}
//+------------------------------------------------------------------+
//| Inversion of a Hermitian positive definite matrix. |
//| Given an upper or lower triangle of a Hermitian positive definite|
//| matrix, the algorithm generates matrix A^-1 and saves the upper |
//| or lower triangle depending on the input. |
//| Input parameters: |
//| A - matrix to be inverted (upper or lower triangle). |
//| Array with elements [0..N-1,0..N-1]. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - storage type (optional): |
//| * if True, symmetric matrix A is given by its |
//| upper triangle, and the lower triangle isn?t |
//| used/changed by function |
//| * if False, symmetric matrix A is given by its |
//| lower triangle, and the upper triangle isn?t |
//| used/changed by function |
//| * if not given, both lower and upper triangles |
//| must be filled. |
//| Output parameters: |
//| Info - return code, same as in RMatrixLUInverse |
//| Rep - solver report, same as in RMatrixLUInverse |
//| A - inverse of matrix A, same as in RMatrixLUInverse |
//+------------------------------------------------------------------+
void CMatInv::HPDMatrixInverse(CMatrixComplex &a,const int n,
const bool IsUpper,int &info,
CMatInvReport &rep)
{
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
//--- check
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteCTrMatrix(a,n,IsUpper),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
//--- check
if(CTrFac::HPDMatrixCholesky(a,n,IsUpper))
HPDMatrixCholeskyInverse(a,n,IsUpper,info,rep);
else
info=-3;
}
//+------------------------------------------------------------------+
//| Triangular matrix inverse (real) |
//| The subroutine inverts the following types of matrices: |
//| * upper triangular |
//| * upper triangular with unit diagonal |
//| * lower triangular |
//| * lower triangular with unit diagonal |
//| In case of an upper (lower) triangular matrix, the inverse matrix|
//| will also be upper (lower) triangular, and after the end of the |
//| algorithm, the inverse matrix replaces the source matrix. The |
//| elements below (above) the main diagonal are not changed by the |
//| algorithm. |
//| If the matrix has a unit diagonal, the inverse matrix also has a |
//| unit diagonal, and the diagonal elements are not passed to the |
//| algorithm. |
//| Input parameters: |
//| A - matrix, array[0..N-1, 0..N-1]. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - diagonal type (optional): |
//| * if True, matrix has unit diagonal (a[i,i] are |
//| NOT used) |
//| * if False, matrix diagonal is arbitrary |
//| * if not given, False is assumed |
//| Output parameters: |
//| Info - same as for RMatrixLUInverse |
//| Rep - same as for RMatrixLUInverse |
//| A - same as for RMatrixLUInverse. |
//+------------------------------------------------------------------+
void CMatInv::RMatrixTrInverse(CMatrixDouble &a,const int n,
const bool IsUpper,const bool IsUnit,
int &info,CMatInvReport &rep)
{
//--- create array
CRowDouble tmp;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteRTrMatrix(a,n,IsUpper),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
//--- calculate condition numbers
rep.m_r1=CRCond::RMatrixTrRCond1(a,n,IsUpper,IsUnit);
rep.m_rinf=CRCond::RMatrixTrRCondInf(a,n,IsUpper,IsUnit);
//--- check
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
a.Fill(0.0,n,n);
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Inverse
tmp.Resize(n);
RMatrixTrInverseRec(a,0,n,IsUpper,IsUnit,tmp,info);
}
//+------------------------------------------------------------------+
//| Triangular matrix inverse (complex) |
//| The subroutine inverts the following types of matrices: |
//| * upper triangular |
//| * upper triangular with unit diagonal |
//| * lower triangular |
//| * lower triangular with unit diagonal |
//| In case of an upper (lower) triangular matrix, the inverse matrix|
//| will also be upper (lower) triangular, and after the end of the |
//| algorithm, the inverse matrix replaces the source matrix. The |
//| elements below (above) the main diagonal are not changed by the |
//| algorithm. |
//| If the matrix has a unit diagonal, the inverse matrix also has a |
//| unit diagonal, and the diagonal elements are not passed to the |
//| algorithm. |
//| Input parameters: |
//| A - matrix, array[0..N-1, 0..N-1]. |
//| N - size of matrix A (optional) : |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, size is automatically determined |
//| from matrix size (A must be square matrix) |
//| IsUpper - True, if the matrix is upper triangular. |
//| IsUnit - diagonal type (optional): |
//| * if True, matrix has unit diagonal (a[i,i] are |
//| NOT used) |
//| * if False, matrix diagonal is arbitrary |
//| * if not given, False is assumed |
//| Output parameters: |
//| Info - same as for RMatrixLUInverse |
//| Rep - same as for RMatrixLUInverse |
//| A - same as for RMatrixLUInverse. |
//+------------------------------------------------------------------+
void CMatInv::CMatrixTrInverse(CMatrixComplex &a,const int n,
const bool IsUpper,const bool IsUnit,
int &info,CMatInvReport &rep)
{
//--- create array
CRowComplex tmp;
//--- initialization
info=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return;
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return;
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return;
if(!CAp::Assert(CApServ::IsFiniteCTrMatrix(a,n,IsUpper),__FUNCTION__+": A contains infinite or NaN values!"))
return;
//--- initialization
info=1;
//--- calculate condition numbers
rep.m_r1=CRCond::CMatrixTrRCond1(a,n,IsUpper,IsUnit);
rep.m_rinf=CRCond::CMatrixTrRCondInf(a,n,IsUpper,IsUnit);
//--- check
if(rep.m_r1<CRCond::RCondThreshold() || rep.m_rinf<CRCond::RCondThreshold())
{
a=matrix<complex>::Zeros(n,n);
//--- change values
rep.m_r1=0;
rep.m_rinf=0;
info=-3;
//--- exit the function
return;
}
//--- Inverse
tmp.Resize(n);
CMatrixTrInverseRec(a,0,n,IsUpper,IsUnit,tmp,info);
}
//+------------------------------------------------------------------+
//| Triangular matrix inversion, recursive subroutine |
//+------------------------------------------------------------------+
void CMatInv::RMatrixTrInverseRec(CMatrixDouble &a,const int Offs,
const int n,const bool IsUpper,
const bool IsUnit,CRowDouble &tmp,
int &info)
{
//--- check
if(n<1)
{
info=-1;
//--- exit the function
return;
}
//--- create variables
int n1=0;
int n2=0;
int i=0;
int j=0;
double v=0;
double ajj=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
if(n<=tsb)
tscur=tsa;
//--- base case
if(n<=tsa)
{
//--- check
if(IsUpper)
{
//--- Compute inverse of upper triangular matrix.
for(j=0; j<n; j++)
{
//--- check
if(!IsUnit)
{
//--- check
if(a.Get(Offs+j,Offs+j)==0.0)
{
info=-3;
//--- exit the function
return;
}
a.Set(Offs+j,Offs+j,1.0/a.Get(Offs+j,Offs+j));
ajj=-a.Get(Offs+j,Offs+j);
}
else
ajj=-1;
//--- Compute elements 1:j-1 of j-th column.
if(j>0)
{
for(i_=Offs; i_<(Offs+j); i_++)
tmp.Set(i_,a.Get(i_,Offs+j));
for(i=0; i<j; i++)
{
v=0.0;
//--- check
if(i<j-1)
{
for(i_=Offs+i+1; i_<Offs+j; i_++)
v+=a.Get(Offs+i,i_)*tmp[i_];
}
//--- check
if(!IsUnit)
a.Set(Offs+i,Offs+j,(v+a.Get(Offs+i,Offs+i)*tmp[Offs+i]));
else
a.Set(Offs+i,Offs+j,(v+tmp[Offs+i]));
}
for(i_=Offs; i_<Offs+j; i_++)
a.Set(i_,Offs+j,(ajj*a.Get(i_,Offs+j)));
}
}
}
else
{
//--- Compute inverse of lower triangular matrix.
for(j=n-1; j>=0; j--)
{
//--- check
if(!IsUnit)
{
//--- check
if(a.Get(Offs+j,Offs+j)==0.0)
{
info=-3;
//--- exit the function
return;
}
a.Set(Offs+j,Offs+j,(1.0/a.Get(Offs+j,Offs+j)));
ajj=-a.Get(Offs+j,Offs+j);
}
else
ajj=-1;
//--- check
if(j<n-1)
{
//--- Compute elements j+1:n of j-th column.
for(i_=Offs+j+1; i_<Offs+n; i_++)
tmp.Set(i_,a.Get(i_,Offs+j));
for(i=j+1; i<n; i++)
{
v=0.0;
//--- check
if(i>j+1)
{
for(i_=Offs+j+1; i_<Offs+i; i_++)
v+=a.Get(Offs+i,i_)*tmp[i_];
}
//--- check
if(!IsUnit)
a.Set(Offs+i,Offs+j,(v+a.Get(Offs+i,Offs+i)*tmp[Offs+i]));
else
a.Set(Offs+i,Offs+j,(v+tmp[Offs+i]));
}
for(i_=Offs+j+1; i_<Offs+n; i_++)
a.Set(i_,Offs+j,(ajj*a.Get(i_,Offs+j)));
}
}
}
//--- exit the function
return;
}
//--- Recursive case
CApServ::TiledSplit(n,tscur,n1,n2);
//--- check
if(n2>0)
{
//--- check
if(IsUpper)
{
for(i=0; i<n1; i++)
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(Offs+i,i_,-a.Get(Offs+i,i_));
//--- function call
CAblas::RMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,IsUnit,0,a,Offs,Offs+n1);
RMatrixTrInverseRec(a,Offs+n1,n2,IsUpper,IsUnit,tmp,info);
//--- function call
CAblas::RMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,IsUnit,0,a,Offs,Offs+n1);
}
else
{
for(i=0; i<n2; i++)
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(Offs+n1+i,i_,-a.Get(Offs+n1+i,i_));
//--- function call
CAblas::RMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,IsUnit,0,a,Offs+n1,Offs);
RMatrixTrInverseRec(a,Offs+n1,n2,IsUpper,IsUnit,tmp,info);
//--- function call
CAblas::RMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,IsUnit,0,a,Offs+n1,Offs);
}
}
//--- function call
RMatrixTrInverseRec(a,Offs,n1,IsUpper,IsUnit,tmp,info);
}
//+------------------------------------------------------------------+
//| Triangular matrix inversion, recursive subroutine |
//+------------------------------------------------------------------+
void CMatInv::CMatrixTrInverseRec(CMatrixComplex &a,const int Offs,
const int n,const bool IsUpper,
const bool IsUnit,CRowComplex &tmp,
int &info)
{
//--- check
if(n<1)
{
info=-1;
//--- exit the function
return;
}
//--- create variables
complex One=1.0;
complex _One=-1.0;
int n1=0;
int n2=0;
int i=0;
int j=0;
complex v=0;
complex ajj=0;
int i_=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
//--- check
if(n<=tsb)
tscur=tsa;
//--- base case
if(n<=tsa)
{
//--- check
if(IsUpper)
{
//--- Compute inverse of upper triangular matrix.
for(j=0; j<n; j++)
{
//--- check
if(!IsUnit)
{
//--- check
if(a.Get(Offs+j,Offs+j)==0)
{
info=-3;
//--- exit the function
return;
}
a.Set(Offs+j,Offs+j,One/a.Get(Offs+j,Offs+j));
ajj=-a.Get(Offs+j,Offs+j);
}
else
ajj=-1;
//--- Compute elements 1:j-1 of j-th column.
if(j>0)
{
for(i_=Offs; i_<(Offs+j); i_++)
tmp.Set(i_,a.Get(i_,Offs+j));
for(i=0; i<j; i++)
{
v=0.0;
//--- check
if(i<j-1)
{
for(i_=Offs+i+1; i_<=Offs+j-1; i_++)
v+=a.Get(Offs+i,i_)*tmp[i_];
}
//--- check
if(!IsUnit)
a.Set(Offs+i,Offs+j,v+a.Get(Offs+i,Offs+i)*tmp[Offs+i]);
else
a.Set(Offs+i,Offs+j,v+tmp[Offs+i]);
}
for(i_=Offs ; i_<Offs+j; i_++)
a.Set(i_,Offs+j,ajj*a.Get(i_,Offs+j));
}
}
}
else
{
//--- Compute inverse of lower triangular matrix.
for(j=n-1; j>=0; j--)
{
//--- check
if(!IsUnit)
{
//--- check
if(a.Get(Offs+j,Offs+j)==0)
{
info=-3;
//--- exit the function
return;
}
a.Set(Offs+j,Offs+j,One/a.Get(Offs+j,Offs+j));
ajj=-a.Get(Offs+j,Offs+j);
}
else
ajj=-1;
//--- check
if(j<n-1)
{
//--- Compute elements j+1:n of j-th column.
for(i_=Offs+j+1; i_<Offs+n; i_++)
tmp.Set(i_,a.Get(i_,Offs+j));
for(i=j+1; i<n; i++)
{
v=0.0;
//--- check
if(i>j+1)
{
for(i_=Offs+j+1; i_<Offs+i; i_++)
v+=a.Get(Offs+i,i_)*tmp[i_];
}
//--- check
if(!IsUnit)
a.Set(Offs+i,Offs+j,(v+a.Get(Offs+i,Offs+i)*tmp[Offs+i]));
else
a.Set(Offs+i,Offs+j,(v+tmp[Offs+i]));
}
for(i_=Offs+j+1; i_<Offs+n; i_++)
a.Set(i_,Offs+j,(ajj*a.Get(i_,Offs+j)));
}
}
}
//--- exit the function
return;
}
//--- Recursive case
CApServ::TiledSplit(n,tscur,n1,n2);
//--- check
if(n2>0)
{
//--- check
if(IsUpper)
{
for(i=0; i<n1; i++)
{
for(i_=Offs+n1; i_<=Offs+n-1; i_++)
a.Set(Offs+i,i_,_One*a.Get(Offs+i,i_));
}
//--- function call
CAblas::CMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,IsUnit,0,a,Offs,Offs+n1);
CMatrixTrInverseRec(a,Offs+n1,n2,IsUpper,IsUnit,tmp,info);
//--- function call
CAblas::CMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,IsUnit,0,a,Offs,Offs+n1);
}
else
{
for(i=0; i<n2; i++)
{
for(i_=Offs; i_<=Offs+n1-1; i_++)
a.Set(Offs+n1+i,i_,_One*a.Get(Offs+n1+i,i_));
}
//--- function call
CAblas::CMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,IsUnit,0,a,Offs+n1,Offs);
CMatrixTrInverseRec(a,Offs+n1,n2,IsUpper,IsUnit,tmp,info);
//--- function call
CAblas::CMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,IsUnit,0,a,Offs+n1,Offs);
}
}
//--- function call
CMatrixTrInverseRec(a,Offs,n1,IsUpper,IsUnit,tmp,info);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CMatInv::RMatrixLUInverseRec(CMatrixDouble &a,const int Offs,
const int n,CRowDouble &work,
int &info,CMatInvReport &rep)
{
//--- check
if(n<1)
{
info=-1;
//--- exit the function
return;
}
//--- create variables
int i=0;
int j=0;
double v=0;
int n1=0;
int n2=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
//--- check
if(n<=tsb)
tscur=tsa;
//--- base case
if(n<=tsa)
{
//--- Form inv(U)
RMatrixTrInverseRec(a,Offs,n,true,false,work,info);
//--- check
if(info<=0)
return;
//--- Solve the equation inv(A)*L = inv(U) for inv(A).
for(j=n-1; j>=0; j--)
{
//--- Copy current column of L to WORK and replace with zeros.
for(i=j+1; i<n; i++)
{
work.Set(i,a.Get(Offs+i,Offs+j));
a.Set(Offs+i,Offs+j,0.0);
}
//--- Compute current column of inv(A).
if(j<n-1)
{
for(i=0; i<n; i++)
{
i1_=-Offs;
v=0.0;
for(i_=Offs+j+1; i_<=Offs+n-1; i_++)
v+=a.Get(Offs+i,i_)*work[i_+i1_];
a.Set(Offs+i,Offs+j,(a.Get(Offs+i,Offs+j)-v));
}
}
}
//--- exit the function
return;
}
//--- Recursive code:
//--- ( L1 ) ( U1 U12 )
//--- A = ( ) * ( )
//--- ( L12 L2 ) ( U2 )
//--- ( W X )
//--- A^-1 = ( )
//--- ( Y Z )
//--- In-place calculation can be done as follows:
//--- * X := inv(U1)*U12*inv(U2)
//--- * Y := inv(L2)*L12*inv(L1)
//--- * W := inv(L1*U1)+X*Y
//--- * X := -X*inv(L2)
//--- * Y := -inv(U2)*Y
//--- * Z := inv(L2*U2)
//--- Reordering w.r.t. interdependencies gives us:
//--- * X := inv(U1)*U12 \ suitable for parallel execution
//--- * Y := L12*inv(L1) /
//--- * X := X*inv(U2) \
//--- * Y := inv(L2)*Y | suitable for parallel execution
//--- * W := inv(L1*U1) /
//--- * W := W+X*Y
//--- * X := -X*inv(L2) \ suitable for parallel execution
//--- * Y := -inv(U2)*Y /
//--- * Z := inv(L2*U2)
CApServ::TiledSplit(n,tscur,n1,n2);
//--- check
if(!CAp::Assert(n2>0,__FUNCTION__+": internal error!"))
return;
//--- X := inv(U1)*U12
//--- Y := L12*inv(L1)
CAblas::RMatrixLeftTrsM(n1,n2,a,Offs,Offs,true,false,0,a,Offs,Offs+n1);
CAblas::RMatrixRightTrsM(n2,n1,a,Offs,Offs,false,true,0,a,Offs+n1,Offs);
//--- X := X*inv(U2)
//--- Y := inv(L2)*Y
//--- W := inv(L1*U1)
CAblas::RMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,true,false,0,a,Offs,Offs+n1);
CAblas::RMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,false,true,0,a,Offs+n1,Offs);
RMatrixLUInverseRec(a,Offs,n1,work,info,rep);
//--- check
if(info<=0)
return;
//--- W := W+X*Y
CAblas::RMatrixGemm(n1,n1,n2,1.0,a,Offs,Offs+n1,0,a,Offs+n1,Offs,0,1.0,a,Offs,Offs);
//--- X :=-X*inv(L2)
//--- Y :=-inv(U2)*Y
CAblas::RMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,false,true,0,a,Offs,Offs+n1);
CAblas::RMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,true,false,0,a,Offs+n1,Offs);
for(i=0; i<n1; i++)
{
for(i_=Offs+n1; i_<=Offs+n-1; i_++)
a.Set(Offs+i,i_,-a.Get(Offs+i,i_));
}
for(i=0; i<n2; i++)
{
for(i_=Offs; i_<=Offs+n1-1; i_++)
a.Set(Offs+n1+i,i_,-a.Get(Offs+n1+i,i_));
}
//--- Z :=inv(L2*U2)
RMatrixLUInverseRec(a,Offs+n1,n2,work,info,rep);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CMatInv::CMatrixLUInverseRec(CMatrixComplex &a,const int Offs,
const int n,CRowComplex &work,
int &info,CMatInvReport &rep)
{
//--- check
if(n<1)
{
info=-1;
//--- exit the function
return;
}
//--- create variables
complex One=1.0;
complex _One=-1.0;
int i=0;
int j=0;
complex v=0;
int n1=0;
int n2=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
if(n<=tsb)
tscur=tsa;
//--- base case
if(n<=tsa)
{
//--- Form inv(U)
CMatrixTrInverseRec(a,Offs,n,true,false,work,info);
//--- check
if(info<=0)
return;
//--- Solve the equation inv(A)*L = inv(U) for inv(A).
for(j=n-1; j>=0; j--)
{
//--- Copy current column of L to WORK and replace with zeros.
for(i=j+1; i<n; i++)
{
work.Set(i,a.Get(Offs+i,Offs+j));
a.Set(Offs+i,Offs+j,0.0);
}
//--- Compute current column of inv(A).
if(j<n-1)
{
for(i=0; i<n; i++)
{
i1_=-Offs;
v=0.0;
for(i_=Offs+j+1; i_<=Offs+n-1; i_++)
v+=a.Get(Offs+i,i_)*work[i_+i1_];
a.Set(Offs+i,Offs+j,a.Get(Offs+i,Offs+j)-v);
}
}
}
//--- exit the function
return;
}
//--- Recursive code:
//--- ( L1 ) ( U1 U12 )
//--- A = ( ) * ( )
//--- ( L12 L2 ) ( U2 )
//--- ( W X )
//--- A^-1 = ( )
//--- ( Y Z )
//--- In-place calculation can be done as follows:
//--- * X := inv(U1)*U12*inv(U2)
//--- * Y := inv(L2)*L12*inv(L1)
//--- * W := inv(L1*U1)+X*Y
//--- * X := -X*inv(L2)
//--- * Y := -inv(U2)*Y
//--- * Z := inv(L2*U2)
//--- Reordering w.r.t. interdependencies gives us:
//--- * X := inv(U1)*U12 \ suitable for parallel execution
//--- * Y := L12*inv(L1) /
//--- * X := X*inv(U2) \
//--- * Y := inv(L2)*Y | suitable for parallel execution
//--- * W := inv(L1*U1) /
//--- * W := W+X*Y
//--- * X := -X*inv(L2) \ suitable for parallel execution
//--- * Y := -inv(U2)*Y /
//--- * Z := inv(L2*U2)
CApServ::TiledSplit(n,tscur,n1,n2);
//--- check
if(!CAp::Assert(n2>0,__FUNCTION__+": internal error!"))
return;
//--- X := inv(U1)*U12
//--- Y := L12*inv(L1)
CAblas::CMatrixLeftTrsM(n1,n2,a,Offs,Offs,true,false,0,a,Offs,Offs+n1);
CAblas::CMatrixRightTrsM(n2,n1,a,Offs,Offs,false,true,0,a,Offs+n1,Offs);
//--- X := X*inv(U2)
//--- Y := inv(L2)*Y
//--- W := inv(L1*U1)
CAblas::CMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,true,false,0,a,Offs,Offs+n1);
CAblas::CMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,false,true,0,a,Offs+n1,Offs);
CMatrixLUInverseRec(a,Offs,n1,work,info,rep);
//--- check
if(info<=0)
return;
//--- W := W+X*Y
CAblas::CMatrixGemm(n1,n1,n2,One,a,Offs,Offs+n1,0,a,Offs+n1,Offs,0,One,a,Offs,Offs);
//--- X :=-X*inv(L2)
//--- Y :=-inv(U2)*Y
CAblas::CMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,false,true,0,a,Offs,Offs+n1);
CAblas::CMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,true,false,0,a,Offs+n1,Offs);
for(i=0; i<n1; i++)
{
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(Offs+i,i_,_One*a.Get(Offs+i,i_));
}
for(i=0; i<n2; i++)
{
for(i_=Offs; i_<=Offs+n1-1; i_++)
a.Set(Offs+n1+i,i_,_One*a.Get(Offs+n1+i,i_));
}
//--- Z :=inv(L2*U2)
CMatrixLUInverseRec(a,Offs+n1,n2,work,info,rep);
}
//+------------------------------------------------------------------+
//| Recursive subroutine for SPD inversion. |
//| NOTE: this function expects that matris is strictly |
//| positive-definite. |
//+------------------------------------------------------------------+
void CMatInv::SPDMatrixCholeskyInverseRec(CMatrixDouble &a,const int Offs,
const int n,const bool IsUpper,
CRowDouble &tmp)
{
//--- check
if(n<1)
return;
//--- create variables
int i=0;
int j=0;
double v=0;
int n1=0;
int n2=0;
int info2=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA();
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
//--- object of class
CMatInvReport rep2;
//--- base case
if(n<=tsb)
tscur=tsa;
if(n<=tsa)
{
info2=1;
RMatrixTrInverseRec(a,Offs,n,IsUpper,false,tmp,info2);
if(!CAp::Assert(info2>0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(IsUpper)
{
//--- Compute the product U * U'.
//--- NOTE: we never assume that diagonal of U is real
for(i=0; i<n; i++)
{
//--- check
if(i==0)
{
//--- 1x1 matrix
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i)));
}
else
{
//--- (I+1)x(I+1) matrix,
//--- ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H )
//--- ( ) * ( ) = ( )
//--- ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H )
//--- A11 is IxI, A22 is 1x1.
i1_=Offs;
for(i_=0; i_<i; i_++)
tmp.Set(i_,a.Get(i_+i1_,Offs+i));
for(j=0; j<i; j++)
{
v=a.Get(Offs+j,Offs+i);
i1_=-Offs;
for(i_=Offs+j; i_<Offs+i; i_++)
a.Set(Offs+j,i_,a.Get(Offs+j,i_)+v*tmp[i_+i1_]);
}
//--- change values
v=a.Get(Offs+i,Offs+i);
for(i_=Offs; i_<Offs+i; i_++)
a.Set(i_,Offs+i,v*a.Get(i_,Offs+i));
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i)));
}
}
}
else
{
//--- Compute the product L' * L
//--- NOTE: we never assume that diagonal of L is reall
for(i=0; i<n; i++)
{
//--- check
if(i==0)
{
//--- 1x1 matrix
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i)));
}
else
{
//--- (I+1)x(I+1) matrix,
//--- ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 )
//--- ( ) * ( ) = ( )
//--- ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 )
//--- A11 is IxI, A22 is 1x1.
i1_=Offs;
for(i_=0; i_<i; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
for(j=0; j<i; j++)
{
v=a.Get(Offs+i,Offs+j);
i1_=-Offs;
for(i_=Offs; i_<=Offs+j; i_++)
a.Add(Offs+j,i_,v*tmp[i_+i1_]);
}
//--- change values
v=a.Get(Offs+i,Offs+i);
for(i_=Offs; i_<Offs+i; i_++)
a.Mul(Offs+i,i_,v);
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i)));
}
}
}
//--- exit the function
return;
}
//--- Recursive code: triangular factor inversion merged with
//--- UU' or L'L multiplication
CApServ::TiledSplit(n,tscur,n1,n2);
//--- form off-diagonal block of trangular inverse
if(IsUpper)
{
for(i=0; i<n1; i++)
{
for(i_=Offs+n1; i_<=Offs+n-1; i_++)
a.Set(Offs+i,i_,-a.Get(Offs+i,i_));
}
//--- function call
CAblas::RMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,false,0,a,Offs,Offs+n1);
//--- function call
CAblas::RMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,false,0,a,Offs,Offs+n1);
}
else
{
for(i=0; i<n2; i++)
{
for(i_=Offs; i_<Offs+n1; i_++)
a.Set(Offs+n1+i,i_,-a.Get(Offs+n1+i,i_));
}
//--- function call
CAblas::RMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,false,0,a,Offs+n1,Offs);
//--- function call
CAblas::RMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,false,0,a,Offs+n1,Offs);
}
//--- invert first diagonal block
SPDMatrixCholeskyInverseRec(a,Offs,n1,IsUpper,tmp);
//--- update first diagonal block with off-diagonal block,
//--- update off-diagonal block
if(IsUpper)
{
//--- function call
CAblas::RMatrixSyrk(n1,n2,1.0,a,Offs,Offs+n1,0,1.0,a,Offs,Offs,IsUpper);
//--- function call
CAblas::RMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,false,1,a,Offs,Offs+n1);
}
else
{
//--- function call
CAblas::RMatrixSyrk(n1,n2,1.0,a,Offs+n1,Offs,1,1.0,a,Offs,Offs,IsUpper);
//--- function call
CAblas::RMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,false,1,a,Offs+n1,Offs);
}
//--- invert second diagonal block
SPDMatrixCholeskyInverseRec(a,Offs+n1,n2,IsUpper,tmp);
}
//+------------------------------------------------------------------+
//| Recursive subroutine for HPD inversion. |
//+------------------------------------------------------------------+
void CMatInv::HPDMatrixCholeskyInverseRec(CMatrixComplex &a,const int Offs,
const int n,const bool IsUpper,
CRowComplex &tmp)
{
//--- check
if(n<1)
return;
//--- create variables
complex _One=-1.0;
int i=0;
int j=0;
complex v=0;
int n1=0;
int n2=0;
int info2=0;
int i_=0;
int i1_=0;
int tsa=CApServ::MatrixTileSizeA()/2;
int tsb=CApServ::MatrixTileSizeB();
int tscur=tsb;
if(n<=tsb)
tscur=tsa;
//--- base case
if(n<=tsa)
{
info2=1;
CMatrixTrInverseRec(a,Offs,n,IsUpper,false,tmp,info2);
if(!CAp::Assert(info2>0,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(IsUpper)
{
//--- Compute the product U * U'.
//--- NOTE: we never assume that diagonal of U is real
for(i=0; i<n; i++)
{
//--- check
if(i==0)
{
//--- 1x1 matrix
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i).real)+CMath::Sqr(a.Get(Offs+i,Offs+i).imag));
}
else
{
//--- (I+1)x(I+1) matrix,
//--- ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H )
//--- ( ) * ( ) = ( )
//--- ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H )
//--- A11 is IxI, A22 is 1x1.
i1_=Offs;
for(i_=0; i_<=i-1; i_++)
tmp.Set(i_,CMath::Conj(a.Get(i_+i1_,Offs+i)));
for(j=0; j<i; j++)
{
v=a.Get(Offs+j,Offs+i);
i1_=-Offs;
for(i_=Offs+j; i_<Offs+i; i_++)
a.Set(Offs+j,i_,a.Get(Offs+j,i_)+v*tmp[i_+i1_]);
}
//--- change values
v=CMath::Conj(a.Get(Offs+i,Offs+i));
for(i_=Offs; i_<Offs+i; i_++)
a.Set(i_,Offs+i,v*a.Get(i_,Offs+i));
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i).real)+CMath::Sqr(a.Get(Offs+i,Offs+i).imag));
}
}
}
else
{
//--- Compute the product L' * L
//--- NOTE: we never assume that diagonal of L is reall
for(i=0; i<n; i++)
{
//--- check
if(i==0)
{
//--- 1x1 matrix
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i).real)+CMath::Sqr(a.Get(Offs+i,Offs+i).imag));
}
else
{
//--- (I+1)x(I+1) matrix,
//--- ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 )
//--- ( ) * ( ) = ( )
//--- ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 )
//--- A11 is IxI, A22 is 1x1.
i1_=Offs;
for(i_=0; i_<=i-1; i_++)
tmp.Set(i_,a.Get(Offs+i,i_+i1_));
for(j=0; j<i; j++)
{
v=CMath::Conj(a.Get(Offs+i,Offs+j));
i1_=-Offs;
for(i_=Offs; i_<=Offs+j; i_++)
a.Set(Offs+j,i_,a.Get(Offs+j,i_)+v*tmp[i_+i1_]);
}
v=CMath::Conj(a.Get(Offs+i,Offs+i));
for(i_=Offs; i_<Offs+i; i_++)
a.Set(Offs+i,i_,v*a.Get(Offs+i,i_));
a.Set(Offs+i,Offs+i,CMath::Sqr(a.Get(Offs+i,Offs+i).real)+CMath::Sqr(a.Get(Offs+i,Offs+i).imag));
}
}
}
//--- exit the function
return;
}
//--- Recursive code: triangular factor inversion merged with
//--- UU' or L'L multiplication
CApServ::TiledSplit(n,tscur,n1,n2);
//--- form off-diagonal block of trangular inverse
if(IsUpper)
{
for(i=0; i<n1; i++)
{
for(i_=Offs+n1; i_<Offs+n; i_++)
a.Set(Offs+i,i_,_One*a.Get(Offs+i,i_));
}
//--- function call
CAblas::CMatrixLeftTrsM(n1,n2,a,Offs,Offs,IsUpper,false,0,a,Offs,Offs+n1);
//--- function call
CAblas::CMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,false,0,a,Offs,Offs+n1);
}
else
{
for(i=0; i<n2; i++)
{
for(i_=Offs; i_<=Offs+n1-1; i_++)
a.Set(Offs+n1+i,i_,_One*a.Get(Offs+n1+i,i_));
}
//--- function call
CAblas::CMatrixRightTrsM(n2,n1,a,Offs,Offs,IsUpper,false,0,a,Offs+n1,Offs);
//--- function call
CAblas::CMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,false,0,a,Offs+n1,Offs);
}
//--- invert first diagonal block
HPDMatrixCholeskyInverseRec(a,Offs,n1,IsUpper,tmp);
//--- update first diagonal block with off-diagonal block,
//--- update off-diagonal block
if(IsUpper)
{
//--- function call
CAblas::CMatrixHerk(n1,n2,1.0,a,Offs,Offs+n1,0,1.0,a,Offs,Offs,IsUpper);
//--- function call
CAblas::CMatrixRightTrsM(n1,n2,a,Offs+n1,Offs+n1,IsUpper,false,2,a,Offs,Offs+n1);
}
else
{
//--- function call
CAblas::CMatrixHerk(n1,n2,1.0,a,Offs+n1,Offs,2,1.0,a,Offs,Offs,IsUpper);
//--- function call
CAblas::CMatrixLeftTrsM(n2,n1,a,Offs+n1,Offs+n1,IsUpper,false,2,a,Offs+n1,Offs);
}
//--- invert second diagonal block
HPDMatrixCholeskyInverseRec(a,Offs+n1,n2,IsUpper,tmp);
}
//+------------------------------------------------------------------+
//| Singular value decomposition of a bidiagonal matrix |
//+------------------------------------------------------------------+
class CBdSingValueDecompose
{
public:
static bool RMatrixBdSVD(double &d[],double &ce[],const int n,const bool IsUpper,const bool isfractionalaccuracyrequired,CMatrixDouble &u,const int nru,CMatrixDouble &c,const int ncc,CMatrixDouble &vt,const int ncvt);
static bool RMatrixBdSVD(CRowDouble &d,CRowDouble &ce,const int n,const bool IsUpper,const bool isfractionalaccuracyrequired,CMatrixDouble &u,const int nru,CMatrixDouble &c,const int ncc,CMatrixDouble &vt,const int ncvt);
static bool BidiagonalSVDDecomposition(double &d[],double &ce[],const int n,const bool IsUpper,const bool isfractionalaccuracyrequired,CMatrixDouble &u,const int nru,CMatrixDouble &c,const int ncc,CMatrixDouble &vt,const int ncvt);
static bool BidiagonalSVDDecomposition(CRowDouble &d,CRowDouble &ce,const int n,const bool IsUpper,const bool isfractionalaccuracyrequired,CMatrixDouble &u,const int nru,CMatrixDouble &c,const int ncc,CMatrixDouble &vt,const int ncvt);
private:
static bool BidiagonalSVDDecompositionInternal(CRowDouble &d,CRowDouble &ce,const int n,const bool IsUpper,const bool isfractionalaccuracyrequired,CMatrixDouble &u,const int ustart,const int nru,CMatrixDouble &c,const int cstart,const int ncc,CMatrixDouble &vt,const int vstart,const int ncvt);
static double ExtSignBdSQR(const double a,const double b);
static void SVD2x2(const double f,const double g,const double h,double &ssmin,double &ssmax);
static void SVDV2x2(const double f,const double g,const double h,double &ssmin,double &ssmax,double &snr,double &csr,double &snl,double &csl);
};
//+------------------------------------------------------------------+
//| Singular value decomposition of a bidiagonal matrix (extended |
//| algorithm) |
//| The algorithm performs the singular value decomposition of a |
//| bidiagonal matrix B (upper or lower) representing it as |
//| B = Q*S*P^T, where Q and P - orthogonal matrices, S - diagonal |
//| matrix with non-negative elements on the main diagonal, in |
//| descending order. |
//| The algorithm finds singular values. In addition, the algorithm |
//| can calculate matrices Q and P (more precisely, not the matrices,|
//| but their product with given matrices U and VT - U*Q and |
//| (P^T)*VT)). Of course, matrices U and VT can be of any type, |
//| including identity. Furthermore, the algorithm can calculate Q'*C|
//| (this product is calculated more effectively than U*Q, because |
//| this calculation operates with rows instead of matrix columns). |
//| The feature of the algorithm is its ability to find all singular |
//| values including those which are arbitrarily close to 0 with |
//| relative accuracy close to machine precision. If the parameter |
//| IsFractionalAccuracyRequired is set to True, all singular values |
//| will have high relative accuracy close to machine precision. If |
//| the parameter is set to False, only the biggest singular value |
//| will have relative accuracy close to machine precision. The |
//| absolute error of other singular values is equal to the absolute |
//| error of the biggest singular value. |
//| Input parameters: |
//| D - main diagonal of matrix B. |
//| Array whose index ranges within [0..N-1]. |
//| E - superdiagonal (or subdiagonal) of matrix B. |
//| Array whose index ranges within [0..N-2]. |
//| N - size of matrix B. |
//| IsUpper - True, if the matrix is upper bidiagonal. |
//| IsFractionalAccuracyRequired - |
//| accuracy to search singular values with. |
//| U - matrix to be multiplied by Q. |
//| Array whose indexes range within |
//| [0..NRU-1, 0..N-1]. |
//| The matrix can be bigger, in that case only the |
//| submatrix [0..NRU-1, 0..N-1] will be multiplied |
//| by Q. |
//| NRU - number of rows in matrix U. |
//| C - matrix to be multiplied by Q'. |
//| Array whose indexes range within |
//| [0..N-1, 0..NCC-1]. |
//| The matrix can be bigger, in that case only the |
//| submatrix [0..N-1, 0..NCC-1] will be multiplied |
//| by Q'. |
//| NCC - number of columns in matrix C. |
//| VT - matrix to be multiplied by P^T. |
//| Array whose indexes range within |
//| [0..N-1, 0..NCVT-1]. |
//| The matrix can be bigger, in that case only the |
//| submatrix [0..N-1, 0..NCVT-1] will be multiplied |
//| by P^T. |
//| NCVT - number of columns in matrix VT. |
//| Output parameters: |
//| D - singular values of matrix B in descending order. |
//| U - if NRU>0, contains matrix U*Q. |
//| VT - if NCVT>0, contains matrix (P^T)*VT. |
//| C - if NCC>0, contains matrix Q'*C. |
//| Result: |
//| True, if the algorithm has converged. |
//| False, if the algorithm hasn't converged (rare case). |
//| Additional information: |
//| The type of convergence is controlled by the internal |
//| parameter TOL. If the parameter is greater than 0, the |
//| singular values will have relative accuracy TOL. If TOL<0, |
//| the singular values will have absolute accuracy |
//| ABS(TOL)*norm(B). By default, |TOL| falls within the range of|
//| 10*Epsilon and 100*Epsilon, where Epsilon is the machine |
//| precision. It is not recommended to use TOL less than |
//| 10*Epsilon since this will considerably slow down the |
//| algorithm and may not lead to error decreasing. |
//| History: |
//| * 31 March, 2007. |
//| changed MAXITR from 6 to 12. |
//| -- LAPACK routine (version 3.0) -- |
//| Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
//| Courant Institute, Argonne National Lab, and Rice University|
//| October 31, 1999. |
//+------------------------------------------------------------------+
bool CBdSingValueDecompose::RMatrixBdSVD(double &d[],double &e[],
const int n,const bool IsUpper,
const bool isfractionalaccuracyrequired,
CMatrixDouble &u,const int nru,
CMatrixDouble &c,const int ncc,
CMatrixDouble &vt,const int ncvt)
{
//--- create variables
bool result;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble d1;
CRowDouble e1;
//--- Use ALGLIB code
//--- allocation
d1=vector<double>::Zeros(n+1);
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
d1.Set(i_,d[i_+i1_]);
//--- check
if(n>1)
{
//--- allocation
e1=vector<double>::Zeros(n);
//--- change values
i1_=-1;
for(i_=1; i_<n; i_++)
e1.Set(i_,e[i_+i1_]);
}
//--- get result
result=BidiagonalSVDDecompositionInternal(d1,e1,n,IsUpper,isfractionalaccuracyrequired,u,0,nru,c,0,ncc,vt,0,ncvt);
//--- change values
i1_=1;
for(i_=0; i_<n; i_++)
d[i_]=d1[i_+i1_];
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
bool CBdSingValueDecompose::RMatrixBdSVD(CRowDouble &d,CRowDouble &e,
const int n,const bool IsUpper,
const bool isfractionalaccuracyrequired,
CMatrixDouble &u,const int nru,
CMatrixDouble &c,const int ncc,
CMatrixDouble &vt,const int ncvt)
{
//--- create variables
bool result;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble d1;
CRowDouble e1;
//--- Use ALGLIB code
//--- allocation
d1=vector<double>::Zeros(n+1);
//--- change values
i1_=-1;
for(i_=1; i_<=n; i_++)
d1.Set(i_,d[i_+i1_]);
//--- check
if(n>1)
{
//--- allocation
e1=vector<double>::Zeros(n);
//--- change values
i1_=-1;
for(i_=1; i_<n; i_++)
e1.Set(i_,e[i_+i1_]);
}
//--- get result
result=BidiagonalSVDDecompositionInternal(d1,e1,n,IsUpper,isfractionalaccuracyrequired,u,0,nru,c,0,ncc,vt,0,ncvt);
//--- change values
i1_=1;
for(i_=0; i_<n; i_++)
d.Set(i_,d1[i_+i1_]);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Singular value decomposition of a bidiagonal matrix |
//+------------------------------------------------------------------+
bool CBdSingValueDecompose::BidiagonalSVDDecomposition(double &d[],double &ce[],
const int n,const bool IsUpper,
const bool isfractionalaccuracyrequired,
CMatrixDouble &u,const int nru,
CMatrixDouble &c,const int ncc,
CMatrixDouble &vt,const int ncvt)
{
//--- create copy
CRowDouble D=d;
CRowDouble E=ce;
//--- call function
if(!BidiagonalSVDDecompositionInternal(D,E,n,IsUpper,isfractionalaccuracyrequired,u,1,nru,c,1,ncc,vt,1,ncvt))
return(false);
D.ToArray(d);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
bool CBdSingValueDecompose::BidiagonalSVDDecomposition(CRowDouble &d,CRowDouble &ce,
const int n,const bool IsUpper,
const bool isfractionalaccuracyrequired,
CMatrixDouble &u,const int nru,
CMatrixDouble &c,const int ncc,
CMatrixDouble &vt,const int ncvt)
{
return(BidiagonalSVDDecompositionInternal(d,ce,n,IsUpper,isfractionalaccuracyrequired,u,1,nru,c,1,ncc,vt,1,ncvt));
}
//+------------------------------------------------------------------+
//| Internal working subroutine for bidiagonal decomposition |
//+------------------------------------------------------------------+
bool CBdSingValueDecompose::BidiagonalSVDDecompositionInternal(CRowDouble &d,CRowDouble &ce,
const int n,const bool IsUpper,
const bool isfractionalaccuracyrequired,
CMatrixDouble &u,const int ustart,
const int nru,CMatrixDouble &c,
const int cstart,const int ncc,
CMatrixDouble &vt,const int vstart,
const int ncvt)
{
//--- check
if(n==0)
return(true);
//--- create variables
bool result=true;
int i=0;
int idir=0;
int isub=0;
int iter=0;
int j=0;
int ll=0;
int lll=0;
int m=0;
int maxit=0;
int oldll=0;
int oldm=0;
double abse=0;
double abss=0;
double cosl=0;
double cosr=0;
double cs=0;
double eps=0;
double f=0;
double g=0;
double h=0;
double mu=0;
double oldcs=0;
double oldsn=0;
double r=0;
double shift=0;
double sigmn=0;
double sigmx=0;
double sinl=0;
double sinr=0;
double sll=0;
double smax=0;
double smin=0;
double sminl=0;
double sminlo=0;
double sminoa=0;
double sn=0;
double thresh=0;
double tol=0;
double tolmul=0;
double unfl=0;
int maxitr=12;
bool matrixsplitflag;
bool iterflag;
bool rightside=true;
bool fwddir=true;
double tmp=0;
int mm1=0;
int mm0=0;
bool bchangedir;
int uend=0;
int cend=0;
int vend=0;
int i_=0;
//--- create arrays
CRowDouble work0;
CRowDouble work1;
CRowDouble work2;
CRowDouble work3;
CRowDouble utemp;
CRowDouble vttemp;
CRowDouble ctemp;
CRowDouble etemp;
//--- create copy
CRowDouble e=ce;
//--- check
if(n==1)
{
//--- check
if(d[1]<0.0)
{
d.Set(1,-d[1]);
//--- check
if(ncvt>0)
for(i_=vstart; i_<vstart+ncvt; i_++)
vt.Set(vstart,i_,-vt.Get(vstart,i_));
}
//--- return result
return(result);
}
//--- allocation
work0=vector<double>::Zeros(n);
work1=vector<double>::Zeros(n);
work2=vector<double>::Zeros(n);
work3=vector<double>::Zeros(n);
uend=ustart+(int)MathMax(nru-1,0);
vend=vstart+(int)MathMax(ncvt-1,0);
cend=cstart+(int)MathMax(ncc-1,0);
utemp=vector<double>::Zeros(uend+1);
vttemp=vector<double>::Zeros(vend+1);
ctemp=vector<double>::Zeros(cend+1);
//--- resize E from N-1 to N
e.Resize(n+1);
e.Set(n,0);
idir=0;
//--- initialization
eps=CMath::m_machineepsilon;
unfl=CMath::m_minrealnumber;
//--- If matrix lower bidiagonal, rotate to be upper bidiagonal
//--- by applying Givens rotations on the left
if(!IsUpper)
{
for(i=1; i<n; i++)
{
//--- function call
CRotations::GenerateRotation(d[i],e[i],cs,sn,r);
d.Set(i,r);
e.Set(i,sn*d[i+1]);
d.Set(i+1,cs*d[i+1]);
work0.Set(i,cs);
work1.Set(i,sn);
}
//--- Update singular vectors if desired
if(nru>0)
//--- function call
CRotations::ApplyRotationsFromTheRight(fwddir,ustart,uend,1+ustart-1,n+ustart-1,work0,work1,u,utemp);
//--- check
if(ncc>0)
//--- function call
CRotations::ApplyRotationsFromTheLeft(fwddir,cstart,n+cstart-1,cstart,cend,work0,work1,c,ctemp);
}
//--- Compute singular values to relative accuracy TOL
//--- (By setting TOL to be negative, algorithm will compute
//--- singular values to absolute accuracy ABS(TOL)*norm(input matrix))
tolmul=MathMax(10,MathMin(100,MathPow(eps,-0.125)));
tol=tolmul*eps;
//--- check
if(!isfractionalaccuracyrequired)
tol=-tol;
sminl=0;
//--- check
if(tol>=0.0)
{
//--- Relative accuracy desired
sminoa=MathAbs(d[1]);
//--- check
if(sminoa!=0.0)
{
mu=sminoa;
for(i=2; i<=n; i++)
{
mu=MathAbs(d[i])*(mu/(mu+MathAbs(e[i-1])));
sminoa=MathMin(sminoa,mu);
//--- check
if(sminoa==0.0)
break;
}
}
//--- change values
sminoa/=MathSqrt(n);
thresh=MathMax(tol*sminoa,maxitr*n*n*unfl);
}
else
{
//--- Compute approximate maximum, minimum singular values
smax=0;
for(i=1; i<n; i++)
smax=MathMax(smax,MathMax(MathAbs(d[i]),MathAbs(e[i])));
smax=MathMax(smax,MathAbs(d[n]));
//--- Absolute accuracy desired
thresh=MathMax(MathAbs(tol)*smax,maxitr*n*n*unfl);
}
//--- Prepare for main iteration loop for the singular values
//--- (MAXIT is the maximum number of passes through the inner
//--- loop permitted before nonconvergence signalled.)
maxit=maxitr*n*n;
iter=0;
oldll=-1;
oldm=-1;
//--- M points to last element of unconverged part of matrix
m=n;
//--- Begin main iteration loop
//--- Check for convergence or exceeding iteration count
while(m>1)
{
//--- check
if(iter>maxit)
return(false);
//--- Find diagonal block of matrix to work on
if(tol<0.0 && MathAbs(d[m])<=thresh)
d.Set(m,0.0);
//--- change values
smax=MathAbs(d[m]);
smin=smax;
matrixsplitflag=false;
for(lll=1; lll<m; lll++)
{
ll=m-lll;
abss=MathAbs(d[ll]);
abse=MathAbs(e[ll]);
//--- check
if(tol<0.0 && abss<=thresh)
d.Set(ll,0.0);
//--- check
if(abse<=thresh)
{
matrixsplitflag=true;
break;
}
//--- change values
smin=MathMin(smin,abss);
smax=MathMax(smax,MathMax(abss,abse));
}
//--- check
if(!matrixsplitflag)
ll=0;
else
{
//--- Matrix splits since E(LL) = 0
e.Set(ll,0.0);
//--- check
if(ll==m-1)
{
//--- Convergence of bottom singular value, return to top of loop
m --;
continue;
}
}
ll++;
//--- E(LL) through E(M-1) are nonzero, E(LL-1) is zero
if(ll==m-1)
{
//--- 2 by 2 block, handle separately
SVDV2x2(d[m-1],e[m-1],d[m],sigmn,sigmx,sinr,cosr,sinl,cosl);
d.Set(m-1,sigmx);
e.Set(m-1,0.0);
d.Set(m,sigmn);
//--- Compute singular vectors, if desired
if(ncvt>0)
{
mm0=m+(vstart-1);
mm1=mm0-1;
//--- swap
for(i_=vstart; i_<=vend; i_++)
{
vttemp.Set(i_,cosr*vt.Get(mm1,i_)+sinr*vt.Get(mm0,i_));
vt.Set(mm0,i_,(cosr*vt.Get(mm0,i_)-sinr*vt.Get(mm1,i_)));
vt.Set(mm1,i_,vttemp[i_]);
}
}
//--- check
if(nru>0)
{
mm0=m+ustart-1;
mm1=m-1+ustart-1;
//--- swap
for(i_=ustart; i_<=uend; i_++)
{
utemp.Set(i_,cosl*u.Get(i_,mm1)+sinl*u.Get(i_,mm0));
u.Set(i_,mm0,(cosl*u.Get(i_,mm0)-sinl*u.Get(i_,mm1)));
u.Set(i_,mm1,utemp[i_]);
}
}
//--- check
if(ncc>0)
{
mm0=m+cstart-1;
mm1=m-1+cstart-1;
//--- swap
for(i_=cstart; i_<=cend; i_++)
{
ctemp.Set(i_,cosl*c.Get(mm1,i_)+sinl*c.Get(mm0,i_));
c.Set(mm0,i_,(cosl*c.Get(mm0,i_)-sinl*c.Get(mm1,i_)));
c.Set(mm1,i_,ctemp[i_]);
}
}
m-=2;
continue;
}
//--- If working on new submatrix, choose shift direction
//--- (from larger end diagonal element towards smaller)
//--- Previously was
//--- "if (LL>OLDM) or (M<OLDLL) then"
//--- fixed thanks to Michael Rolle < m@rolle.name >
//--- Very strange that LAPACK still contains it.
bchangedir=false;
//--- check
if(idir==1 && MathAbs(d[ll])<1.0E-3*MathAbs(d[m]))
bchangedir=true;
//--- check
if(idir==2 && MathAbs(d[m])<1.0E-3*MathAbs(d[ll]))
bchangedir=true;
//--- check
if(ll!=oldll || m!=oldm || bchangedir)
{
//--- check
if(MathAbs(d[ll])>=MathAbs(d[m]))
//--- Chase bulge from top(big end) to bottom(small end)
idir=1;
else
//--- Chase bulge from bottom (big end) to top (small end)
idir=2;
}
//--- Apply convergence tests
if(idir==1)
{
//--- Run convergence test in forward direction
//--- First apply standard test to bottom of matrix
if(MathAbs(e[m-1])<=MathAbs(tol)*MathAbs(d[m]) || (tol<0.0 && MathAbs(e[m-1])<=thresh))
{
e.Set(m-1,0.0);
continue;
}
//--- check
if(tol>=0.0)
{
//--- If relative accuracy desired,
//--- apply convergence criterion forward
mu=MathAbs(d[ll]);
sminl=mu;
iterflag=false;
for(lll=ll; lll<m; lll++)
{
//--- check
if(MathAbs(e[lll])<=tol*mu)
{
e.Set(lll,0.0);
iterflag=true;
//--- break the cycle
break;
}
//--- change values
mu=MathAbs(d[lll+1])*(mu/(mu+MathAbs(e[lll])));
sminl=MathMin(sminl,mu);
}
//--- check
if(iterflag)
continue;
}
}
else
{
//--- Run convergence test in backward direction
//--- First apply standard test to top of matrix
if(MathAbs(e[ll])<=MathAbs(tol)*MathAbs(d[ll]) || (tol<0.0 && MathAbs(e[ll])<=thresh))
{
e.Set(ll,0.0);
continue;
}
//--- check
if(tol>=0.0)
{
//--- If relative accuracy desired,
//--- apply convergence criterion backward
mu=MathAbs(d[m]);
sminl=mu;
iterflag=false;
for(lll=m-1; lll>=ll; lll--)
{
//--- check
if(MathAbs(e[lll])<=(double)(tol*mu))
{
e.Set(lll,0.0);
iterflag=true;
//--- break the cycle
break;
}
mu=MathAbs(d[lll])*(mu/(mu+MathAbs(e[lll])));
sminl=MathMin(sminl,mu);
}
//--- check
if(iterflag)
continue;
}
}
//--- change values
oldll=ll;
oldm=m;
//--- Compute shift. First, test if shifting would ruin relative
//--- accuracy, and if so set the shift to zero.
if(tol>=0.0 && n*tol*(sminl/smax)<=MathMax(eps,0.01*tol))
//--- Use a zero shift to avoid loss of relative accuracy
shift=0;
else
{
//--- Compute the shift from 2-by-2 block at end of matrix
if(idir==1)
{
sll=MathAbs(d[ll]);
SVD2x2(d[m-1],e[m-1],d[m],shift,r);
}
else
{
sll=MathAbs(d[m]);
SVD2x2(d[ll],e[ll],d[ll+1],shift,r);
}
//--- Test if shift negligible, and if so set to zero
if(sll>0.0)
{
//--- check
if(CMath::Sqr(shift/sll)<eps)
shift=0;
}
}
//--- Increment iteration count
iter+=m-ll;
//--- If SHIFT = 0, do simplified QR iteration
if(shift==0.0)
{
//--- check
if(idir==1)
{
//--- Chase bulge from top to bottom
//--- Save cosines and sines for later singular vector updates
cs=1;
oldcs=1;
for(i=ll; i<m; i++)
{
//--- function call
CRotations::GenerateRotation(d[i]*cs,e[i],cs,sn,r);
//--- check
if(i>ll)
e.Set(i-1,oldsn*r);
//--- function call
CRotations::GenerateRotation(oldcs*r,d[i+1]*sn,oldcs,oldsn,tmp);
//--- change values
d.Set(i,tmp);
work0.Set(i-ll+1,cs);
work1.Set(i-ll+1,sn);
work2.Set(i-ll+1,oldcs);
work3.Set(i-ll+1,oldsn);
}
//--- change values
h=d[m]*cs;
d.Set(m,h*oldcs);
e.Set(m-1,h*oldsn);
//--- Update singular vectors
if(ncvt>0)
{
//--- function call
CRotations::ApplyRotationsFromTheLeft(fwddir,ll+vstart-1,m+vstart-1,vstart,vend,work0,work1,vt,vttemp);
}
//--- check
if(nru>0)
{
//--- function call
CRotations::ApplyRotationsFromTheRight(fwddir,ustart,uend,ll+ustart-1,m+ustart-1,work2,work3,u,utemp);
}
//--- check
if(ncc>0)
{
//--- function call
CRotations::ApplyRotationsFromTheLeft(fwddir,ll+cstart-1,m+cstart-1,cstart,cend,work2,work3,c,ctemp);
}
//--- Check for convergence
if(MathAbs(e[m-1])<=thresh)
e.Set(m-1,0);
}
else
{
//--- Chase bulge from bottom to top
//--- Save cosines and sines for later singular vector updates
cs=1;
oldcs=1;
for(i=m; i>ll; i--)
{
//--- function call
CRotations::GenerateRotation(d[i]*cs,e[i-1],cs,sn,r);
//--- check
if(i<m)
e.Set(i,oldsn*r);
//--- function call
CRotations::GenerateRotation(oldcs*r,d[i-1]*sn,oldcs,oldsn,tmp);
//--- change values
d.Set(i,tmp);
work0.Set(i-ll,cs);
work1.Set(i-ll,-sn);
work2.Set(i-ll,oldcs);
work3.Set(i-ll,-oldsn);
}
//--- change values
h=d[ll]*cs;
d.Set(ll,h*oldcs);
e.Set(ll,h*oldsn);
//--- Update singular vectors
if(ncvt>0)
{
//--- function call
CRotations::ApplyRotationsFromTheLeft(!fwddir,ll+vstart-1,m+vstart-1,vstart,vend,work2,work3,vt,vttemp);
}
//--- check
if(nru>0)
{
//--- function call
CRotations::ApplyRotationsFromTheRight(!fwddir,ustart,uend,ll+ustart-1,m+ustart-1,work0,work1,u,utemp);
}
//--- check
if(ncc>0)
{
//--- function call
CRotations::ApplyRotationsFromTheLeft(!fwddir,ll+cstart-1,m+cstart-1,cstart,cend,work0,work1,c,ctemp);
}
//--- Check for convergence
if(MathAbs(e[ll])<=thresh)
e.Set(ll,0);
}
}
else
{
//--- Use nonzero shift
if(idir==1)
{
//--- Chase bulge from top to bottom
//--- Save cosines and sines for later singular vector updates
f=(MathAbs(d[ll])-shift)*(ExtSignBdSQR(1,d[ll])+shift/d[ll]);
g=e[ll];
for(i=ll; i<m; i++)
{
//--- function call
CRotations::GenerateRotation(f,g,cosr,sinr,r);
//--- check
if(i>ll)
e.Set(i-1,r);
//--- change values
f=cosr*d[i]+sinr*e[i];
e.Set(i,cosr*e[i]-sinr*d[i]);
g=sinr*d[i+1];
d.Set(i+1,cosr*d[i+1]);
//--- function call
CRotations::GenerateRotation(f,g,cosl,sinl,r);
//--- change values
d.Set(i,r);
f=cosl*e[i]+sinl*d[i+1];
d.Set(i+1,cosl*d[i+1]-sinl*e[i]);
//--- check
if(i<m-1)
{
g=sinl*e[i+1];
e.Set(i+1,cosl*e[i+1]);
}
//--- change values
work0.Set(i-ll+1,cosr);
work1.Set(i-ll+1,sinr);
work2.Set(i-ll+1,cosl);
work3.Set(i-ll+1,sinl);
}
e.Set(m-1,f);
//--- Update singular vectors
if(ncvt>0)
//--- function call
CRotations::ApplyRotationsFromTheLeft(fwddir,ll+vstart-1,m+vstart-1,vstart,vend,work0,work1,vt,vttemp);
if(nru>0)
//--- function call
CRotations::ApplyRotationsFromTheRight(fwddir,ustart,uend,ll+ustart-1,m+ustart-1,work2,work3,u,utemp);
if(ncc>0)
//--- function call
CRotations::ApplyRotationsFromTheLeft(fwddir,ll+cstart-1,m+cstart-1,cstart,cend,work2,work3,c,ctemp);
//--- Check for convergence
if(MathAbs(e[m-1])<=thresh)
e.Set(m-1,0.0);
}
else
{
//--- Chase bulge from bottom to top
//--- Save cosines and sines for later singular vector updates
f=(MathAbs(d[m])-shift)*(ExtSignBdSQR(1,d[m])+shift/d[m]);
g=e[m-1];
for(i=m; i>ll; i--)
{
//--- function call
CRotations::GenerateRotation(f,g,cosr,sinr,r);
//--- check
if(i<m)
e.Set(i,r);
//--- change values
f=cosr*d[i]+sinr*e[i-1];
e.Set(i-1,cosr*e[i-1]-sinr*d[i]);
g=sinr*d[i-1];
d.Set(i-1,cosr*d[i-1]);
//--- function call
CRotations::GenerateRotation(f,g,cosl,sinl,r);
//--- change values
d.Set(i,r);
f=cosl*e[i-1]+sinl*d[i-1];
d.Set(i-1,cosl*d[i-1]-sinl*e[i-1]);
//--- check
if(i>ll+1)
{
g=sinl*e[i-2];
e.Set(i-2,cosl*e[i-2]);
}
//--- change values
work0.Set(i-ll,cosr);
work1.Set(i-ll,-sinr);
work2.Set(i-ll,cosl);
work3.Set(i-ll,-sinl);
}
e.Set(ll,f);
//--- Check for convergence
if(MathAbs(e[ll])<=thresh)
e.Set(ll,0);
//--- Update singular vectors if desired
if(ncvt>0)
//--- function call
CRotations::ApplyRotationsFromTheLeft(!fwddir,ll+vstart-1,m+vstart-1,vstart,vend,work2,work3,vt,vttemp);
//--- check
if(nru>0)
//--- function call
CRotations::ApplyRotationsFromTheRight(!fwddir,ustart,uend,ll+ustart-1,m+ustart-1,work0,work1,u,utemp);
//--- check
if(ncc>0)
//--- function call
CRotations::ApplyRotationsFromTheLeft(!fwddir,ll+cstart-1,m+cstart-1,cstart,cend,work0,work1,c,ctemp);
}
}
//--- QR iteration finished, go back and check convergence
continue;
}
//--- All singular values converged, so make them positive
for(i=1; i<=n; i++)
{
//--- check
if(d[i]<0.0)
{
d.Set(i,-d[i]);
//--- Change sign of singular vectors, if desired
if(ncvt>0)
{
for(i_=vstart; i_<=vend; i_++)
vt.Mul(i+vstart-1,i_,-1);
}
}
}
//--- Sort the singular values into decreasing order (insertion sort on
//--- singular values, but only one transposition per singular vector)
for(i=1; i<n; i++)
{
//--- Scan for smallest D(I)
isub=1;
smin=d[1];
for(j=2; j<=n+1-i; j++)
{
//--- check
if(d[j]<=smin)
{
isub=j;
smin=d[j];
}
}
//--- check
if(isub!=n+1-i)
{
//--- Swap singular values and vectors
d.Set(isub,d[n+1-i]);
d.Set(n+1-i,smin);
//--- check
if(ncvt>0)
{
j=n+1-i;
//--- swap
for(i_=vstart; i_<=vend; i_++)
{
vttemp.Set(i_,vt.Get(isub+vstart-1,i_));
vt.Set(isub+vstart-1,i_,vt.Get(j+vstart-1,i_));
vt.Set(j+vstart-1,i_,vttemp[i_]);
}
}
if(nru>0)
{
j=n+1-i;
//--- swap
for(i_=ustart; i_<=uend; i_++)
{
utemp.Set(i_,u.Get(i_,isub+ustart-1));
u.Set(i_,isub+ustart-1,u.Get(i_,j+ustart-1));
u.Set(i_,j+ustart-1,utemp[i_]);
}
}
//--- check
if(ncc>0)
{
j=n+1-i;
//--- swap
for(i_=cstart; i_<=cend; i_++)
{
ctemp.Set(i_,c.Get(isub+cstart-1,i_));
c.Set(isub+cstart-1,i_,c.Get(j+cstart-1,i_));
c.Set(j+cstart-1,i_,ctemp[i_]);
}
}
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
double CBdSingValueDecompose::ExtSignBdSQR(const double a,
const double b)
{
//--- create a variable
double result=0;
//--- check
if(b>=0.0)
result=MathAbs(a);
else
result=-MathAbs(a);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CBdSingValueDecompose::SVD2x2(const double f,const double g,
const double h,double &ssmin,
double &ssmax)
{
//--- create variables
double aas=0;
double at=0;
double au=0;
double c=0;
double fa=MathAbs(f);
double ga=MathAbs(g);
double ha=MathAbs(h);
double fhmn=MathMin(fa,ha);
double fhmx=MathMax(fa,ha);
//--- initialization
ssmin=0;
ssmax=0;
//--- check
if(fhmn==0.0)
{
ssmin=0;
//--- check
if(fhmx==0.0)
ssmax=ga;
else
ssmax=MathMax(fhmx,ga)*MathSqrt(1+CMath::Sqr(MathMin(fhmx,ga)/MathMax(fhmx,ga)));
}
else
{
//--- check
if(ga<fhmx)
{
//--- change values
aas=1+fhmn/fhmx;
at=(fhmx-fhmn)/fhmx;
au=CMath::Sqr(ga/fhmx);
c=2/(MathSqrt(aas*aas+au)+MathSqrt(at*at+au));
ssmin=fhmn*c;
ssmax=fhmx/c;
}
else
{
au=fhmx/ga;
//--- check
if(au==0.0)
{
//--- Avoid possible harmful underflow if exponent range
//--- asymmetric (true SSMIN may not underflow even if
//--- AU underflows)
ssmin=fhmn*fhmx/ga;
ssmax=ga;
}
else
{
//--- change values
aas=1+fhmn/fhmx;
at=(fhmx-fhmn)/fhmx;
c=1/(MathSqrt(1+CMath::Sqr(aas*au))+MathSqrt(1+CMath::Sqr(at*au)));
ssmin=fhmn*c*au;
ssmin=ssmin+ssmin;
ssmax=ga/(c+c);
}
}
}
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CBdSingValueDecompose::SVDV2x2(const double f,const double g,
const double h,double &ssmin,
double &ssmax,double &snr,
double &csr,double &snl,
double &csl)
{
//--- create variables
bool gasmal;
bool swp;
int pmax=0;
double a=0;
double clt=0;
double crt=0;
double d=0;
double ft=f;
double fa=MathAbs(ft);
double ht=h;
double ha=MathAbs(h);
double ga=0;
double gt=0;
double l=0;
double m=0;
double mm=0;
double r=0;
double s=0;
double slt=0;
double srt=0;
double t=0;
double temp=0;
double tsign=0;
double tt=0;
double v=0;
//--- initialization
ssmin=0;
ssmax=0;
snr=0;
csr=0;
snl=0;
csl=0;
//--- PMAX points to the maximum absolute element of matrix
//--- PMAX = 1 if F largest in absolute values
//--- PMAX = 2 if G largest in absolute values
//--- PMAX = 3 if H largest in absolute values
pmax=1;
swp=ha>fa;
//--- check
if(swp)
{
//--- Now FA .ge. HA
pmax=3;
temp=ft;
ft=ht;
ht=temp;
temp=fa;
fa=ha;
ha=temp;
}
gt=g;
ga=MathAbs(gt);
//--- check
if(ga==0.0)
{
//--- Diagonal matrix
ssmin=ha;
ssmax=fa;
clt=1;
crt=1;
slt=0;
srt=0;
}
else
{
gasmal=true;
//--- check
if(ga>fa)
{
pmax=2;
//--- check
if(fa/ga<CMath::m_machineepsilon)
{
//--- Case of very large GA
gasmal=false;
ssmax=ga;
//--- check
if(ha>1.0)
{
v=ga/ha;
ssmin=fa/v;
}
else
{
v=fa/ga;
ssmin=v*ha;
}
//--- change values
clt=1;
slt=ht/gt;
srt=1;
crt=ft/gt;
}
}
//--- check
if(gasmal)
{
//--- Normal case
d=fa-ha;
//--- check
if(d==fa)
l=1;
else
l=d/fa;
//--- change values
m=gt/ft;
t=2-l;
mm=m*m;
tt=t*t;
s=MathSqrt(tt+mm);
//--- check
if(l==0.0)
r=MathAbs(m);
else
r=MathSqrt(l*l+mm);
//--- change values
a=0.5*(s+r);
ssmin=ha/a;
ssmax=fa*a;
//--- check
if(mm==0.0)
{
//--- Note that M is very tiny
if(l==0.0)
t=ExtSignBdSQR(2,ft)*ExtSignBdSQR(1,gt);
else
t=gt/ExtSignBdSQR(d,ft)+m/t;
}
else
t=(m/(s+t)+m/(r+l))*(1+a);
//--- change values
l=MathSqrt(t*t+4);
crt=2/l;
srt=t/l;
clt=(crt+srt*m)/a;
v=ht/ft;
slt=v*srt/a;
}
}
//--- check
if(swp)
{
csl=srt;
snl=crt;
csr=slt;
snr=clt;
}
else
{
csl=clt;
snl=slt;
csr=crt;
snr=srt;
}
//--- Correct signs of SSMAX and SSMIN
if(pmax==1)
tsign=ExtSignBdSQR(1,csr)*ExtSignBdSQR(1,csl)*ExtSignBdSQR(1,f);
//--- check
if(pmax==2)
tsign=ExtSignBdSQR(1,snr)*ExtSignBdSQR(1,csl)*ExtSignBdSQR(1,g);
//--- check
if(pmax==3)
tsign=ExtSignBdSQR(1,snr)*ExtSignBdSQR(1,snl)*ExtSignBdSQR(1,h);
//--- get result
ssmax=ExtSignBdSQR(ssmax,tsign);
ssmin=ExtSignBdSQR(ssmin,tsign*ExtSignBdSQR(1,f)*ExtSignBdSQR(1,h));
}
//+------------------------------------------------------------------+
//| Singular value decomposition |
//+------------------------------------------------------------------+
class CSingValueDecompose
{
public:
static bool RMatrixSVD(CMatrixDouble &ca,const int m,const int n,const int uneeded,const int vtneeded,const int additionalmemory,double &w[],CMatrixDouble &u,CMatrixDouble &vt);
static bool RMatrixSVD(CMatrixDouble &ca,const int m,const int n,const int uneeded,const int vtneeded,const int additionalmemory,CRowDouble &w,CMatrixDouble &u,CMatrixDouble &vt);
};
//+------------------------------------------------------------------+
//| Singular value decomposition of a rectangular matrix. |
//| The algorithm calculates the singular value decomposition of a |
//| matrix of size MxN: A = U * S * V^T |
//| The algorithm finds the singular values and, optionally, matrices|
//| U and V^T. The algorithm can find both first min(M,N) columns of |
//| matrix U and rows of matrix V^T (singular vectors), and matrices |
//| U and V^T wholly (of sizes MxM and NxN respectively). |
//| Take into account that the subroutine does not return matrix V |
//| but V^T. |
//| Input parameters: |
//| A - matrix to be decomposed. |
//| Array whose indexes range within |
//| [0..M-1, 0..N-1]. |
//| M - number of rows in matrix A. |
//| N - number of columns in matrix A. |
//| UNeeded - 0, 1 or 2. See the description of the |
//| parameter U. |
//| VTNeeded - 0, 1 or 2. See the description of the |
//| parameter VT. |
//| AdditionalMemory - |
//| If the parameter: |
//| * equals 0, the algorithm doesn?t use |
//| additional memory (lower requirements, |
//| lower performance). |
//| * equals 1, the algorithm uses additional |
//| memory of size min(M,N)*min(M,N) of real |
//| numbers. It often speeds up the algorithm.|
//| * equals 2, the algorithm uses additional |
//| memory of size M*min(M,N) of real numbers.|
//| It allows to get a maximum performance. |
//| The recommended value of the parameter is 2. |
//| Output parameters: |
//| W - contains singular values in descending order.|
//| U - if UNeeded=0, U isn't changed, the left |
//| singular vectors are not calculated. |
//| if Uneeded=1, U contains left singular |
//| vectors (first min(M,N) columns of matrix U).|
//| Array whose indexes range within |
//| [0..M-1, 0..Min(M,N)-1]. if UNeeded=2, U |
//| contains matrix U wholly. Array whose indexes|
//| range within [0..M-1, 0..M-1]. |
//| VT - if VTNeeded=0, VT isn?t changed, the right |
//| singular vectors are not calculated. |
//| if VTNeeded=1, VT contains right singular |
//| vectors (first min(M,N) rows of matrix V^T). |
//| Array whose indexes range within |
//| [0..min(M,N)-1, 0..N-1]. if VTNeeded=2, VT |
//| contains matrix V^T wholly. Array whose |
//| indexes range within [0..N-1, 0..N-1]. |
//+------------------------------------------------------------------+
bool CSingValueDecompose::RMatrixSVD(CMatrixDouble &ca,const int m,
const int n,const int uneeded,
const int vtneeded,
const int additionalmemory,
double &w[],CMatrixDouble &u,
CMatrixDouble &vt)
{
CRowDouble W;
if(!RMatrixSVD(ca,m,n,uneeded,vtneeded,additionalmemory,W,u,vt))
return(false);
W.ToArray(w);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CSingValueDecompose::RMatrixSVD(CMatrixDouble &ca,const int m,
const int n,const int uneeded,
const int vtneeded,
const int additionalmemory,
CRowDouble &w,CMatrixDouble &u,
CMatrixDouble &vt)
{
//--- check
if(m==0 || n==0)
return(true);
//--- create variables
bool result=true;
bool IsUpper;
int minmn=0;
int ncu=0;
int nrvt=0;
int nru=0;
int ncvt=0;
int i=0;
int j=0;
//--- create arrays
CRowDouble tauq;
CRowDouble taup;
CRowDouble tau;
CRowDouble e;
CRowDouble work;
//--- create matrix
CMatrixDouble t2;
CMatrixDouble a=ca;
//--- check
if(!CAp::Assert(uneeded>=0 && uneeded<=2,__FUNCTION__+": wrong parameters!"))
return(false);
//--- check
if(!CAp::Assert(vtneeded>=0 && vtneeded<=2,__FUNCTION__+": wrong parameters!"))
return(false);
//--- check
if(!CAp::Assert(additionalmemory>=0 && additionalmemory<=2,__FUNCTION__+": wrong parameters!"))
return(false);
//--- initialization
minmn=MathMin(m,n);
w.Resize(minmn+1);
//--- check
if(uneeded==1)
{
nru=m;
ncu=minmn;
u.Resize(nru,ncu);
}
//--- check
if(uneeded==2)
{
nru=m;
ncu=m;
u.Resize(nru,ncu);
}
//--- check
if(vtneeded==1)
{
nrvt=minmn;
ncvt=n;
vt.Resize(nrvt,ncvt);
}
//--- check
if(vtneeded==2)
{
nrvt=n;
ncvt=n;
vt.Resize(nrvt,ncvt);
}
//--- M much larger than N
//--- Use bidiagonal reduction with QR-decomposition
if((double)(m)>(double)(1.6*n))
{
//--- check
if(uneeded==0)
{
//-- No left singular vectors to be computed
COrtFac::RMatrixQR(a,m,n,tau);
for(i=0; i<n; i++)
{
for(j=0; j<i; j++)
a.Set(i,j,0);
}
//--- function call
COrtFac::RMatrixBD(a,n,n,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackPT(a,n,n,taup,nrvt,vt);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,n,n,IsUpper,w,e);
//--- return result
return(CBdSingValueDecompose::RMatrixBdSVD(w,e,n,IsUpper,false,u,0,a,0,vt,ncvt));
}
else
{
//--- Left singular vectors (may be full matrix U) to be computed
COrtFac::RMatrixQR(a,m,n,tau);
//--- function call
COrtFac::RMatrixQRUnpackQ(a,m,n,tau,ncu,u);
for(i=0; i<n; i++)
{
for(j=0; j<i; j++)
a.Set(i,j,0);
}
//--- function call
COrtFac::RMatrixBD(a,n,n,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackPT(a,n,n,taup,nrvt,vt);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,n,n,IsUpper,w,e);
//--- check
if(additionalmemory<1)
{
//--- No additional memory can be used
COrtFac::RMatrixBDMultiplyByQ(a,n,n,tauq,u,m,n,true,false);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,n,IsUpper,false,u,m,a,0,vt,ncvt);
}
else
{
//--- Large U. Transforming intermediate matrix T2
work.Resize(MathMax(m,n)+1);
//--- function call
COrtFac::RMatrixBDUnpackQ(a,n,n,tauq,n,t2);
//--- function call
CBlas::CopyMatrix(u,0,m-1,0,n-1,a,0,m-1,0,n-1);
//--- function call
CBlas::InplaceTranspose(t2,0,n-1,0,n-1,work);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,n,IsUpper,false,u,0,t2,n,vt,ncvt);
//--- function call
CAblas::RMatrixGemm(m,n,n,1.0,a,0,0,0,t2,0,0,1,0.0,u,0,0);
}
//--- return result
return(result);
}
}
//--- N much larger than M
//--- Use bidiagonal reduction with LQ-decomposition
if((double)(n)>(double)(1.6*m))
{
//--- check
if(vtneeded==0)
{
//--- No right singular vectors to be computed
COrtFac::RMatrixLQ(a,m,n,tau);
for(i=0; i<=m-1; i++)
{
for(j=i+1; j<=m-1; j++)
a.Set(i,j,0);
}
//--- function call
COrtFac::RMatrixBD(a,m,m,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackQ(a,m,m,tauq,ncu,u);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,m,m,IsUpper,w,e);
work.Resize(m+1);
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,m,IsUpper,false,a,0,u,nru,vt,0);
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- return result
return(result);
}
else
{
//--- Right singular vectors (may be full matrix VT) to be computed
COrtFac::RMatrixLQ(a,m,n,tau);
//--- function call
COrtFac::RMatrixLQUnpackQ(a,m,n,tau,nrvt,vt);
for(i=0; i<=m-1; i++)
{
for(j=i+1; j<=m-1; j++)
a.Set(i,j,0);
}
//--- function call
COrtFac::RMatrixBD(a,m,m,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackQ(a,m,m,tauq,ncu,u);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,m,m,IsUpper,w,e);
work.Resize(MathMax(m,n)+1);
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- check
if(additionalmemory<1)
{
//--- No additional memory available
COrtFac::RMatrixBDMultiplyByP(a,m,m,taup,vt,m,n,false,true);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,m,IsUpper,false,a,0,u,nru,vt,n);
}
else
{
//--- Large VT. Transforming intermediate matrix T2
COrtFac::RMatrixBDUnpackPT(a,m,m,taup,m,t2);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,m,IsUpper,false,a,0,u,nru,t2,m);
//--- function call
CBlas::CopyMatrix(vt,0,m-1,0,n-1,a,0,m-1,0,n-1);
//--- function call
CAblas::RMatrixGemm(m,n,m,1.0,t2,0,0,0,a,0,0,0,0.0,vt,0,0);
}
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- return result
return(result);
}
}
//--- M<=N
//--- We can use inplace transposition of U to get rid of columnwise operations
if(m<=n)
{
//--- function call
COrtFac::RMatrixBD(a,m,n,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackQ(a,m,n,tauq,ncu,u);
//--- function call
COrtFac::RMatrixBDUnpackPT(a,m,n,taup,nrvt,vt);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,m,n,IsUpper,w,e);
work.Resize(m+1);
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,minmn,IsUpper,false,a,0,u,nru,vt,ncvt);
//--- function call
CBlas::InplaceTranspose(u,0,nru-1,0,ncu-1,work);
//--- return result
return(result);
}
//--- Simple bidiagonal reduction
COrtFac::RMatrixBD(a,m,n,tauq,taup);
//--- function call
COrtFac::RMatrixBDUnpackQ(a,m,n,tauq,ncu,u);
//--- function call
COrtFac::RMatrixBDUnpackPT(a,m,n,taup,nrvt,vt);
//--- function call
COrtFac::RMatrixBDUnpackDiagonals(a,m,n,IsUpper,w,e);
//--- check
if(additionalmemory<2 || uneeded==0)
{
//--- We cant use additional memory or there is no need in such operations
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,minmn,IsUpper,false,u,nru,a,0,vt,ncvt);
}
else
{
//--- We can use additional memory
t2.Resize(minmn,m);
//--- function call
CBlas::CopyAndTranspose(u,0,m-1,0,minmn-1,t2,0,minmn-1,0,m-1);
//--- get result
result=CBdSingValueDecompose::RMatrixBdSVD(w,e,minmn,IsUpper,false,u,0,t2,m,vt,ncvt);
//--- function call
CBlas::CopyAndTranspose(t2,0,minmn-1,0,m-1,u,0,m-1,0,minmn-1);
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Structure which stores state of linear CG solver between |
//| subsequent calls of FBLSCgIteration(). Initialized with |
//| FBLSCGCreate(). |
//| USAGE: |
//| 1. call to FBLSCGCreate() |
//| 2. F:=FBLSCgIteration(State) |
//| 3. if F is False, iterations are over |
//| 4. otherwise, fill State.AX with A*x, State.XAX with x'*A*x |
//| 5. goto 2 |
//| If you want to rerminate iterations, pass zero or negative value |
//| to XAX. |
//| FIELDS: |
//| E1 - 2-norm of residual at the start |
//| E2 - 2-norm of residual at the end |
//| X - on return from FBLSCgIteration() it contains |
//| vector for matrix-vector product |
//| AX - must be filled with A*x if FBLSCgIteration() |
//| returned True |
//| XAX - must be filled with x'*A*x |
//| XK - contains result (if FBLSCgIteration() returned |
//| False) |
//| Other fields are private and should not be used by outsiders. |
//+------------------------------------------------------------------+
struct CFblsLinCgState
{
//--- variables
double m_e1;
double m_e2;
CRowDouble m_x;
CRowDouble m_ax;
double m_xax;
int m_n;
CRowDouble m_rk;
CRowDouble m_rk1;
CRowDouble m_xk;
CRowDouble m_xk1;
CRowDouble m_pk;
CRowDouble m_pk1;
CRowDouble m_b;
RCommState m_rstate;
CRowDouble m_tmp2;
//--- constructor, destructor
CFblsLinCgState(void);
~CFblsLinCgState(void) {}
void Copy(const CFblsLinCgState &obj);
//--- overloading
void operator=(const CFblsLinCgState &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Constructor |
//+------------------------------------------------------------------+
CFblsLinCgState::CFblsLinCgState(void)
{
m_e1=0;
m_e2=0;
m_xax=0;
m_n=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CFblsLinCgState::Copy(const CFblsLinCgState &obj)
{
m_e1=obj.m_e1;
m_e2=obj.m_e2;
m_x=obj.m_x;
m_ax=obj.m_ax;
m_xax=obj.m_xax;
m_n=obj.m_n;
m_rk=obj.m_rk;
m_rk1=obj.m_rk1;
m_xk=obj.m_xk;
m_xk1=obj.m_xk1;
m_pk=obj.m_pk;
m_pk1=obj.m_pk1;
m_b=obj.m_b;
m_rstate=obj.m_rstate;
m_tmp2=obj.m_tmp2;
}
//+------------------------------------------------------------------+
//| Structure which stores state of basic GMRES(k) solver between |
//| subsequent calls of FBLSGMRESIteration(). Initialized with |
//| FBLSGMRESCreate(). |
//| USAGE: |
//| 1. call to FBLSCGCreate() |
//| 2. F:=FBLSGMRESIteration(State) |
//| 3. if F is False, iterations are over |
//| 4. otherwise, fill State.AX with A*x |
//| 5. goto 2 |
//| RCOMM FIELDS: |
//| X - on return from FBLSCgIteration() it contains vector |
//| for matrix-vector product |
//| AX - must be filled with A*x if FBLSCgIteration() returned |
//| True |
//| RESULT: |
//| XS - contains result (if FBLSCgIteration() returned False) |
//| State - following fields can be used: |
//| * ItsPerformed |
//| * RetCode |
//| Other fields are private and should not be used by outsiders: |
//| Qi - rows store orthonormal basis of the Krylov subspace |
//| AQi - rows store products A*Qi |
//+------------------------------------------------------------------+
struct CFblsGMRESState
{
CRowDouble m_b;
CRowDouble m_x;
CRowDouble m_ax;
CRowDouble m_xs;
CMatrixDouble m_qi;
CMatrixDouble m_aqi;
CMatrixDouble m_h;
CMatrixDouble m_hq;
CMatrixDouble m_hr;
CRowDouble m_hqb;
CRowDouble m_ys;
CRowDouble m_tmp0;
CRowDouble m_tmp1;
int m_n;
int m_itscnt;
double m_epsort;
double m_epsres;
double m_epsred;
double m_epsdiag;
int m_itsperformed;
int m_retcode;
double m_reprelres;
RCommState m_rstate;
//--- constructor, destructor
CFblsGMRESState(void);
~CFblsGMRESState(void) {}
void Copy(const CFblsGMRESState &obj);
//--- overloading
void operator=(const CFblsGMRESState &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Constructor |
//+------------------------------------------------------------------+
CFblsGMRESState::CFblsGMRESState(void)
{
m_n=0;
m_itscnt=0;
m_epsort=0;
m_epsres=0;
m_epsred=0;
m_epsdiag=0;
m_itsperformed=0;
m_retcode=0;
m_reprelres=0;
}
//+------------------------------------------------------------------+
//| Copy |
//+------------------------------------------------------------------+
void CFblsGMRESState::Copy(const CFblsGMRESState &obj)
{
m_b=obj.m_b;
m_x=obj.m_x;
m_ax=obj.m_ax;
m_xs=obj.m_xs;
m_qi=obj.m_qi;
m_aqi=obj.m_aqi;
m_h=obj.m_h;
m_hq=obj.m_hq;
m_hr=obj.m_hr;
m_hqb=obj.m_hqb;
m_ys=obj.m_ys;
m_tmp0=obj.m_tmp0;
m_tmp1=obj.m_tmp1;
m_n=obj.m_n;
m_itscnt=obj.m_itscnt;
m_epsort=obj.m_epsort;
m_epsres=obj.m_epsres;
m_epsred=obj.m_epsred;
m_epsdiag=obj.m_epsdiag;
m_itsperformed=obj.m_itsperformed;
m_retcode=obj.m_retcode;
m_reprelres=obj.m_reprelres;
m_rstate=obj.m_rstate;
}
//+------------------------------------------------------------------+
//| Fast basic linear solutions |
//+------------------------------------------------------------------+
class CFbls
{
public:
static void FblsCholeskySolve(CMatrixDouble &cha,const double sqrtscalea,const int n,const bool IsUpper,double &xb[],double &tmp[]);
static void FblsCholeskySolve(CMatrixDouble &cha,const double sqrtscalea,const int n,const bool IsUpper,CRowDouble &xb,CRowDouble &tmp);
static void FblsSolveCGx(CMatrixDouble &a,const int m,const int n,const double alpha,const double &b[],double &x[],double &buf[]);
static void FblsSolveCGx(CMatrixDouble &a,const int m,const int n,const double alpha,const CRowDouble &b,CRowDouble &x,CRowDouble &buf);
static void FblsCGCreate(double &x[],double &b[],const int n,CFblsLinCgState &state);
static void FblsCGCreate(CRowDouble &x,CRowDouble &b,const int n,CFblsLinCgState &state);
static bool FblsCGIteration(CFblsLinCgState &state);
static void FblsGMRESCreate(CRowDouble &b,int n,int k,CFblsGMRESState &state);
static bool FblsGMRESIteration(CFblsGMRESState &state);
static void FblsSolveLS(CMatrixDouble &a,CRowDouble &b,int m,int n,CRowDouble &tmp0,CRowDouble &tmp1,CRowDouble &tmp2);
private:
//--- auxiliary functions for FblsCGiteration
static void Func_lbl_rcomm(CFblsLinCgState &state,int n,int k,double rk2,double rk12,double pap,double s,double betak,double v1,double v2);
static bool Func_lbl_3(CFblsLinCgState &state,int &n,int &k,double &rk2,double &rk12,double &pap,double &s,double &betak,double &v1,double &v2);
static bool Func_lbl_5(CFblsLinCgState &state,int &n,int &k,double &rk2,double &rk12,double &pap,double &s,double &betak,double &v1,double &v2);
static void FblsGMRESIteration_lbl_3(CFblsGMRESState &state,int kdim,int n);
};
//+------------------------------------------------------------------+
//| Basic Cholesky solver for ScaleA*Cholesky(A)'*x = y. |
//| This subroutine assumes that: |
//| * A*ScaleA is well scaled |
//| * A is well-conditioned, so no zero divisions or overflow may |
//| occur |
//| INPUT PARAMETERS: |
//| CHA - Cholesky decomposition of A |
//| SqrtScaleA- square root of scale factor ScaleA |
//| N - matrix size |
//| IsUpper - storage type |
//| XB - right part |
//| Tmp - buffer; function automatically allocates it, if |
//| it is too small. It can be reused if function is |
//| called several times. |
//| OUTPUT PARAMETERS: |
//| XB - solution |
//| NOTES: no assertion or tests are done during algorithm operation |
//+------------------------------------------------------------------+
void CFbls::FblsCholeskySolve(CMatrixDouble &cha,const double sqrtscalea,
const int n,const bool IsUpper,double &xb[],
double &tmp[])
{
CRowDouble XB=xb;
CRowDouble Tmp;
FblsCholeskySolve(cha,sqrtscalea,n,IsUpper,XB,Tmp);
XB.ToArray(xb);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CFbls::FblsCholeskySolve(CMatrixDouble &cha,const double sqrtscalea,
const int n,const bool IsUpper,CRowDouble &xb,
CRowDouble &tmp)
{
//--- create variable
double v=0;
if(n<=0)
{
return;
}
//--- Scale right part
xb*=1/CMath::Sqr(sqrtscalea);
//--- Solve A = L*L' or A=U'*U
if(IsUpper)
{
//--- Solve U'*y=b first.
CAblas::RMatrixTrsVect(n,cha,0,0,true,false,1,xb,0);
//--- Solve U*x=y then.
CAblas::RMatrixTrsVect(n,cha,0,0,true,false,0,xb,0);
}
else
{
//--- Solve L*y=b first
CAblas::RMatrixTrsVect(n,cha,0,0,false,false,0,xb,0);
//--- Solve L'*x=y then.
CAblas::RMatrixTrsVect(n,cha,0,0,false,false,1,xb,0);
}
}
//+------------------------------------------------------------------+
//| Fast basic linear solver: linear SPD CG |
//| Solves (A^T*A + alpha*I)*x = b where: |
//| * A is MxN matrix |
//| * alpha>0 is a scalar |
//| * I is NxN identity matrix |
//| * b is Nx1 vector |
//| * X is Nx1 unknown vector. |
//| N iterations of linear conjugate gradient are used to solve |
//| problem. |
//| INPUT PARAMETERS: |
//| A - array[M,N], matrix |
//| M - number of rows |
//| N - number of unknowns |
//| B - array[N], right part |
//| X - initial approxumation, array[N] |
//| Buf - buffer; function automatically allocates it, if it |
//| is too small. It can be reused if function is called |
//| several times with same M and N. |
//| OUTPUT PARAMETERS: |
//| X - improved solution |
//| NOTES: |
//| * solver checks quality of improved solution. If (because of |
//| problem condition number, numerical noise, etc.) new solution|
//| is WORSE than original approximation, then original |
//| approximation is returned. |
//| * solver assumes that both A, B, Alpha are well scaled (i.e. |
//| they are less than sqrt(overflow) and greater than |
//| sqrt(underflow)). |
//+------------------------------------------------------------------+
void CFbls::FblsSolveCGx(CMatrixDouble &a,const int m,const int n,
const double alpha,const double &b[],
double &x[],double &buf[])
{
CRowDouble X=x;
CRowDouble B=b;
CRowDouble Buf;
FblsSolveCGx(a,m,n,alpha,B,X,Buf);
X.ToArray(x);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CFbls::FblsSolveCGx(CMatrixDouble &a,const int m,const int n,
const double alpha,const CRowDouble &b,
CRowDouble &x,CRowDouble &buf)
{
//--- create variables
int k=0;
int offsrk=0;
int offsrk1=offsrk+n;
int offsxk=offsrk1+n;
int offsxk1=offsxk+n;
int offspk=offsxk1+n;
int offspk1=offspk+n;
int offstmp1=offspk1+n;
int offstmp2=offstmp1+m;
int bs=offstmp2+n;
double e1=0;
double e2=0;
double rk2=0;
double rk12=0;
double pap=0;
double s=0;
double betak=0;
double v1=0;
double v2=0;
int i_=0;
int i1_=0;
//--- Test for special case: B=0
v1=(b.Abs()+0).Sum();
//--- check
if(v1==0.0)
{
x=vector<double>::Zeros(n);
//--- exit the function
return;
}
//--- Offsets inside Buf for:
//--- * R[K], R[K+1]
//--- * X[K], X[K+1]
//--- * P[K], P[K+1]
//--- * Tmp1 - array[M], Tmp2 - array[N]
//--- check
if(CAp::Len(buf)<bs)
buf.Resize(bs);
//--- x(0)=x
i1_=-offsxk;
for(i_=offsxk; i_<=offsxk+n-1; i_++)
buf.Set(i_,x[i_+i1_]);
//--- r(0)=b-A*x(0)
//--- RK2=r(0)'*r(0)
CAblas::RMatrixMVect(m,n,a,0,0,0,buf,offsxk,buf,offstmp1);
//--- function call
CAblas::RMatrixMVect(n,m,a,0,0,1,buf,offstmp1,buf,offstmp2);
//--- change array
i1_=offsxk-offstmp2;
for(i_=offstmp2; i_<offstmp2+n; i_++)
buf.Set(i_,buf[i_]+alpha*buf[i_+i1_]);
//--- change array
i1_=-offsrk;
for(i_=offsrk; i_<offsrk+n; i_++)
buf.Set(i_,b[i_+i1_]);
//--- change array
i1_=offstmp2-offsrk;
for(i_=offsrk; i_<offsrk+n; i_++)
buf.Set(i_,buf[i_]-buf[i_+i1_]);
rk2=0.0;
for(i_=offsrk; i_<offsrk+n; i_++)
rk2+=buf[i_]*buf[i_];
//--- change array
i1_=offsrk-offspk;
for(i_=offspk; i_<=offspk+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
e1=MathSqrt(rk2);
//--- cycle
for(k=0; k<n; k++)
{
//--- Calculate A*p(k) - store in Buf[OffsTmp2:OffsTmp2+N-1]
//--- and p(k)'*A*p(k) - store in PAP
//--- If PAP=0, break (iteration is over)
CAblas::RMatrixMVect(m,n,a,0,0,0,buf,offspk,buf,offstmp1);
v1=0.0;
for(i_=offstmp1; i_<=offstmp1+m-1; i_++)
v1+=buf[i_]*buf[i_];
v2=0.0;
for(i_=offspk; i_<=offspk+n-1; i_++)
v2+=buf[i_]*buf[i_];
pap=v1+alpha*v2;
//--- function call
CAblas::RMatrixMVect(n,m,a,0,0,1,buf,offstmp1,buf,offstmp2);
i1_=offspk-offstmp2;
for(i_=offstmp2; i_<offstmp2+n; i_++)
buf.Set(i_,buf[i_]+alpha*buf[i_+i1_]);
//--- check
if(pap==0.0)
break;
//--- S=(r(k)'*r(k))/(p(k)'*A*p(k))
s=rk2/pap;
//--- x(k+1)=x(k) + S*p(k)
i1_=offsxk-offsxk1;
for(i_=offsxk1; i_<=offsxk1+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
i1_=offspk-offsxk1;
for(i_=offsxk1; i_<=offsxk1+n-1; i_++)
buf.Set(i_,buf[i_]+s*buf[i_+i1_]);
//--- r(k+1)=r(k) - S*A*p(k)
//--- RK12=r(k+1)'*r(k+1)
//--- Break if r(k+1) small enough (when compared to r(k))
i1_=offsrk-offsrk1;
for(i_=offsrk1; i_<=offsrk1+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
i1_=offstmp2-offsrk1;
for(i_=offsrk1; i_<=offsrk1+n-1; i_++)
buf.Set(i_,buf[i_]-s*buf[i_+i1_]);
rk12=0.0;
for(i_=offsrk1; i_<=offsrk1+n-1; i_++)
rk12+=buf[i_]*buf[i_];
//--- check
if(MathSqrt(rk12)<=100*CMath::m_machineepsilon*MathSqrt(rk2))
{
//--- X(k) = x(k+1) before exit -
//--- - because we expect to find solution at x(k)
i1_=offsxk1-offsxk;
for(i_=offsxk; i_<=offsxk+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
break;
}
//--- BetaK=RK12/RK2
//--- p(k+1)=r(k+1)+betak*p(k)
betak=rk12/rk2;
i1_=offsrk1-offspk1;
for(i_=offspk1; i_<=offspk1+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
i1_=offspk-offspk1;
for(i_=offspk1; i_<=offspk1+n-1; i_++)
buf.Set(i_,buf[i_]+betak*buf[i_+i1_]);
//--- r(k) :=r(k+1)
//--- x(k) :=x(k+1)
//--- p(k) :=p(k+1)
i1_=offsrk1-offsrk;
for(i_=offsrk; i_<offsrk+n; i_++)
buf.Set(i_,buf[i_+i1_]);
i1_=offsxk1-offsxk;
for(i_=offsxk; i_<=offsxk+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
i1_=offspk1-offspk;
for(i_=offspk; i_<=offspk+n-1; i_++)
buf.Set(i_,buf[i_+i1_]);
rk2=rk12;
}
//--- Calculate E2
CAblas::RMatrixMVect(m,n,a,0,0,0,buf,offsxk,buf,offstmp1);
//--- function call
CAblas::RMatrixMVect(n,m,a,0,0,1,buf,offstmp1,buf,offstmp2);
i1_=offsxk-offstmp2;
for(i_=offstmp2; i_<offstmp2+n; i_++)
buf.Set(i_,buf[i_]+alpha*buf[i_+i1_]);
i1_=-offsrk;
for(i_=offsrk; i_<offsrk+n; i_++)
buf.Set(i_,b[i_+i1_]);
i1_=offstmp2-offsrk;
for(i_=offsrk; i_<offsrk+n; i_++)
buf.Set(i_,buf[i_]-buf[i_+i1_]);
v1=0.0;
for(i_=offsrk; i_<offsrk+n; i_++)
v1+=buf[i_]*buf[i_];
e2=MathSqrt(v1);
//--- Output result (if it was improved)
if(e2<e1)
{
i1_=offsxk;
for(i_=0; i_<n; i_++)
x.Set(i_,buf[i_+i1_]);
}
}
//+------------------------------------------------------------------+
//| Construction of linear conjugate gradient solver. |
//| State parameter passed using "var" semantics (i.e. previous state|
//| is NOT erased). When it is already initialized, we can reause |
//| prevously allocated memory. |
//| INPUT PARAMETERS: |
//| X - initial solution |
//| B - right part |
//| N - system size |
//| State - structure; may be preallocated, if we want to |
//| reuse memory |
//| OUTPUT PARAMETERS: |
//| State - structure which is used by FBLSCGIteration() to |
//| store algorithm state between subsequent calls. |
//| NOTE: no error checking is done; caller must check all |
//| parameters, prevent overflows, and so on. |
//+------------------------------------------------------------------+
void CFbls::FblsCGCreate(double &x[],double &b[],const int n,CFblsLinCgState &state)
{
CRowDouble X=x;
CRowDouble B=b;
FblsCGCreate(X,B,n,state);
}
//+------------------------------------------------------------------+
//| Same |
//+------------------------------------------------------------------+
void CFbls::FblsCGCreate(CRowDouble &x,CRowDouble &b,const int n,CFblsLinCgState &state)
{
//--- check
if(CAp::Len(state.m_rk)<n)
state.m_rk.Resize(n);
//--- check
if(CAp::Len(state.m_rk1)<n)
state.m_rk1.Resize(n);
//--- check
if(CAp::Len(state.m_xk1)<n)
state.m_xk1.Resize(n);
//--- check
if(CAp::Len(state.m_pk)<n)
state.m_pk.Resize(n);
//--- check
if(CAp::Len(state.m_pk1)<n)
state.m_pk1.Resize(n);
//--- check
if(CAp::Len(state.m_tmp2)<n)
state.m_tmp2.Resize(n);
//--- check
if(CAp::Len(state.m_x)<n)
state.m_x.Resize(n);
//--- check
if(CAp::Len(state.m_ax)<n)
state.m_ax.Resize(n);
//--- check
state.m_n=n;
state.m_xk=x;
state.m_b=b;
//--- allocation
state.m_rstate.ia.Resize(2);
state.m_rstate.ra.Resize(7);
state.m_rstate.stage=-1;
}
//+------------------------------------------------------------------+
//| Linear CG solver, function relying on reverse communication to |
//| calculate matrix-vector products. |
//| See comments for FBLSLinCGState structure for more info. |
//+------------------------------------------------------------------+
bool CFbls::FblsCGIteration(CFblsLinCgState &state)
{
//--- create variables
int n=0;
int k=0;
double rk2=0;
double rk12=0;
double pap=0;
double s=0;
double betak=0;
double v1=0;
double v2=0;
int i_=0;
//--- This code initializes locals by:
//--- * random values determined during code
//--- generation - on first subroutine call
//--- * values from previous call - on subsequent calls
if(state.m_rstate.stage>=0)
{
//--- initialization
n=state.m_rstate.ia[0];
k=state.m_rstate.ia[1];
rk2=state.m_rstate.ra[0];
rk12=state.m_rstate.ra[1];
pap=state.m_rstate.ra[2];
s=state.m_rstate.ra[3];
betak=state.m_rstate.ra[4];
v1=state.m_rstate.ra[5];
v2=state.m_rstate.ra[6];
}
else
{
//--- initialization
n=359;
k=-58;
rk2=-919;
rk12=-909;
pap=81;
s=255;
betak=74;
v1=-788;
v2=809;
}
//--- check
switch(state.m_rstate.stage)
{
case 0:
//--- calculation
state.m_rk=state.m_b-state.m_ax+0;
//--- change value
rk2=state.m_rk.Dot(state.m_rk);
//--- copy
state.m_pk=state.m_rk;
state.m_e1=MathSqrt(rk2);
//--- cycle
k=0;
//--- function call
return(Func_lbl_3(state,n,k,rk2,rk12,pap,s,betak,v1,v2));
case 1:
//--- copy
state.m_tmp2=state.m_ax;
pap=state.m_xax;
//--- check
if(!CMath::IsFinite(pap) || pap<=0.0)
return(Func_lbl_5(state,n,k,rk2,rk12,pap,s,betak,v1,v2));
//--- S=(r(k)'*r(k))/(p(k)'*A*p(k))
s=rk2/pap;
//--- x(k+1)=x(k) + S*p(k)
state.m_xk1=state.m_xk.ToVector()+state.m_pk*s;
//--- r(k+1)=r(k) - S*A*p(k)
//--- RK12=r(k+1)'*r(k+1)
//--- Break if r(k+1) small enough (when compared to r(k))
state.m_rk1=state.m_rk.ToVector()-state.m_tmp2*s;
rk12=state.m_rk1.Dot(state.m_rk1);
//--- check
if(MathSqrt(rk12)<=100*CMath::m_machineepsilon*state.m_e1)
{
//--- X(k) = x(k+1) before exit -
//--- - because we expect to find solution at x(k)
state.m_xk=state.m_xk1;
//--- function call
return(Func_lbl_5(state,n,k,rk2,rk12,pap,s,betak,v1,v2));
}
//--- BetaK=RK12/RK2
//--- p(k+1)=r(k+1)+betak*p(k)
//--- NOTE: we expect that BetaK won't overflow because of
//--- "Sqrt(RK12)<=100*MachineEpsilon*E1" test above.
betak=rk12/rk2;
state.m_pk1=state.m_rk1.ToVector()+state.m_pk*betak;
//--- r(k) :=r(k+1)
//--- x(k) :=x(k+1)
//--- p(k) :=p(k+1)
state.m_rk=state.m_rk1;
state.m_xk=state.m_xk1;
state.m_pk=state.m_pk1;
rk2=rk12;
k++;
//--- function call
return(Func_lbl_3(state,n,k,rk2,rk12,pap,s,betak,v1,v2));
break;
//--- check
case 2:
//--- calculation
state.m_rk=state.m_b-state.m_ax+0;
//--- change value
v1=(state.m_rk.Pow(2)+0).Sum();
state.m_e2=MathSqrt(v1);
//--- return result
return(false);
break;
}
//--- Routine body
//--- prepare locals
n=state.m_n;
//--- Test for special case: B=0
v1=state.m_b.Dot(state.m_b);
//--- check
if(v1==0.0)
{
state.m_xk=vector<double>::Zeros(n);
//--- return result
return(false);
}
//--- r(0)=b-A*x(0)
//--- RK2=r(0)'*r(0)
state.m_x=state.m_xk;
state.m_rstate.stage=0;
//--- Saving state
Func_lbl_rcomm(state,n,k,rk2,rk12,pap,s,betak,v1,v2);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Construction of GMRES(k) solver. |
//| State parameter passed using "shared" semantics (i.e. previous |
//| state is NOT erased). When it is already initialized, we can |
//| reause prevously allocated memory. |
//| After (but not before!) initialization you can tweak following |
//| fields (they are initialized by default values, but you can |
//| change it): |
//| * State.EpsOrt - stop if norm of new candidate for |
//| orthogonalization is below EpsOrt |
//| * State.EpsRes - stop of residual decreased below EpsRes*|B||
//| * State.EpsRed - stop if relative reduction of residual |
//| |R(k+1)|/|R(k)|>EpsRed |
//| INPUT PARAMETERS: |
//| B - right part |
//| N - system size |
//| K - iterations count, K>=1 |
//| State - structure; may be preallocated, if we want to reuse |
//| memory |
//| OUTPUT PARAMETERS: |
//| State - structure which is used by FBLSGMRESIteration() to |
//| store algorithm state between subsequent calls. |
//| NOTE: no error checking is done; caller must check all |
//| parameters, prevent overflows, and so on. |
//+------------------------------------------------------------------+
void CFbls::FblsGMRESCreate(CRowDouble &b,
int n,
int k,
CFblsGMRESState &state)
{
//--- check
if(!CAp::Assert(n>0 && k>0 && k<=n,__FUNCTION__+": incorrect params"))
return;
state.m_n=n;
state.m_itscnt=k;
state.m_epsres=state.m_epsort=(1000+MathSqrt(n))*CMath::m_machineepsilon;
state.m_epsred=1.0;
state.m_epsdiag=(10000+n)*CMath::m_machineepsilon;
state.m_itsperformed=0;
state.m_retcode=0;
CAblasF::RCopyAllocV(n,b,state.m_b);
CAblasF::RAllocV(n,state.m_x);
CAblasF::RAllocV(n,state.m_ax);
state.m_rstate.ia.Resize(4+1);
state.m_rstate.ra.Resize(10+1);
state.m_rstate.stage=-1;
}
//+------------------------------------------------------------------+
//| Linear CG solver, function relying on reverse communication to |
//| calculate matrix-vector products. |
//| See comments for FBLSLinCGState structure for more info. |
//+------------------------------------------------------------------+
bool CFbls::FblsGMRESIteration(CFblsGMRESState &state)
{
//--- create variables
int n=0;
int itidx=0;
int kdim=0;
double rmax=0;
double rmindiag=0;
double cs=0;
double sn=0;
double v=0;
double vv=0;
double anrm=0;
double qnrm=0;
double bnrm=0;
double resnrm=0;
double prevresnrm=0;
int i=0;
int j=0;
//--- Reverse communication preparations
//--- This code initializes locals by:
//--- * random values determined during code
//--- generation - on first subroutine call
//--- * values from previous call - on subsequent calls
if(state.m_rstate.stage>=0)
{
n=state.m_rstate.ia[0];
itidx=state.m_rstate.ia[1];
kdim=state.m_rstate.ia[2];
i=state.m_rstate.ia[3];
j=state.m_rstate.ia[4];
rmax=state.m_rstate.ra[0];
rmindiag=state.m_rstate.ra[1];
cs=state.m_rstate.ra[2];
sn=state.m_rstate.ra[3];
v=state.m_rstate.ra[4];
vv=state.m_rstate.ra[5];
anrm=state.m_rstate.ra[6];
qnrm=state.m_rstate.ra[7];
bnrm=state.m_rstate.ra[8];
resnrm=state.m_rstate.ra[9];
prevresnrm=state.m_rstate.ra[10];
}
else
{
n=205;
itidx=-838;
kdim=939;
i=-526;
j=763;
rmax=-541;
rmindiag=-698;
cs=-900;
sn=-318;
v=-940;
vv=1016;
anrm=-229;
qnrm=-536;
bnrm=487;
resnrm=-115;
prevresnrm=886;
}
if(state.m_rstate.stage==0)
{
CAblasF::RCopyVR(n,state.m_ax,state.m_aqi,itidx);
anrm=MathSqrt(CAblasF::RDotV2(n,state.m_ax));
if(anrm==0.0)
{
state.m_retcode=2;
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
CAblas::RowWiseGramSchmidt(state.m_qi,itidx+1,n,state.m_ax,state.m_tmp0,true);
CAblas::RowWiseGramSchmidt(state.m_qi,itidx+1,n,state.m_ax,state.m_tmp1,true);
CAblasF::RAddVC(itidx+1,1.0,state.m_tmp0,state.m_h,itidx);
CAblasF::RAddVC(itidx+1,1.0,state.m_tmp1,state.m_h,itidx);
qnrm=MathSqrt(CAblasF::RDotV2(n,state.m_ax));
state.m_h.Set(itidx+1,itidx,qnrm);
CAblasF::RMulV(n,1/CApServ::Coalesce(qnrm,1),state.m_ax);
CAblasF::RCopyVR(n,state.m_ax,state.m_qi,itidx+1);
//--- We have QR decomposition of H from the previous iteration:
//--- * (ItIdx+1)*(ItIdx+1) orthogonal HQ embedded into larger (ItIdx+2)*(ItIdx+2) identity matrix
//--- * (ItIdx+1)*ItIdx triangular HR embedded into larger (ItIdx+2)*(ItIdx+1) zero matrix
//--- We just have to update QR decomposition after one more column is added to H:
//--- * multiply this column by HQ to obtain (ItIdx+2)-dimensional vector X
//--- * generate rotation to nullify last element of X to obtain (ItIdx+1)-dimensional vector Y
//--- that is copied into (ItIdx+1)-th column of HR
//--- * apply same rotation to HQ
//--- * apply same rotation to HQB - current right-hand side
CAblasF::RCopyCV(itidx+2,state.m_h,itidx,state.m_tmp0);
CAblas::RMatrixGemVect(itidx+2,itidx+2,1.0,state.m_hq,0,0,0,state.m_tmp0,0,0.0,state.m_tmp1,0);
CRotations::GenerateRotation(state.m_tmp1[itidx],state.m_tmp1[itidx+1],cs,sn,v);
state.m_tmp1.Set(itidx,v);
state.m_tmp1.Set(itidx+1,0);
rmax=MathMax(rmax,CAblasF::RMaxAbsV(itidx+2,state.m_tmp1));
rmindiag=MathMin(rmindiag,MathAbs(v));
if(rmindiag<=(rmax*state.m_epsdiag))
{
state.m_retcode=3;
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
CAblasF::RCopyVC(itidx+2,state.m_tmp1,state.m_hr,itidx);
for(j=0; j<=itidx+1; j++)
{
v=state.m_hq.Get(itidx+0,j);
vv=state.m_hq.Get(itidx+1,j);
state.m_hq.Set(itidx+0,j,cs*v+sn*vv);
state.m_hq.Set(itidx+1,j,-(sn*v)+cs*vv);
}
v=state.m_hqb[itidx+0];
vv=state.m_hqb[itidx+1];
state.m_hqb.Set(itidx,cs*v+sn*vv);
state.m_hqb.Set(itidx+1,-(sn*v)+cs*vv);
resnrm=MathAbs(state.m_hqb[itidx+1]);
//--- Previous attempt to extend R was successful (no small diagonal elements).
//--- Increase Krylov subspace dimensionality.
kdim=kdim+1;
//--- Iteration is over.
//--- Terminate if:
//--- * last Qi was nearly zero after orthogonalization.
//--- * sufficient decrease of residual
//--- * stagnation of residual
state.m_itsperformed++;
if(qnrm<=(state.m_epsort*anrm) || qnrm==0.0)
{
state.m_retcode=4;
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
if(resnrm<=(state.m_epsres*bnrm))
{
state.m_retcode=5;
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
if((resnrm/prevresnrm)>state.m_epsred)
{
state.m_retcode=6;
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
itidx=itidx+1;
}
else
{
//--- Routine body
n=state.m_n;
state.m_retcode=1;
//--- Set up Q0
CAblasF::RSetAllocV(n,0.0,state.m_xs);
bnrm=MathSqrt(CAblasF::RDotV2(n,state.m_b));
if(bnrm==0.0)
{
state.m_reprelres=0;
return(false);
}
CAblasF::RAllocM(state.m_itscnt+1,n,state.m_qi);
CAblasF::RAllocM(state.m_itscnt,n,state.m_aqi);
CAblasF::RCopyMulVR(n,1/bnrm,state.m_b,state.m_qi,0);
CAblasF::RSetAllocM(state.m_itscnt+1,state.m_itscnt,0.0,state.m_h);
CAblasF::RSetAllocM(state.m_itscnt+1,state.m_itscnt,0.0,state.m_hr);
CAblasF::RSetAllocM(state.m_itscnt+1,state.m_itscnt+1,0.0,state.m_hq);
for(i=0; i<=state.m_itscnt; i++)
state.m_hq.Set(i,i,1);
CAblasF::RSetAllocV(state.m_itscnt+1,0.0,state.m_hqb);
state.m_hqb.Set(0,bnrm);
//--- Perform iteration
resnrm=bnrm;
kdim=0;
rmax=0;
rmindiag=1.0E99;
CAblasF::RSetAllocV(state.m_itscnt,0.0,state.m_ys);
CAblasF::RAllocV(MathMax(n,state.m_itscnt+2),state.m_tmp0);
CAblasF::RAllocV(MathMax(n,state.m_itscnt+2),state.m_tmp1);
itidx=0;
}
if(itidx>state.m_itscnt-1)
{
FblsGMRESIteration_lbl_3(state,kdim,n);
return(false);
}
prevresnrm=resnrm;
state.m_reprelres=resnrm/bnrm;
//--- Compute A*Qi[ItIdx], then compute Qi[ItIdx+1]
CAblasF::RCopyRV(n,state.m_qi,itidx,state.m_x);
state.m_rstate.stage=0;
//--- Saving state
state.m_rstate.ia.Set(0,n);
state.m_rstate.ia.Set(1,itidx);
state.m_rstate.ia.Set(2,kdim);
state.m_rstate.ia.Set(3,i);
state.m_rstate.ia.Set(4,j);
state.m_rstate.ra.Set(0,rmax);
state.m_rstate.ra.Set(1,rmindiag);
state.m_rstate.ra.Set(2,cs);
state.m_rstate.ra.Set(3,sn);
state.m_rstate.ra.Set(4,v);
state.m_rstate.ra.Set(5,vv);
state.m_rstate.ra.Set(6,anrm);
state.m_rstate.ra.Set(7,qnrm);
state.m_rstate.ra.Set(8,bnrm);
state.m_rstate.ra.Set(9,resnrm);
state.m_rstate.ra.Set(10,prevresnrm);
return(true);
}
//+------------------------------------------------------------------+
//| Post-solve |
//+------------------------------------------------------------------+
void CFbls::FblsGMRESIteration_lbl_3(CFblsGMRESState &state,int kdim,int n)
{
if(kdim>0)
{
CAblasF::RCopyV(kdim,state.m_hqb,state.m_ys);
CAblas::RMatrixTrsVect(kdim,state.m_hr,0,0,true,false,0,state.m_ys,0);
CAblas::RMatrixMVect(n,kdim,state.m_qi,0,0,1,state.m_ys,0,state.m_xs,0);
}
}
//+------------------------------------------------------------------+
//| Fast least squares solver, solves well conditioned system without|
//| performing any checks for degeneracy, and using user - provided |
//| buffers (which are automatically reallocated if too small). |
//| This function is intended for solution of moderately sized |
//| systems. It uses factorization algorithms based on Level 2 BLAS |
//| operations, thus it won't work efficiently on large scale systems|
//| INPUT PARAMETERS: |
//| A - array[M, N], system matrix. Contents of A is |
//| destroyed during solution. |
//| B - array[M], right part |
//| M - number of equations |
//| N - number of variables, N <= M |
//| Tmp0, Tmp1, Tmp2 - buffers; function automatically allocates |
//| them, if they are too small. They can be reused if |
//| function is called several times. |
//| OUTPUT PARAMETERS: |
//| B - solution(first N components, next M - N are zero) |
//+------------------------------------------------------------------+
void CFbls::FblsSolveLS(CMatrixDouble &a,CRowDouble &b,int m,int n,
CRowDouble &tmp0,
CRowDouble &tmp1,
CRowDouble &tmp2)
{
//--- create variables
int i=0;
int k=0;
double v=0;
int i_=0;
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(m>=n,__FUNCTION__+": M<N"))
return;
if(!CAp::Assert((int)a.Rows()>=m,__FUNCTION__+": Rows(A)<M"))
return;
if(!CAp::Assert((int)a.Cols()>=n,__FUNCTION__+": Cols(A)<N"))
return;
if(!CAp::Assert((int)b.Size()>=m,__FUNCTION__+": Length(B)<M"))
return;
//--- Allocate temporaries
tmp0=vector<double>::Zeros(MathMax(m,n)+1);
tmp1=vector<double>::Zeros(MathMax(m,n)+1);
tmp2=vector<double>::Zeros(MathMin(m,n));
//--- Call basecase QR
COrtFac::RMatrixQRBaseCase(a,m,n,tmp0,tmp1,tmp2);
//--- Multiply B by Q'
for(k=0; k<n; k++)
{
CAblasF::RSetV(k,0,tmp0);
for(i_=k+1; i_<m; i_++)
tmp0.Set(i_,a.Get(i_,k));
tmp0.Set(k,1);
v=0.0;
for(i_=k; i_<m; i_++)
v+=tmp0[i_]*b[i_];
v=v*tmp2[k];
for(i_=k; i_<m; i_++)
b.Add(i_,-v*tmp0[i_]);
}
//--- Solve triangular system
b.Set(n-1,b[n-1]/a.Get(n-1,n-1));
for(i=n-2; i>=0; i--)
{
v=0.0;
for(i_=i+1; i_<=n-1; i_++)
v+=a.Get(i,i_)*b[i_];
b.Set(i,(b[i]-v)/a.Get(i,i));
}
for(i=n; i<=m-1; i++)
b.Set(i,0.0);
}
//+------------------------------------------------------------------+
//| Auxiliary function for FblsCGiteration. Is a product to get rid |
//| of the operator unconditional jump goto. |
//+------------------------------------------------------------------+
void CFbls::Func_lbl_rcomm(CFblsLinCgState &state,int n,int k,
double rk2,double rk12,double pap,
double s,double betak,double v1,double v2)
{
//--- save
state.m_rstate.ia.Set(0,n);
state.m_rstate.ia.Set(1,k);
state.m_rstate.ra.Set(0,rk2);
state.m_rstate.ra.Set(1,rk12);
state.m_rstate.ra.Set(2,pap);
state.m_rstate.ra.Set(3,s);
state.m_rstate.ra.Set(4,betak);
state.m_rstate.ra.Set(5,v1);
state.m_rstate.ra.Set(6,v2);
}
//+------------------------------------------------------------------+
//| Auxiliary function for FblsCGiteration. Is a product to get rid |
//| of the operator unconditional jump goto. |
//+------------------------------------------------------------------+
bool CFbls::Func_lbl_3(CFblsLinCgState &state,int &n,int &k,
double &rk2,double &rk12,double &pap,
double &s,double &betak,double &v1,double &v2)
{
//--- check
if(k>n-1)
return(Func_lbl_5(state,n,k,rk2,rk12,pap,s,betak,v1,v2));
//--- Calculate A*p(k) - store in State.Tmp2
//--- and p(k)'*A*p(k) - store in PAP
//--- If PAP=0,break (iteration is over)
state.m_x=state.m_pk;
state.m_rstate.stage=1;
//--- Saving state
Func_lbl_rcomm(state,n,k,rk2,rk12,pap,s,betak,v1,v2);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Auxiliary function for FblsCGiteration. Is a product to get rid |
//| of the operator unconditional jump goto. |
//+------------------------------------------------------------------+
bool CFbls::Func_lbl_5(CFblsLinCgState &state,int &n,int &k,
double &rk2,double &rk12,double &pap,
double &s,double &betak,double &v1,double &v2)
{
//--- calculation E2
state.m_x=state.m_xk;
state.m_rstate.stage=2;
//--- Saving state
Func_lbl_rcomm(state,n,k,rk2,rk12,pap,s,betak,v1,v2);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Determinant calculation |
//+------------------------------------------------------------------+
class CMatDet
{
public:
static double RMatrixLUDet(CMatrixDouble &a,int &pivots[],const int n);
static double RMatrixLUDet(CMatrixDouble &a,CRowInt &pivots,const int n);
static double RMatrixDet(CMatrixDouble &ca,const int n);
static double SPDMatrixCholeskyDet(CMatrixDouble &a,const int n);
static double SPDMatrixDet(CMatrixDouble &ca,const int n,const bool IsUpper);
static complex CMatrixLUDet(CMatrixComplex &a,int &pivots[],const int n);
static complex CMatrixLUDet(CMatrixComplex &a,CRowInt &pivots,const int n);
static complex CMatrixDet(CMatrixComplex &ca,const int n);
};
//+------------------------------------------------------------------+
//| Determinant calculation of the matrix given by its LU |
//| decomposition. |
//| Input parameters: |
//| A - LU decomposition of the matrix (output of |
//| RMatrixLU subroutine). |
//| Pivots - table of permutations which were made during |
//| the LU decomposition. |
//| Output of RMatrixLU subroutine. |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| Result: matrix determinant. |
//+------------------------------------------------------------------+
double CMatDet::RMatrixLUDet(CMatrixDouble &a,int &pivots[],const int n)
{
CRowInt Pivots=pivots;
return(RMatrixLUDet(a,Pivots,n));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
double CMatDet::RMatrixLUDet(CMatrixDouble &a,CRowInt &pivots,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CAp::Len(pivots)>=n,__FUNCTION__+": Pivots array is too short!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CApServ::IsFiniteMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
//--- create variables
double result=0;
int i=0;
int s=0;
//--- initialization
result=1;
s=1;
for(i=0; i<n; i++)
{
result=result*a.Get(i,i);
//--- check
if(pivots[i]!=i)
s=-s;
}
//--- return result
return(result*s);
}
//+------------------------------------------------------------------+
//| Calculation of the determinant of a general matrix |
//| Input parameters: |
//| A - matrix, array[0..N-1, 0..N-1] |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| Result: determinant of matrix A. |
//+------------------------------------------------------------------+
double CMatDet::RMatrixDet(CMatrixDouble &ca,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(ca)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(ca)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CApServ::IsFiniteMatrix(ca,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
//--- create variables
double result=0;
CRowInt pivots;
//--- create copy
CMatrixDouble a=ca;
//--- function call
CTrFac::RMatrixLU(a,n,n,pivots);
//--- return result
return(RMatrixLUDet(a,pivots,n));
}
//+------------------------------------------------------------------+
//| Determinant calculation of the matrix given by its LU |
//| decomposition. |
//| Input parameters: |
//| A - LU decomposition of the matrix (output of |
//| RMatrixLU subroutine). |
//| Pivots - table of permutations which were made during |
//| the LU decomposition. |
//| Output of RMatrixLU subroutine. |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| Result: matrix determinant. |
//+------------------------------------------------------------------+
complex CMatDet::CMatrixLUDet(CMatrixComplex &a,int &pivots[],const int n)
{
CRowInt Pivots=pivots;
return(CMatrixLUDet(a,Pivots,n));
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
complex CMatDet::CMatrixLUDet(CMatrixComplex &a,CRowInt &pivots,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CAp::Len(pivots)>=n,__FUNCTION__+": Pivots array is too short!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CApServ::IsFiniteComplexMatrix(a,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
//--- create variables
complex result=0;
int i=0;
int s=0;
//--- initialization
result=1;
s=1;
for(i=0; i<n; i++)
{
result=result*a.Get(i,i);
//--- check
if(pivots[i]!=i)
s=-s;
}
//--- return result
return(result*s);
}
//+------------------------------------------------------------------+
//| Calculation of the determinant of a general matrix |
//| Input parameters: |
//| A - matrix, array[0..N-1, 0..N-1] |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| Result: determinant of matrix A. |
//+------------------------------------------------------------------+
complex CMatDet::CMatrixDet(CMatrixComplex &ca,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(ca)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(ca)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CApServ::IsFiniteComplexMatrix(ca,n,n),__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
//--- create variables
complex result=0;
int pivots[];
//--- create copy
CMatrixComplex a=ca;
//--- function call
CTrFac::CMatrixLU(a,n,n,pivots);
//--- return result
return(CMatrixLUDet(a,pivots,n));
}
//+------------------------------------------------------------------+
//| Determinant calculation of the matrix given by the Cholesky |
//| decomposition. |
//| Input parameters: |
//| A - Cholesky decomposition, |
//| output of SMatrixCholesky subroutine. |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| As the determinant is equal to the product of squares of diagonal|
//| elements, it?s not necessary to specify which triangle - lower |
//| or upper - the matrix is stored in. |
//| Result: |
//| matrix determinant. |
//+------------------------------------------------------------------+
double CMatDet::SPDMatrixCholeskyDet(CMatrixDouble &a,const int n)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(a)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(a)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
//--- create variables
double result=0;
int i=0;
bool f;
//--- initialization
f=true;
for(i=0; i<n; i++)
f=f && CMath::IsFinite(a.Get(i,i));
//--- check
if(!CAp::Assert(f,__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
result=1;
for(i=0; i<n; i++)
result=result*CMath::Sqr(a.Get(i,i));
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Determinant calculation of the symmetric positive definite |
//| matrix. |
//| Input parameters: |
//| A - matrix. Array with elements [0..N-1, 0..N-1]. |
//| N - (optional) size of matrix A: |
//| * if given, only principal NxN submatrix is |
//| processed and overwritten. other elements are |
//| unchanged. |
//| * if not given, automatically determined from |
//| matrix size (A must be square matrix) |
//| IsUpper - (optional) storage type: |
//| * if True, symmetric matrix A is given by its |
//| upper triangle, and the lower triangle isn?t |
//| used/changed by function |
//| * if False, symmetric matrix A is given by its |
//| lower triangle, and the upper triangle isn?t |
//| used/changed by function |
//| * if not given, both lower and upper triangles |
//| must be filled. |
//| Result: |
//| determinant of matrix A. |
//| If matrix A is not positive definite, exception is thrown. |
//+------------------------------------------------------------------+
double CMatDet::SPDMatrixDet(CMatrixDouble &ca,const int n,const bool IsUpper)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Rows(ca)>=n,__FUNCTION__+": rows(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert((int)CAp::Cols(ca)>=n,__FUNCTION__+": cols(A)<N!"))
return(EMPTY_VALUE);
if(!CAp::Assert(CApServ::IsFiniteRTrMatrix(ca,n,IsUpper),__FUNCTION__+": A contains infinite or NaN values!"))
return(EMPTY_VALUE);
//--- create variables
double result=0;
bool b;
//--- create copy
CMatrixDouble a=ca;
//--- function call
b=CTrFac::SPDMatrixCholesky(a,n,IsUpper);
//--- check
if(!CAp::Assert(b,__FUNCTION__+": A is not SPD!"))
return(EMPTY_VALUE);
//--- return result
return(SPDMatrixCholeskyDet(a,n));
}
//+------------------------------------------------------------------+
//| Generalized symmetric eigensolver |
//+------------------------------------------------------------------+
class CSpdGEVD
{
public:
static bool SMatrixGEVD(CMatrixDouble &ca,const int n,const bool isUppera,CMatrixDouble &b,const bool isUpperb,const int zneeded,const int problemtype,double &d[],CMatrixDouble &z);
static bool SMatrixGEVD(CMatrixDouble &ca,const int n,const bool isUppera,CMatrixDouble &b,const bool isUpperb,const int zneeded,const int problemtype,CRowDouble &d,CMatrixDouble &z);
static bool SMatrixGEVDReduce(CMatrixDouble &a,const int n,const bool isUppera,CMatrixDouble &b,const bool isUpperb,const int problemtype,CMatrixDouble &r,bool &isUpperr);
};
//+------------------------------------------------------------------+
//| Algorithm for solving the following generalized symmetric |
//| positive-definite eigenproblem: |
//| A*x = lambda*B*x (1) or |
//| A*B*x = lambda*x (2) or |
//| B*A*x = lambda*x (3). |
//| where A is a symmetric matrix, B - symmetric positive-definite |
//| matrix. The problem is solved by reducing it to an ordinary |
//| symmetric eigenvalue problem. |
//| Input parameters: |
//| A - symmetric matrix which is given by its upper |
//| or lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrices A and B. |
//| isUpperA - storage format of matrix A. |
//| B - symmetric positive-definite matrix which is |
//| given by its upper or lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| isUpperB - storage format of matrix B. |
//| ZNeeded - if ZNeeded is equal to: |
//| * 0, the eigenvectors are not returned; |
//| * 1, the eigenvectors are returned. |
//| ProblemType - if ProblemType is equal to: |
//| * 1, the following problem is solved: |
//| A*x = lambda*B*x; |
//| * 2, the following problem is solved: |
//| A*B*x = lambda*x; |
//| * 3, the following problem is solved: |
//| B*A*x = lambda*x. |
//| Output parameters: |
//| D - eigenvalues in ascending order. |
//| Array whose index ranges within [0..N-1]. |
//| Z - if ZNeeded is equal to: |
//| * 0, Z hasn?t changed; |
//| * 1, Z contains eigenvectors. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| The eigenvectors are stored in matrix |
//| columns. It should be noted that the |
//| eigenvectors in such problems do not form an |
//| orthogonal system. |
//| Result: |
//| True, if the problem was solved successfully. |
//| False, if the error occurred during the Cholesky |
//| decomposition of matrix B (the matrix isn?t |
//| positive-definite) or during the work of the iterative |
//| algorithm for solving the symmetric eigenproblem. |
//| See also the GeneralizedSymmetricDefiniteEVDReduce subroutine. |
//+------------------------------------------------------------------+
bool CSpdGEVD::SMatrixGEVD(CMatrixDouble &ca,const int n,const bool isUppera,
CMatrixDouble &b,const bool isUpperb,const int zneeded,
const int problemtype,double &d[],CMatrixDouble &z)
{
CRowDouble D;
if(!SMatrixGEVD(ca,n,isUppera,b,isUpperb,zneeded,problemtype,D,z))
return(false);
D.ToArray(d);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CSpdGEVD::SMatrixGEVD(CMatrixDouble &ca,const int n,const bool isUppera,
CMatrixDouble &b,const bool isUpperb,const int zneeded,
const int problemtype,CRowDouble &d,CMatrixDouble &z)
{
//--- create variables
bool result;
bool isUpperr;
int j1=0;
int j2=0;
int j1inc=0;
int j2inc=0;
int i=0;
int j=0;
double v=0;
int i_=0;
//--- create matrix
CMatrixDouble r;
CMatrixDouble t;
//--- create copy
CMatrixDouble a=ca;
//--- Reduce and solve
result=SMatrixGEVDReduce(a,n,isUppera,b,isUpperb,problemtype,r,isUpperr);
//--- check
if(!result)
return(result);
//--- get result
result=CEigenVDetect::SMatrixEVD(a,n,zneeded,isUppera,d,t);
//--- check
if(!result)
return(result);
//--- Transform eigenvectors if needed
if(zneeded!=0)
{
//--- fill Z with zeros
z=matrix<double>::Zeros(n,n);
//--- Setup R properties
if(isUpperr)
{
j1=0;
j2=n-1;
j1inc=1;
j2inc=0;
}
else
{
j1=0;
j2=0;
j1inc=0;
j2inc=1;
}
//--- Calculate R*Z
for(i=0; i<n; i++)
{
for(j=j1; j<=j2; j++)
{
v=r.Get(i,j);
for(i_=0; i_<n; i_++)
z.Set(i,i_,z.Get(i,i_)+v*t.Get(j,i_));
}
j1=j1+j1inc;
j2=j2+j2inc;
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Algorithm for reduction of the following generalized symmetric |
//| positive- definite eigenvalue problem: |
//| A*x = lambda*B*x (1) or |
//| A*B*x = lambda*x (2) or |
//| B*A*x = lambda*x (3) |
//| to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues |
//| of this and the given problems are the same, and the eigenvectors|
//| of the given problem could be obtained by multiplying the |
//| obtained eigenvectors by the transformation matrix x = R*y). |
//| Here A is a symmetric matrix, B - symmetric positive-definite |
//| matrix. |
//| Input parameters: |
//| A - symmetric matrix which is given by its upper |
//| or lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrices A and B. |
//| isUpperA - storage format of matrix A. |
//| B - symmetric positive-definite matrix which is |
//| given by its upper or lower triangular part. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| isUpperB - storage format of matrix B. |
//| ProblemType - if ProblemType is equal to: |
//| * 1, the following problem is solved: |
//| A*x = lambda*B*x; |
//| * 2, the following problem is solved: |
//| A*B*x = lambda*x; |
//| * 3, the following problem is solved: |
//| B*A*x = lambda*x. |
//| Output parameters: |
//| A - symmetric matrix which is given by its upper |
//| or lower triangle depending on isUpperA. |
//| Contains matrix C. Array whose indexes range |
//| within [0..N-1, 0..N-1]. |
//| R - upper triangular or low triangular |
//| transformation matrix which is used to obtain|
//| the eigenvectors of a given problem as the |
//| product of eigenvectors of C (from the right)|
//| and matrix R (from the left). If the matrix |
//| is upper triangular, the elements below the |
//| main diagonal are equal to 0 (and vice versa)|
//| Thus, we can perform the multiplication |
//| without taking into account the internal |
//| structure (which is an easier though less |
//| effective way). Array whose indexes range |
//| within [0..N-1, 0..N-1]. |
//| isUpperR - type of matrix R (upper or lower triangular).|
//| Result: |
//| True, if the problem was reduced successfully. |
//| False, if the error occurred during the Cholesky |
//| decomposition of matrix B (the matrix is not |
//| positive-definite). |
//+------------------------------------------------------------------+
bool CSpdGEVD::SMatrixGEVDReduce(CMatrixDouble &a,const int n,const bool isUppera,
CMatrixDouble &b,const bool isUpperb,const int problemtype,
CMatrixDouble &r,bool &isUpperr)
{
//--- check
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0!"))
return(false);
//--- check
if(!CAp::Assert(problemtype==1 || problemtype==2 || problemtype==3,__FUNCTION__+": incorrect ProblemType!"))
return(false);
//--- create variables
bool result;
int i=0;
int j=0;
double v=0;
int info=0;
int i_=0;
int i1_=0;
//--- create matrix
CMatrixDouble t;
//--- create arrays
CRowDouble w1;
CRowDouble w2;
CRowDouble w3;
//--- object of class
CMatInvReport rep;
//--- initialization
result=true;
//--- Problem 1: A*x = lambda*B*x
//--- Reducing to:
//--- C*y = lambda*y
//--- C = L^(-1) * A * L^(-T)
//--- x = L^(-T) * y
if(problemtype==1)
{
//--- Factorize B in T: B = LL'
t.Resize(n,n);
//--- check
if(isUpperb)
t=(b.Transpose()+0).TriL();
else
t=b.TriL()+0;
//--- check
if(!CTrFac::SPDMatrixCholesky(t,n,false))
return(false);
//--- Invert L in T
CMatInv::RMatrixTrInverse(t,n,false,false,info,rep);
//--- check
if(info<=0)
return(false);
//--- Build L^(-1) * A * L^(-T) in R
w1.Resize(n+1);
w2.Resize(n+1);
r.Resize(n,n);
for(j=1; j<=n; j++)
{
//--- Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T))
i1_=-1;
for(i_=1; i_<=j; i_++)
w1.Set(i_,t.Get(j-1,i_+i1_));
//--- function call
CSblas::SymmetricMatrixVectorMultiply(a,isUppera,0,j-1,w1,1.0,w2);
//--- check
if(isUppera)
CBlas::MatrixVectorMultiply(a,0,j-1,j,n-1,true,w1,1,j,1.0,w2,j+1,n,0.0);
else
CBlas::MatrixVectorMultiply(a,j,n-1,0,j-1,false,w1,1,j,1.0,w2,j+1,n,0.0);
//--- Form l(i)*w2 (here l(i) is i-th row of L^(-1))
for(i=1; i<=n; i++)
{
i1_=1;
v=0.0;
for(i_=0; i_<i; i_++)
v+=t.Get(i-1,i_)*w2[i_+i1_];
r.Set(i-1,j-1,v);
}
}
//--- Copy R to A
a=r;
//--- Copy L^(-1) from T to R and transpose
isUpperr=true;
r=t.Transpose()+0;
//--- return result
return(result);
}
//--- Problem 2: A*B*x = lambda*x
//--- or
//--- problem 3: B*A*x = lambda*x
//--- Reducing to:
//--- C*y = lambda*y
//--- C = U * A * U'
//--- B = U'* U
if(problemtype==2 || problemtype==3)
{
//--- Factorize B in T: B = U'*U
//--- check
if(isUpperb)
t=b.TriU()+0;
else
t=(b.Transpose()+0).TriU();
//--- check
if(!CTrFac::SPDMatrixCholesky(t,n,true))
return(false);
//--- Build U * A * U' in R
w1.Resize(n+1);
w2.Resize(n+1);
w3.Resize(n+1);
r.Resize(n,n);
for(j=1; j<=n; j++)
{
//--- Form w2 = A * u'(j) (here u'(j) is j-th column of U')
i1_=j-2;
for(i_=1; i_<=n-j+1; i_++)
w1.Set(i_,t.Get(j-1,i_+i1_));
//--- function call
CSblas::SymmetricMatrixVectorMultiply(a,isUppera,j-1,n-1,w1,1.0,w3);
i1_=(1)-(j);
for(i_=j; i_<=n; i_++)
w2.Set(i_,w3[i_+i1_]);
i1_ =-1;
for(i_=j; i_<=n; i_++)
w1.Set(i_,t.Get(j-1,i_+i1_));
//--- check
if(isUppera)
CBlas::MatrixVectorMultiply(a,0,j-2,j-1,n-1,false,w1,j,n,1.0,w2,1,j-1,0.0);
else
CBlas::MatrixVectorMultiply(a,j-1,n-1,0,j-2,true,w1,j,n,1.0,w2,1,j-1,0.0);
//--- Form u(i)*w2 (here u(i) is i-th row of U)
for(i=1; i<=n; i++)
{
i1_= 1;
v=0.0;
for(i_=i-1; i_<n; i_++)
v+=t.Get(i-1,i_)*w2[i_+i1_];
r.Set(i-1,j-1,v);
}
}
//--- Copy R to A
a=r;
//--- check
if(problemtype==2)
{
//--- Invert U in T
CMatInv::RMatrixTrInverse(t,n,true,false,info,rep);
//--- check
if(info<=0)
return(false);
//--- Copy U^-1 from T to R
isUpperr=true;
r=t;
}
else
{
//--- Copy U from T to R and transpose
isUpperr=false;
r=t.Transpose()+0;
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Inverse and update |
//+------------------------------------------------------------------+
class CInverseUpdate
{
public:
static void RMatrixInvUpdateSimple(CMatrixDouble &inva,const int n,const int updrow,const int updcolumn,const double updval);
static void RMatrixInvUpdateRow(CMatrixDouble &inva,const int n,const int updrow,double &v[]);
static void RMatrixInvUpdateRow(CMatrixDouble &inva,const int n,const int updrow,CRowDouble &v);
static void RMatrixInvUpdateColumn(CMatrixDouble &inva,const int n,const int updcolumn,double &u[]);
static void RMatrixInvUpdateColumn(CMatrixDouble &inva,const int n,const int updcolumn,CRowDouble &u);
static void RMatrixInvUpdateUV(CMatrixDouble &inva,const int n,double &u[],double &v[]);
static void RMatrixInvUpdateUV(CMatrixDouble &inva,const int n,CRowDouble &u,CRowDouble &v);
};
//+------------------------------------------------------------------+
//| Inverse matrix update by the Sherman-Morrison formula |
//| The algorithm updates matrix A^-1 when adding a number to an |
//| element of matrix A. |
//| Input parameters: |
//| InvA - inverse of matrix A. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| UpdRow - row where the element to be updated is stored. |
//| UpdColumn - column where the element to be updated is stored.|
//| UpdVal - a number to be added to the element. |
//| Output parameters: |
//| InvA - inverse of modified matrix A. |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateSimple(CMatrixDouble &inva,const int n,
const int updrow,const int updcolumn,
const double updval)
{
//--- check
if(!CAp::Assert(updrow>=0 && updrow<n,__FUNCTION__+": incorrect UpdRow!"))
return;
if(!CAp::Assert(updcolumn>=0 && updcolumn<n,__FUNCTION__+": incorrect UpdColumn!"))
return;
//--- create arrays
CRowDouble t1;
CRowDouble t2;
//--- create variables
int i=0;
double lambdav=0;
double vt=0;
int i_=0;
//--- T1=InvA * U
t1=inva.Col(updrow)+0;
//--- T2=v*InvA
t2=inva.Row(updcolumn)+0;
//--- Lambda=v * InvA * U
lambdav=updval*inva.Get(updcolumn,updrow);
//--- InvA=InvA - correction
for(i=0; i<n; i++)
{
vt=(updval*t1[i])/(1+lambdav);
inva.Row(i,inva[i]-t2*vt);
}
}
//+------------------------------------------------------------------+
//| Inverse matrix update by the Sherman-Morrison formula |
//| The algorithm updates matrix A^-1 when adding a vector to a row |
//| of matrix A. |
//| Input parameters: |
//| InvA - inverse of matrix A. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| UpdRow - the row of A whose vector V was added. |
//| 0 <= Row <= N-1 |
//| V - the vector to be added to a row. |
//| Array whose index ranges within [0..N-1]. |
//| Output parameters: |
//| InvA - inverse of modified matrix A. |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateRow(CMatrixDouble &inva,const int n,
const int updrow,double &v[])
{
CRowDouble V=v;
RMatrixInvUpdateRow(inva,n,updrow,V);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateRow(CMatrixDouble &inva,const int n,
const int updrow,CRowDouble &v)
{
//--- create arrays
vector<double> t1;
vector<double> t2;
//--- create variables
int i=0;
int j=0;
double lambdav=0;
double vt=0;
int i_=0;
//--- T1=InvA * U
t1=inva.Col(updrow);
//--- T2=v*InvA
t2=v.ToVector();
t2=(inva.Transpose()+0).MatMul(t2);
//--- Lambda=v * InvA * U
lambdav=t2[updrow];
//--- InvA=InvA - correction
for(i=0; i<n; i++)
{
vt=t1[i]/(1+lambdav);
inva.Row(i,inva[i]-t2*vt);
}
}
//+------------------------------------------------------------------+
//| Inverse matrix update by the Sherman-Morrison formula |
//| The algorithm updates matrix A^-1 when adding a vector to a |
//| column of matrix A. |
//| Input parameters: |
//| InvA - inverse of matrix A. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| UpdColumn - the column of A whose vector U was added. |
//| 0 <= UpdColumn <= N-1 |
//| U - the vector to be added to a column. |
//| Array whose index ranges within [0..N-1]. |
//| Output parameters: |
//| InvA - inverse of modified matrix A. |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateColumn(CMatrixDouble &inva,const int n,
const int updcolumn,double &u[])
{
CRowDouble U=u;
RMatrixInvUpdateColumn(inva,n,updcolumn,U);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateColumn(CMatrixDouble &inva,const int n,
const int updcolumn,CRowDouble &u)
{
//--- create arrays
vector<double> t1=u.ToVector();
vector<double> t2;
//--- create variables
int i=0;
double lambdav=0;
double vt=0;
int i_=0;
//--- T1=InvA * U
t1=(inva.ToMatrix()+0).MatMul(t1);
//--- Lambda=v * InvA * U
lambdav=t1[updcolumn];
//--- T2=v*InvA
t2=inva[updcolumn];
//--- InvA=InvA - correction
t1/=(1+lambdav);
for(i=0; i<n; i++)
inva.Row(i,inva[i]-t2*t1[i]);
}
//+------------------------------------------------------------------+
//| Inverse matrix update by the Sherman-Morrison formula |
//| The algorithm computes the inverse of matrix A+u*v? by using the |
//| given matrix A^-1 and the vectors u and v. |
//| Input parameters: |
//| InvA - inverse of matrix A. |
//| Array whose indexes range within |
//| [0..N-1, 0..N-1]. |
//| N - size of matrix A. |
//| U - the vector modifying the matrix. |
//| Array whose index ranges within [0..N-1]. |
//| V - the vector modifying the matrix. |
//| Array whose index ranges within [0..N-1]. |
//| Output parameters: |
//| InvA - inverse of matrix A + u*v'. |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateUV(CMatrixDouble &inva,const int n,
double &u[],double &v[])
{
CRowDouble U=u;
CRowDouble V=v;
RMatrixInvUpdateUV(inva,n,U,V);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CInverseUpdate::RMatrixInvUpdateUV(CMatrixDouble &inva,const int n,
CRowDouble &u,CRowDouble &v)
{
//--- create arrays
vector<double> t1=u.ToVector();
vector<double> t2=v.ToVector();
//--- create variables
double lambdav=0;
double vt=0;
//--- T1=InvA * U
t1=(inva.ToMatrix()+0).MatMul(t1);
//--- Lambda=v * T1
lambdav=t2.MatMul(t1);
//--- T2=v*InvA
t2=(inva.Transpose()+0).MatMul(t2);
//--- InvA=InvA - correction
t1/=(1+lambdav);
for(int i=0; i<n; i++)
inva.Row(i,inva[i]-t2*t1[i]);
}
//+------------------------------------------------------------------+
//| Schur decomposition |
//+------------------------------------------------------------------+
class CSchur
{
public:
static bool RMatrixSchur(CMatrixDouble &a,const int n,CMatrixDouble &s);
};
//+------------------------------------------------------------------+
//| Subroutine performing the Schur decomposition of a general matrix|
//| by using the QR algorithm with multiple shifts. |
//| The source matrix A is represented as S'*A*S = T, where S is an |
//| orthogonal matrix (Schur vectors), T - upper quasi-triangular |
//| matrix (with blocks of sizes 1x1 and 2x2 on the main diagonal). |
//| Input parameters: |
//| A - matrix to be decomposed. |
//| Array whose indexes range within [0..N-1, 0..N-1]. |
//| N - size of A, N>=0. |
//| Output parameters: |
//| A - contains matrix T. |
//| Array whose indexes range within [0..N-1, 0..N-1]. |
//| S - contains Schur vectors. |
//| Array whose indexes range within [0..N-1, 0..N-1]. |
//| Note 1: |
//| The block structure of matrix T can be easily recognized: |
//| since all the elements below the blocks are zeros, the |
//| elements a[i+1,i] which are equal to 0 show the block border.|
//| Note 2: |
//| The algorithm performance depends on the value of the |
//| internal parameter NS of the InternalSchurDecomposition |
//| subroutine which defines the number of shifts in the QR |
//| algorithm (similarly to the block width in block-matrix |
//| algorithms in linear algebra). If you require maximum |
//| performance on your machine, it is recommended to adjust |
//| this parameter manually. |
//| Result: |
//| True, |
//| if the algorithm has converged and parameters A and S |
//| contain the result. |
//| False, |
//| if the algorithm has not converged. |
//| Algorithm implemented on the basis of the DHSEQR subroutine |
//| (LAPACK 3.0 library). |
//+------------------------------------------------------------------+
bool CSchur::RMatrixSchur(CMatrixDouble &a,const int n,CMatrixDouble &s)
{
//--- create variables
int info=0;
//--- create arrays
CRowDouble tau;
CRowDouble wi;
CRowDouble wr;
//--- Upper Hessenberg form of the 0-based matrix
COrtFac::RMatrixHessenberg(a,n,tau);
COrtFac::RMatrixHessenbergUnpackQ(a,n,tau,s);
//--- Schur decomposition
CHsSchur::RMatrixInternalSchurDecomposition(a,n,1,1,wr,wi,s,info);
//--- return result
return(info==0);
}
//+------------------------------------------------------------------+
//| This structure is used by sparse LU to store "left" and "upper" |
//| rectangular submatrices BL and BU, as defined below: |
//| [ | : ] |
//| [ LU | BU : ] |
//| [ | : ] |
//| [--------------: dense ] |
//| [ | : trail ] |
//| [ | sparse : ] |
//| [ BL | : ] |
//| [ | trail : ] |
//| [ | : ] |
//+------------------------------------------------------------------+
class CSLUV2List1Matrix
{
public:
int m_NFixed;
int m_NDynamic;
CRowInt m_IdxFirst;
CRowInt m_StrgIdx;
CRowDouble m_StrgVal;
int m_NAllocated;
int m_NUsed;
//---
CSLUV2List1Matrix(void) { Init();}
~CSLUV2List1Matrix(void) { }
void Init(void) { };
void Copy(const CSLUV2List1Matrix &obj);
//--- overloading
void operator=(const CSLUV2List1Matrix &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Make copy of object |
//+------------------------------------------------------------------+
void CSLUV2List1Matrix::Copy(const CSLUV2List1Matrix &obj)
{
m_NFixed=obj.m_NFixed;
m_NDynamic=obj.m_NDynamic;
m_IdxFirst=obj.m_IdxFirst;
m_StrgIdx=obj.m_StrgIdx;
m_StrgVal=obj.m_StrgVal;
m_NAllocated=obj.m_NAllocated;
m_NUsed=obj.m_NUsed;
}
//+------------------------------------------------------------------+
//| This structure is used by sparse LU to store sparse trail |
//| submatrix as defined below: |
//| [ | : ] |
//| [ LU | BU : ] |
//| [ | : ] |
//| [--------------: dense ] |
//| [ | : trail ] |
//| [ | sparse : ] |
//| [ BL | : ] |
//| [ | trail : ] |
//| [ | : ] |
//+------------------------------------------------------------------+
struct CSLUV2SparseTrail
{
int m_N;
int m_K;
int m_MaxWrkCnt;
int m_MaxWrkNz;
int m_WrkCnt;
int m_SlsUsed;
CRowInt m_Nzc;
CRowInt m_WrkSet;
CRowInt m_ColId;
bool m_IsDensified[];
CRowInt m_SlsColPtr;
CRowInt m_SlsRowPtr;
CRowInt m_SlsIdx;
CRowDouble m_SlsVal;
CRowDouble m_Tmp0;
//---
CSLUV2SparseTrail(void) { Init(); }
~CSLUV2SparseTrail(void) {}
void Init(void);
void Copy(const CSLUV2SparseTrail &obj);
//--- overloading
void operator=(const CSLUV2SparseTrail &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSLUV2SparseTrail::Init(void)
{
m_N=0;
m_K=0;
m_MaxWrkCnt=0;
m_MaxWrkNz=0;
m_WrkCnt=0;
m_SlsUsed=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSLUV2SparseTrail::Copy(const CSLUV2SparseTrail &obj)
{
m_N=obj.m_N;
m_K=obj.m_K;
m_MaxWrkCnt=obj.m_MaxWrkCnt;
m_MaxWrkNz=obj.m_MaxWrkNz;
m_WrkCnt=obj.m_WrkCnt;
m_SlsUsed=obj.m_SlsUsed;
m_Nzc=obj.m_Nzc;
m_WrkSet=obj.m_WrkSet;
m_ColId=obj.m_ColId;
ArrayCopy(m_IsDensified,obj.m_IsDensified);
m_SlsColPtr=obj.m_SlsColPtr;
m_SlsRowPtr=obj.m_SlsRowPtr;
m_SlsIdx=m_SlsIdx;
m_SlsVal=obj.m_SlsVal;
m_Tmp0=obj.m_Tmp0;
}
//+------------------------------------------------------------------+
//| This structure is used by sparse LU to store dense trail |
//| submatrix as defined below: |
//| [ | : ] |
//| [ LU | BU : ] |
//| [ | : ] |
//| [--------------: dense ] |
//| [ | : trail ] |
//| [ | sparse : ] |
//| [ BL | : ] |
//| [ | trail : ] |
//| [ | : ] |
//+------------------------------------------------------------------+
struct CSLUV2DenseTrail
{
int m_N;
int m_NDense;
CMatrixDouble m_D;
CRowInt m_Did;
//---
CSLUV2DenseTrail(void) { Init(); }
~CSLUV2DenseTrail(void) {}
void Init(void);
void Copy(const CSLUV2DenseTrail &obj);
//--- overloading
void operator=(const CSLUV2DenseTrail &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSLUV2DenseTrail::Init(void)
{
m_N=0;
m_NDense=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSLUV2DenseTrail::Copy(const CSLUV2DenseTrail &obj)
{
m_N=obj.m_N;
m_NDense=obj.m_NDense;
m_D=obj.m_D;
m_Did=obj.m_Did;
}
//+------------------------------------------------------------------+
//| This structure is used by sparse LU for buffer storage |
//+------------------------------------------------------------------+
struct CSLUV2Buffer
{
int m_N;
CSparseMatrix m_SparseL;
CSparseMatrix m_SparseUT;
CSLUV2List1Matrix m_BLeft;
CSLUV2List1Matrix m_BUpper;
CSLUV2SparseTrail m_STrail;
CSLUV2DenseTrail m_DTrail;
CRowInt m_RowPermRawIdx;
CMatrixDouble m_DBuf;
CRowInt m_V0i;
CRowInt m_V1i;
CRowDouble m_V0r;
CRowDouble m_V1r;
CRowDouble m_Tmp0;
CRowInt m_TmpI;
CRowInt m_TmpP;
//---
CSLUV2Buffer(void) { Init(); };
~CSLUV2Buffer(void) {}
void Init() { m_N=0; }
void Copy(const CSLUV2Buffer &obj);
//--- overloading
void operator=(const CSLUV2Buffer &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CSLUV2Buffer::Copy(const CSLUV2Buffer &obj)
{
m_N=obj.m_N;
m_SparseL=obj.m_SparseL;
m_SparseUT=obj.m_SparseUT;
m_BLeft=obj.m_BLeft;
m_BUpper=obj.m_BUpper;
m_STrail=obj.m_STrail;
m_DTrail=obj.m_DTrail;
m_RowPermRawIdx=obj.m_RowPermRawIdx;
m_DBuf=obj.m_DBuf;
m_V0i=obj.m_V0i;
m_V1i=obj.m_V1i;
m_V0r=obj.m_V0r;
m_V1r=obj.m_V1r;
m_Tmp0=obj.m_Tmp0;
m_TmpI=obj.m_TmpI;
m_TmpP=obj.m_TmpP;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
class CSpTrf
{
public:
static const double m_DenseBnd;
static const int m_SlsWidth;
static bool SpTrfLU(CSparseMatrix &a,int pivottype,CRowInt &pr,CRowInt &pc,CSLUV2Buffer &buf);
private:
static void SLUV2List1Init(int n,CSLUV2List1Matrix &a);
static void SLUV2List1Swap(CSLUV2List1Matrix &a,int i,int j);
static void SLUV2List1DropSequence(CSLUV2List1Matrix &a,int i);
static void SLUV2List1AppendSequenceToMatrix(CSLUV2List1Matrix &a,int src,bool HasDiagonal,double d,int nzmax,CSparseMatrix &s,int dst);
static void SLUV2List1PushSparseVector(CSLUV2List1Matrix &a,CRowInt &si,CRowDouble &sv,int nz);
static void DenseTrailInit(CSLUV2DenseTrail &d,int n);
static void DenseTrailAppendColumn(CSLUV2DenseTrail &d,CRowDouble &x,int id);
static void SparseTrailInit(CSparseMatrix &s,CSLUV2SparseTrail &a);
static bool SparseTrailFindPivot(CSLUV2SparseTrail &a,int pivottype,int &ipiv,int &jpiv);
static void SparseTrailPivotOut(CSLUV2SparseTrail &a,int ipiv,int jpiv,double &uu,CRowInt &v0i,CRowDouble &v0r,int &nz0,CRowInt &v1i,CRowDouble &v1r,int &nz1);
static void SparseTrailDensify(CSLUV2SparseTrail &a,int i1,CSLUV2List1Matrix &BUpper,CSLUV2DenseTrail &DTrail);
static void SparseTrailUpdate(CSLUV2SparseTrail &a,CRowInt &v0i,CRowDouble &v0r,int nz0,CRowInt &v1i,CRowDouble &v1r,int nz1,CSLUV2List1Matrix &BUpper,CSLUV2DenseTrail &DTrail,bool DensificationSupported);
};
//+------------------------------------------------------------------+
//| Constants |
//+------------------------------------------------------------------+
const double CSpTrf::m_DenseBnd=0.10;
const int CSpTrf::m_SlsWidth=8;
//+------------------------------------------------------------------+
//| Sparse LU for square NxN CRS matrix with both row and column |
//| permutations. |
//| Represents A as Pr*L*U*Pc, where: |
//| * Pr is a product of row permutations |
//| Pr=Pr(0)*Pr(1)*...*Pr(n-2)*Pr(n-1) |
//| * Pc is a product of col permutations |
//| Pc=Pc(n-1)*Pc(n-2)*...*Pc(1)*Pc(0) |
//| * L is lower unitriangular |
//| * U is upper triangular |
//| INPUT PARAMETERS: |
//| A - sparse square matrix in CRS format |
//| PivotType - pivot type: |
//| * 0 - for best pivoting available |
//| * 1 - row-only pivoting |
//| * 2 - row and column greedy pivoting algorithm (most|
//| sparse pivot column is selected from the |
//| trailing matrix at each step) |
//| Buf - temporary buffer, previously allocated memory is |
//| reused as much as possible |
//| OUTPUT PARAMETERS: |
//| A - LU decomposition of A |
//| PR - array[N], row pivots |
//| PC - array[N], column pivots |
//| Buf - following fields of Buf are set: |
//| * Buf.RowPermRawIdx[] - contains row permutation, with|
//| RawIdx[I]=J meaning that J-th row of the original|
//| input matrix was moved to Ith position of the output|
//| factorization |
//| This function always succeeds i.e. it ALWAYS returns valid |
//| factorization, but for your convenience it also returns boolean |
//| value which helps to detect symbolically degenerate matrix: |
//| * function returns TRUE if the matrix was factorized AND |
//| symbolically non-degenerate |
//| * function returns FALSE if the matrix was factorized but U has|
//| strictly zero elements at the diagonal (the factorization is |
//| returned anyway). |
//+------------------------------------------------------------------+
bool CSpTrf::SpTrfLU(CSparseMatrix &a,
int pivottype,
CRowInt &pr,
CRowInt &pc,
CSLUV2Buffer &buf)
{
bool result;
int n=CSparse::SparseGetNRows(a);
int k=0;
int i=0;
int j=0;
int jp=0;
int i0=0;
int i1=0;
int ibest=0;
int jbest=0;
double v=0;
double v0=0;
int nz0=0;
int nz1=0;
double uu=0;
int Offs=0;
int tmpndense=0;
bool DensificationSupported;
int DensifyAbove=0;
//--- check
if(!CAp::Assert(CSparse::SparseIsCRS(a),__FUNCTION__+": A is not stored in CRS format"))
return(false);
if(!CAp::Assert(n==CSparse::SparseGetNCols(a),__FUNCTION__+": non-square A"))
return(false);
//--- check
if(!CAp::Assert((pivottype==0 || pivottype==1) || pivottype==2,__FUNCTION__+": unexpected pivot type"))
return(false);
//--- Initialization
result=true;
if(pivottype==0)
{
pivottype=2;
}
DensificationSupported=pivottype==2;
buf.m_N=n;
CApServ::IVectorSetLengthAtLeast(buf.m_RowPermRawIdx,n);
for(i=0; i<n; i++)
{
buf.m_RowPermRawIdx.Set(i,i);
}
//--- Allocate storage for sparse L and U factors
//--- NOTE: SparseMatrix structure for these factors is only
//--- partially initialized; we use it just as a temporary
//--- storage and do not intend to use facilities of the
//--- 'sparse' subpackage to work with these objects.
buf.m_SparseL.m_MatrixType=1;
buf.m_SparseL.m_M=n;
buf.m_SparseL.m_N=n;
CApServ::IVectorSetLengthAtLeast(buf.m_SparseL.m_RIdx,n+1);
buf.m_SparseL.m_RIdx.Set(0,0);
buf.m_SparseUT.m_MatrixType=1;
buf.m_SparseUT.m_M=n;
buf.m_SparseUT.m_N=n;
CApServ::IVectorSetLengthAtLeast(buf.m_SparseUT.m_RIdx,n+1);
buf.m_SparseUT.m_RIdx.Set(0,0);
//--- Allocate unprocessed yet part of the matrix,
//--- two submatrices:
//--- * BU, upper J rows of columns [J,N), upper submatrix
//--- * BL, left J cols of rows [J,N), left submatrix
//--- * B1, (N-J)*(N-J) square submatrix
SLUV2List1Init(n,buf.m_BLeft);
SLUV2List1Init(n,buf.m_BUpper);
CApServ::IVectorSetLengthAtLeast(pr,n);
CApServ::IVectorSetLengthAtLeast(pc,n);
CApServ::IVectorSetLengthAtLeast(buf.m_V0i,n);
CApServ::IVectorSetLengthAtLeast(buf.m_V1i,n);
CApServ::RVectorSetLengthAtLeast(buf.m_V0r,n);
CApServ::RVectorSetLengthAtLeast(buf.m_V1r,n);
SparseTrailInit(a,buf.m_STrail);
//--- Prepare dense trail, initial densification
DenseTrailInit(buf.m_DTrail,n);
DensifyAbove=(int)MathRound(m_DenseBnd*n)+1;
if(DensificationSupported)
{
for(i=0; i<n; i++)
if(buf.m_STrail.m_Nzc[i]>DensifyAbove)
SparseTrailDensify(buf.m_STrail,i,buf.m_BUpper,buf.m_DTrail);
}
//--- Process sparse part
for(k=0; k<n; k++)
{
//--- Find pivot column and pivot row
if(!SparseTrailFindPivot(buf.m_STrail,pivottype,ibest,jbest))
{
//--- Only densified columns are left, break sparse iteration
if(!CAp::Assert(buf.m_DTrail.m_NDense+k==n,__FUNCTION__+": integrity check failed (35741)"))
return(false);
break;
}
pc.Set(k,jbest);
pr.Set(k,ibest);
j=buf.m_RowPermRawIdx[k];
buf.m_RowPermRawIdx.Set(k,buf.m_RowPermRawIdx[ibest]);
buf.m_RowPermRawIdx.Set(ibest,j);
//--- Apply pivoting to BL and BU
SLUV2List1Swap(buf.m_BLeft,k,ibest);
SLUV2List1Swap(buf.m_BUpper,k,jbest);
//--- Apply pivoting to sparse trail, pivot out
SparseTrailPivotOut(buf.m_STrail,ibest,jbest,uu,buf.m_V0i,buf.m_V0r,nz0,buf.m_V1i,buf.m_V1r,nz1);
result=(result && uu!=0);
//--- Pivot dense trail
tmpndense=buf.m_DTrail.m_NDense;
for(i=0; i<tmpndense; i++)
{
v=buf.m_DTrail.m_D.Get(k,i);
buf.m_DTrail.m_D.Set(k,i,buf.m_DTrail.m_D.Get(ibest,i));
buf.m_DTrail.m_D.Set(ibest,i,v);
}
//--- Output to LU matrix
SLUV2List1AppendSequenceToMatrix(buf.m_BUpper,k,true,uu,n,buf.m_SparseUT,k);
SLUV2List1AppendSequenceToMatrix(buf.m_BLeft,k,false,0.0,n,buf.m_SparseL,k);
//--- Extract K-th col/row of B1, generate K-th col/row of BL/BU, update NZC
SLUV2List1PushSparseVector(buf.m_BLeft,buf.m_V0i,buf.m_V0r,nz0);
SLUV2List1PushSparseVector(buf.m_BUpper,buf.m_V1i,buf.m_V1r,nz1);
//--- Update the rest of the matrix
if(nz0*(nz1+buf.m_DTrail.m_NDense)>0)
{
//--- Update dense trail
//--- NOTE: this update MUST be performed before we update sparse trail,
//--- because sparse update may move columns to dense storage after
//--- update is performed on them. Thus, we have to avoid applying
//--- same update twice.
if(buf.m_DTrail.m_NDense>0)
{
tmpndense=buf.m_DTrail.m_NDense;
for(i=0; i<nz0; i++)
{
i0=buf.m_V0i[i];
v0=buf.m_V0r[i];
for(j=0; j<tmpndense; j++)
buf.m_DTrail.m_D.Set(i0,j,buf.m_DTrail.m_D.Get(i0,j)-v0*buf.m_DTrail.m_D.Get(k,j));
}
}
//--- Update sparse trail
SparseTrailUpdate(buf.m_STrail,buf.m_V0i,buf.m_V0r,nz0,buf.m_V1i,buf.m_V1r,nz1,buf.m_BUpper,buf.m_DTrail,DensificationSupported);
}
}
//--- Process densified trail
if(buf.m_DTrail.m_NDense>0)
{
tmpndense=buf.m_DTrail.m_NDense;
//--- Generate column pivots to bring actual order of columns in the
//--- working part of the matrix to one used for dense storage
for(i=n-tmpndense; i<n; i++)
{
k=buf.m_DTrail.m_Did[i-(n-tmpndense)];
jp=-1;
for(j=i; j<n; j++)
{
if(buf.m_STrail.m_ColId[j]==k)
{
jp=j;
break;
}
}
if(!CAp::Assert(jp>=0,__FUNCTION__+": integrity check failed during reordering"))
return(false);
buf.m_STrail.m_ColId.Swap(i,jp);
pc.Set(i,jp);
}
//--- Perform dense LU decomposition on dense trail
CApServ::RMatrixSetLengthAtLeast(buf.m_DBuf,buf.m_DTrail.m_NDense,buf.m_DTrail.m_NDense);
for(i=0; i<tmpndense; i++)
for(j=0; j<tmpndense; j++)
buf.m_DBuf.Set(i,j,buf.m_DTrail.m_D.Get(i+(n-tmpndense),j));
CApServ::RVectorSetLengthAtLeast(buf.m_Tmp0,2*n);
CApServ::IVectorSetLengthAtLeast(buf.m_TmpP,n);
CDLU::RMatrixPLURec(buf.m_DBuf,0,tmpndense,tmpndense,buf.m_TmpP,buf.m_Tmp0);
//--- Convert indexes of rows pivots, swap elements of BLeft
for(i=0; i<tmpndense; i++)
{
pr.Set(i+(n-tmpndense),buf.m_TmpP[i]+(n-tmpndense));
SLUV2List1Swap(buf.m_BLeft,i+(n-tmpndense),pr[i+(n-tmpndense)]);
buf.m_RowPermRawIdx.Swap(i+(n-tmpndense),pr[i+(n-tmpndense)]);
}
//--- Convert U-factor
CApServ::VectorGrowTo(buf.m_SparseUT.m_Idx,buf.m_SparseUT.m_RIdx[n-tmpndense]+n*tmpndense);
CApServ::VectorGrowTo(buf.m_SparseUT.m_Vals,buf.m_SparseUT.m_RIdx[n-tmpndense]+n*tmpndense);
for(j=0; j<tmpndense; j++)
{
Offs=buf.m_SparseUT.m_RIdx[j+(n-tmpndense)];
k=n-tmpndense;
//--- Convert leading N-NDense columns
for(i=0; i<k; i++)
{
v=buf.m_DTrail.m_D.Get(i,j);
if(v!=0)
{
buf.m_SparseUT.m_Idx.Set(Offs,i);
buf.m_SparseUT.m_Vals.Set(Offs,v);
Offs=Offs+1;
}
}
//--- Convert upper diagonal elements
for(i=0; i<j; i++)
{
v=buf.m_DBuf.Get(i,j);
if(v!=0)
{
buf.m_SparseUT.m_Idx.Set(Offs,i+(n-tmpndense));
buf.m_SparseUT.m_Vals.Set(Offs,v);
Offs=Offs+1;
}
}
//--- Convert diagonal element (always stored)
v=buf.m_DBuf.Get(j,j);
buf.m_SparseUT.m_Idx.Set(Offs,j+(n-tmpndense));
buf.m_SparseUT.m_Vals.Set(Offs,v);
Offs=Offs+1;
result=(result && v!=0);
//--- Column is done
buf.m_SparseUT.m_RIdx.Set(j+(n-tmpndense)+1,Offs);
}
//--- Convert L-factor
CApServ::VectorGrowTo(buf.m_SparseL.m_Idx,buf.m_SparseL.m_RIdx[n-tmpndense]+n*tmpndense);
CApServ::VectorGrowTo(buf.m_SparseL.m_Vals,buf.m_SparseL.m_RIdx[n-tmpndense]+n*tmpndense);
for(i=0; i<tmpndense; i++)
{
SLUV2List1AppendSequenceToMatrix(buf.m_BLeft,i+(n-tmpndense),false,0.0,n,buf.m_SparseL,i+(n-tmpndense));
Offs=buf.m_SparseL.m_RIdx[i+(n-tmpndense)+1];
for(j=0; j<=i-1; j++)
{
v=buf.m_DBuf.Get(i,j);
if(v!=0)
{
buf.m_SparseL.m_Idx.Set(Offs,j+(n-tmpndense));
buf.m_SparseL.m_Vals.Set(Offs,v);
Offs=Offs+1;
}
}
buf.m_SparseL.m_RIdx.Set(i+(n-tmpndense)+1,Offs);
}
}
//--- Allocate output
CApServ::IVectorSetLengthAtLeast(buf.m_TmpI,n);
for(i=0; i<n; i++)
buf.m_TmpI.Set(i,buf.m_SparseL.m_RIdx[i+1]-buf.m_SparseL.m_RIdx[i]);
for(i=0; i<n; i++)
{
i0=buf.m_SparseUT.m_RIdx[i];
i1=buf.m_SparseUT.m_RIdx[i+1]-1;
for(j=i0; j<=i1; j++)
{
k=buf.m_SparseUT.m_Idx[j];
buf.m_TmpI.Set(k,buf.m_TmpI[k]+1);
}
}
a.m_MatrixType=1;
a.m_NInitialized=buf.m_SparseL.m_RIdx[n]+buf.m_SparseUT.m_RIdx[n];
a.m_M=n;
a.m_N=n;
CApServ::IVectorSetLengthAtLeast(a.m_RIdx,n+1);
CApServ::IVectorSetLengthAtLeast(a.m_Idx,a.m_NInitialized);
CApServ::RVectorSetLengthAtLeast(a.m_Vals,a.m_NInitialized);
a.m_RIdx.Set(0,0);
for(i=0; i<n; i++)
a.m_RIdx.Set(i+1,a.m_RIdx[i]+buf.m_TmpI[i]);
for(i=0; i<n; i++)
{
i0=buf.m_SparseL.m_RIdx[i];
i1=buf.m_SparseL.m_RIdx[i+1]-1;
jp=a.m_RIdx[i];
for(j=i0; j<=i1; j++)
{
a.m_Idx.Set(jp+(j-i0),buf.m_SparseL.m_Idx[j]);
a.m_Vals.Set(jp+(j-i0),buf.m_SparseL.m_Vals[j]);
}
buf.m_TmpI.Set(i,buf.m_SparseL.m_RIdx[i+1]-buf.m_SparseL.m_RIdx[i]);
}
CApServ::IVectorSetLengthAtLeast(a.m_DIdx,n);
CApServ::IVectorSetLengthAtLeast(a.m_UIdx,n);
for(i=0; i<n; i++)
{
a.m_DIdx.Set(i,a.m_RIdx[i]+buf.m_TmpI[i]);
a.m_UIdx.Set(i,a.m_DIdx[i]+1);
buf.m_TmpI.Set(i,a.m_DIdx[i]);
}
for(i=0; i<n; i++)
{
i0=buf.m_SparseUT.m_RIdx[i];
i1=buf.m_SparseUT.m_RIdx[i+1]-1;
for(j=i0; j<=i1; j++)
{
k=buf.m_SparseUT.m_Idx[j];
Offs=buf.m_TmpI[k];
a.m_Idx.Set(Offs,i);
a.m_Vals.Set(Offs,buf.m_SparseUT.m_Vals[j]);
buf.m_TmpI.Set(k,Offs+1);
}
}
return(result);
}
//+------------------------------------------------------------------+
//| This function initialized rectangular submatrix structure. |
//| After initialization this structure stores matrix[N,0], which |
//| contains N rows (sequences), stored as single-linked lists. |
//+------------------------------------------------------------------+
void CSpTrf::SLUV2List1Init(int n,CSLUV2List1Matrix &a)
{
//--- check
if(!CAp::Assert(n>=1,__FUNCTION__+": N<1"))
return;
a.m_NFixed=n;
a.m_NDynamic=0;
a.m_NAllocated=n;
a.m_NUsed=0;
CApServ::VectorGrowTo(a.m_IdxFirst,n);
CApServ::VectorGrowTo(a.m_StrgIdx,2*a.m_NAllocated);
CApServ::VectorGrowTo(a.m_StrgVal,a.m_NAllocated);
a.m_IdxFirst.Fill(-1);
}
//+------------------------------------------------------------------+
//| This function swaps sequences #I and #J stored by the structure |
//+------------------------------------------------------------------+
void CSpTrf::SLUV2List1Swap(CSLUV2List1Matrix &a,int i,int j)
{
a.m_IdxFirst.Swap(i,j);
}
//+------------------------------------------------------------------+
//| This function drops sequence #I from the structure |
//+------------------------------------------------------------------+
void CSpTrf::SLUV2List1DropSequence(CSLUV2List1Matrix &a,int i)
{
a.m_IdxFirst.Set(i,-1);
}
//+------------------------------------------------------------------+
//| This function appends sequence from the structure to the sparse |
//| matrix. |
//| It is assumed that S is a lower triangular matrix, and A stores |
//| strictly lower triangular elements (no diagonal ones!). You can |
//| explicitly control whether you want to add diagonal elements or |
//| not. |
//| Output matrix is assumed to be stored in CRS format and to be |
//| partially initialized (up to, but not including, Dst-th row). |
//| DIdx and UIdx are NOT updated by this function as well as |
//| NInitialized. |
//| INPUT PARAMETERS: |
//| A - rectangular matrix structure |
//| Src - sequence (row or column) index in the structure |
//| HasDiagonal- whether we want to add diagonal element |
//| D - diagonal element, if HasDiagonal=True |
//| NZMAX - maximum estimated number of non-zeros in the row, |
//| this function will preallocate storage in the |
//| output matrix. |
//| S - destination matrix in CRS format, partially |
//| initialized |
//| Dst - destination row index |
//+------------------------------------------------------------------+
void CSpTrf::SLUV2List1AppendSequenceToMatrix(CSLUV2List1Matrix &a,
int src,
bool HasDiagonal,
double d,int nzmax,
CSparseMatrix &s,
int dst)
{
//--- create variables
int i0=s.m_RIdx[dst];
int i1=0;
int jp=0;
int nnz=0;
CApServ::VectorGrowTo(s.m_Idx,i0+nzmax);
CApServ::VectorGrowTo(s.m_Vals,i0+nzmax);
if(HasDiagonal)
{
i1=i0+nzmax-1;
s.m_Idx.Set(i1,dst);
s.m_Vals.Set(i1,d);
nnz=1;
}
else
{
i1=i0+nzmax;
nnz=0;
}
jp=a.m_IdxFirst[src];
while(jp>=0)
{
i1=i1-1;
s.m_Idx.Set(i1,a.m_StrgIdx[2*jp+1]);
s.m_Vals.Set(i1,a.m_StrgVal[jp]);
nnz=nnz+1;
jp=a.m_StrgIdx[2*jp+0];
}
for(int i=0; i<nnz; i++)
{
s.m_Idx.Set(i0+i,s.m_Idx[i1+i]);
s.m_Vals.Set(i0+i,s.m_Vals[i1+i]);
}
s.m_RIdx.Set(dst+1,s.m_RIdx[dst]+nnz);
}
//+------------------------------------------------------------------+
//| This function appends sparse column to the matrix, increasing its|
//| size from [N,K] to [N,K+1] |
//+------------------------------------------------------------------+
void CSpTrf::SLUV2List1PushSparseVector(CSLUV2List1Matrix &a,
CRowInt &si,
CRowDouble &sv,
int nz)
{
//--- create variables
int k=a.m_NDynamic;
int idx=0;
int i=0;
int nused=0;
double v=0;
//--- check
if(!CAp::Assert(k<a.m_NFixed))
return;
a.m_NDynamic=k+1;
//--- Allocate new storage if needed
nused=a.m_NUsed;
a.m_NAllocated=MathMax(a.m_NAllocated,nused+nz);
CApServ::VectorGrowTo(a.m_StrgIdx,2*a.m_NAllocated);
CApServ::VectorGrowTo(a.m_StrgVal,a.m_NAllocated);
//--- Append to list
for(idx=0; idx<nz; idx++)
{
i=si[idx];
v=sv[idx];
a.m_StrgIdx.Set(2*nused,a.m_IdxFirst[i]);
a.m_StrgIdx.Set(2*nused+1,k);
a.m_StrgVal.Set(nused,v);
a.m_IdxFirst.Set(i,nused);
nused++;
}
a.m_NUsed=nused;
}
//+------------------------------------------------------------------+
//| This function initializes dense trail, by default it is |
//| matrix[N,0] |
//+------------------------------------------------------------------+
void CSpTrf::DenseTrailInit(CSLUV2DenseTrail &d,int n)
{
//--- Note: excessive rows are allocated to accomodate for situation when
//--- this buffer is used to solve successive problems with increasing
//--- sizes.
int excessivesize=(int)MathMax(MathRound(1.333*n),n);
d.m_N=n;
d.m_NDense=0;
CApServ::IVectorSetLengthAtLeast(d.m_Did,n);
if(d.m_D.Rows()<=excessivesize)
CApServ::RMatrixSetLengthAtLeast(d.m_D,n,1);
else
d.m_D.Resize(excessivesize,1);
}
//+------------------------------------------------------------------+
//| This function appends column with id=ID to the dense trail |
//| (column IDs are integer numbers in [0,N) which can be used to |
//| track column permutations). |
//+------------------------------------------------------------------+
void CSpTrf::DenseTrailAppendColumn(CSLUV2DenseTrail &d,
CRowDouble &x,int id)
{
//--- create variables
int n=d.m_N;
int targetidx=d.m_NDense;
//--- Reallocate storage
CApServ::RMatrixGrowColsTo(d.m_D,d.m_NDense+1,n);
//--- Copy to dense storage:
//--- * BUpper
//--- * BTrail
//--- Remove from sparse storage
for(int i=0; i<n; i++)
{
d.m_D.Set(i,targetidx,x[i]);
}
d.m_Did.Set(targetidx,id);
d.m_NDense=targetidx+1;
}
//+------------------------------------------------------------------+
//| This function initializes sparse trail from the sparse matrix. |
//| By default, sparse trail spans columns and rows in [0,N) range. |
//| Subsequent pivoting out of rows/columns changes its range |
//| to [K,N), [K+1,N) and so on. |
//+------------------------------------------------------------------+
void CSpTrf::SparseTrailInit(CSparseMatrix &s,
CSLUV2SparseTrail &a)
{
//--- create variables
int n=s.m_N;
int i=0;
int j=0;
int j0=0;
int j1=0;
int jj=0;
int p=0;
int slsused=0;
//--- check
if(!CAp::Assert(s.m_M==s.m_N,__FUNCTION__+": M<>N"))
return;
//--- check
if(!CAp::Assert(s.m_MatrixType==1,__FUNCTION__+": non-CRS input"))
return;
//--- initialization
a.m_N=s.m_N;
a.m_K=0;
CApServ::IVectorSetLengthAtLeast(a.m_Nzc,n);
CApServ::IVectorSetLengthAtLeast(a.m_ColId,n);
CApServ::RVectorSetLengthAtLeast(a.m_Tmp0,n);
for(i=0; i<n; i++)
a.m_ColId.Set(i,i);
CApServ::BVectorSetLengthAtLeast(a.m_IsDensified,n);
ArrayFill(a.m_IsDensified,0,n,false);
//--- Working set of columns
a.m_MaxWrkCnt=CApServ::BoundVal((int)MathRound(1+(double)n/3.0),1,MathMin(n,50));
a.m_WrkCnt=0;
CApServ::IVectorSetLengthAtLeast(a.m_WrkSet,a.m_MaxWrkCnt);
//--- Sparse linked storage (SLS). Store CRS matrix to SLS format,
//--- row by row, starting from the last one.
CApServ::IVectorSetLengthAtLeast(a.m_SlsColPtr,n);
CApServ::IVectorSetLengthAtLeast(a.m_SlsRowPtr,n);
CApServ::IVectorSetLengthAtLeast(a.m_SlsIdx,s.m_RIdx[n]*m_SlsWidth);
CApServ::RVectorSetLengthAtLeast(a.m_SlsVal,s.m_RIdx[n]);
a.m_Nzc.Fill(0);
a.m_SlsColPtr.Fill(-1);
a.m_SlsRowPtr.Fill(-1);
slsused=0;
for(i=n-1; i>=0; i--)
{
j0=s.m_RIdx[i];
j1=s.m_RIdx[i+1]-1;
for(jj=j1; jj>=j0; jj--)
{
j=s.m_Idx[jj];
//--- Update non-zero counts for columns
a.m_Nzc.Set(j,a.m_Nzc[j]+1);
//--- Insert into column list
p=a.m_SlsColPtr[j];
if(p>=0)
a.m_SlsIdx.Set(p*m_SlsWidth,slsused);
a.m_SlsIdx.Set(slsused*m_SlsWidth,-1);
a.m_SlsIdx.Set(slsused*m_SlsWidth+1,p);
a.m_SlsColPtr.Set(j,slsused);
//--- Insert into row list
p=a.m_SlsRowPtr[i];
if(p>=0)
a.m_SlsIdx.Set(p*m_SlsWidth+2,slsused);
a.m_SlsIdx.Set(slsused*m_SlsWidth+2,-1);
a.m_SlsIdx.Set(slsused*m_SlsWidth+3,p);
a.m_SlsRowPtr.Set(i,slsused);
//--- Store index and value
a.m_SlsIdx.Set(slsused*m_SlsWidth+4,i);
a.m_SlsIdx.Set(slsused*m_SlsWidth+5,j);
a.m_SlsVal.Set(slsused,s.m_Vals[jj]);
slsused++;
}
}
a.m_SlsUsed=slsused;
}
//+------------------------------------------------------------------+
//| This function searches for a appropriate pivot column/row. |
//| If there exists non-densified column, it returns indexes of pivot|
//| column and row, with most sparse column selected for column |
//| pivoting, and largest element selected for row pivoting. Function|
//| result is True. |
//| PivotType=1 means that no column pivoting is performed |
//| PivotType=2 means that both column and row pivoting are |
//| supported |
//| If all columns were densified, False is returned. |
//+------------------------------------------------------------------+
bool CSpTrf::SparseTrailFindPivot(CSLUV2SparseTrail &a,
int pivottype,
int &ipiv,
int &jpiv)
{
//--- create variables
bool result=true;
int n=a.m_N;
int k=a.m_K;
int j=0;
int jp=0;
int entry=0;
int nz=0;
int maxwrknz=0;
int nnzbest=n+1;
double s=0;
double bbest=0;
int wrk0=0;
int wrk1=0;
jpiv=-1;
ipiv=-1;
//--- Select pivot column
if(pivottype==1)
{
//--- No column pivoting
//--- check
if(!CAp::Assert(!a.m_IsDensified[k],__FUNCTION__+": integrity check failed"))
return(false);
jpiv=k;
}
else
{
//--- Find pivot column
while(true)
{
//--- Scan working set (if non-empty) for good columns
maxwrknz=a.m_MaxWrkNz;
for(j=0; j<a.m_WrkCnt; j++)
{
jp=a.m_WrkSet[j];
if(jp<k)
continue;
if(a.m_IsDensified[jp])
continue;
nz=a.m_Nzc[jp];
if(nz>maxwrknz)
continue;
if(jpiv<0 || nz<nnzbest)
{
nnzbest=nz;
jpiv=jp;
}
}
if(jpiv>=0)
break;
//--- Well, nothing found. Recompute working set:
//--- * determine most sparse unprocessed yet column
//--- * gather all columns with density in [Wrk0,Wrk1) range,
//--- increase range, repeat, until working set is full
a.m_WrkCnt=0;
a.m_MaxWrkNz=0;
wrk0=n+1;
for(jp=k; jp<n; jp++)
if(!a.m_IsDensified[jp] && a.m_Nzc[jp]<wrk0)
wrk0=a.m_Nzc[jp];
if(wrk0>n)
//--- Only densified columns are present, exit.
return(false);
wrk1=wrk0+1;
while(a.m_WrkCnt<a.m_MaxWrkCnt && wrk0<=n)
{
//--- Find columns with non-zero count in [Wrk0,Wrk1) range
for(jp=k; jp<n; jp++)
{
if(a.m_WrkCnt==a.m_MaxWrkCnt)
break;
if(a.m_IsDensified[jp])
continue;
if(a.m_Nzc[jp]>=wrk0 && a.m_Nzc[jp]<wrk1)
{
a.m_WrkSet.Set(a.m_WrkCnt,jp);
a.m_WrkCnt++;
a.m_MaxWrkNz=MathMax(a.m_MaxWrkNz,a.m_Nzc[jp]);
}
}
//--- Advance scan range
jp=(int)MathRound(1.41*(wrk1-wrk0))+1;
wrk0=wrk1;
wrk1=wrk0+jp;
}
}
}
//--- Select pivot row
bbest=0;
entry=a.m_SlsColPtr[jpiv];
while(entry>=0)
{
s=MathAbs(a.m_SlsVal[entry]);
if(ipiv<0 || s>bbest)
{
bbest=s;
ipiv=a.m_SlsIdx[entry*m_SlsWidth+4];
}
entry=a.m_SlsIdx[entry*m_SlsWidth+1];
}
if(ipiv<0)
{
ipiv=k;
}
return(result);
}
//+------------------------------------------------------------------+
//| This function pivots out specified row and column. |
//| Sparse trail range changes from [K,N) to [K+1,N). |
//| V0I, V0R, V1I, V1R must be preallocated arrays[N]. |
//| Following data are returned: |
//| * UU - diagonal element (pivoted out), can be zero |
//| * V0I, V0R, NZ0 - sparse column pivoted out to the left (after |
//| permutation is applied to its elements) and |
//| divided by UU. |
//| V0I is array[NZ0] which stores row indexes in [K+1,N) range, V0R |
//| stores values. |
//| * V1I, V1R, NZ1 - sparse row pivoted out to the top. |
//+------------------------------------------------------------------+
void CSpTrf::SparseTrailPivotOut(CSLUV2SparseTrail &a,
int ipiv,
int jpiv,
double &uu,
CRowInt &v0i,
CRowDouble &v0r,
int &nz0,
CRowInt &v1i,
CRowDouble &v1r,
int &nz1)
{
//--- create variables
int n=a.m_N;
int k=a.m_K;
int i=0;
int j=0;
int entry=a.m_SlsColPtr[jpiv];
double v=0;
double s=0;
bool vb;
int pos0k=-1;
int pos0piv=-1;
int pprev=0;
int pnext=0;
int pnextnext=0;
uu=0;
nz0=0;
nz1=0;
//--- check
if(!CAp::Assert(k<n,__FUNCTION__+": integrity check failed"))
return;
//--- Pivot out column JPiv from the sparse linked storage:
//--- * remove column JPiv from the matrix
//--- * update column K:
//--- * change element indexes after it is permuted to JPiv
//--- * resort rows affected by move K->JPiv
//--- NOTE: this code leaves V0I/V0R/NZ0 in the unfinalized state,
//--- i.e. these arrays do not account for pivoting performed
//--- on rows. They will be post-processed later.
while(entry>=0)
{
//--- Offload element
i=a.m_SlsIdx[entry*m_SlsWidth+4];
v0i.Set(nz0,i);
v0r.Set(nz0,a.m_SlsVal[entry]);
if(i==k)
pos0k=nz0;
if(i==ipiv)
pos0piv=nz0;
nz0=nz0+1;
//--- Remove element from the row list
pprev=a.m_SlsIdx[entry*m_SlsWidth+2];
pnext=a.m_SlsIdx[entry*m_SlsWidth+3];
if(pprev>=0)
a.m_SlsIdx.Set(pprev*m_SlsWidth+3,pnext);
else
a.m_SlsRowPtr.Set(i,pnext);
if(pnext>=0)
a.m_SlsIdx.Set(pnext*m_SlsWidth+2,pprev);
//--- Select next entry
entry=a.m_SlsIdx[entry*m_SlsWidth+1];
}
entry=a.m_SlsColPtr[k];
a.m_SlsColPtr.Set(jpiv,entry);
while(entry>=0)
{
//--- Change column index
a.m_SlsIdx.Set(entry*m_SlsWidth+5,jpiv);
//--- Next entry
entry=a.m_SlsIdx[entry*m_SlsWidth+1];
}
//--- Post-process V0, account for pivoting.
//--- Compute diagonal element UU.
uu=0;
if(pos0k>=0 || pos0piv>=0)
{
//--- Apply permutation to rows of pivoted out column, specific
//--- implementation depends on the sparsity at locations #Pos0K
//--- and #Pos0Piv of the V0 array.
if(pos0k>=0 && pos0piv>=0)
{
//--- Obtain diagonal element
uu=v0r[pos0piv];
if(uu!=0)
s=1/uu;
else
s=1;
//--- Move pivoted out element, shift array by one in order
//--- to remove heading diagonal element (not needed here
//--- anymore).
v0r.Set(pos0piv,v0r[pos0k]);
for(i=0; i<nz0-1; i++)
{
v0i.Set(i,v0i[i+1]);
v0r.Set(i,v0r[i+1]*s);
}
nz0=nz0-1;
}
if(pos0k>=0 && pos0piv<0)
{
//--- Diagonal element is zero
uu=0;
//--- Pivot out element, reorder array
v0i.Set(pos0k,ipiv);
for(i=pos0k; i<nz0-1; i++)
{
if(v0i[i]<v0i[i+1])
break;
v0i.Swap(i,i+1);
v0r.Swap(i,i+1);
}
}
if(pos0k<0 && pos0piv>=0)
{
//--- Get diagonal element
uu=v0r[pos0piv];
if(uu!=0)
s=1/uu;
else
s=1;
//--- Shift array past the pivoted in element by one
//--- in order to remove pivot
CAblasF::RMulV(pos0piv,s,v0r);
for(i=pos0piv; i<nz0-1; i++)
{
v0i.Set(i,v0i[i+1]);
v0r.Set(i,v0r[i+1]*s);
}
nz0=nz0-1;
}
}
//--- Pivot out row IPiv from the sparse linked storage:
//--- * remove row IPiv from the matrix
//--- * reindex elements of row K after it is permuted to IPiv
//--- * apply permutation to the cols of the pivoted out row,
//--- resort columns
nz1=0;
entry=a.m_SlsRowPtr[ipiv];
while(entry>=0)
{
//--- Offload element
j=a.m_SlsIdx[entry*m_SlsWidth+5];
v1i.Set(nz1,j);
v1r.Set(nz1,a.m_SlsVal[entry]);
nz1=nz1+1;
//--- Remove element from the column list
pprev=a.m_SlsIdx[entry*m_SlsWidth+0];
pnext=a.m_SlsIdx[entry*m_SlsWidth+1];
if(pprev>=0)
a.m_SlsIdx.Set(pprev*m_SlsWidth+1,pnext);
else
a.m_SlsColPtr.Set(j,pnext);
if(pnext>=0)
a.m_SlsIdx.Set(pnext*m_SlsWidth,pprev);
//--- Select next entry
entry=a.m_SlsIdx[entry*m_SlsWidth+3];
}
a.m_SlsRowPtr.Set(ipiv,a.m_SlsRowPtr[k]);
entry=a.m_SlsRowPtr[ipiv];
while(entry>=0)
{
//--- Change row index
a.m_SlsIdx.Set(entry*m_SlsWidth+4,ipiv);
//--- Resort column affected by row pivoting
j=a.m_SlsIdx[entry*m_SlsWidth+5];
pprev=a.m_SlsIdx[entry*m_SlsWidth+0];
pnext=a.m_SlsIdx[entry*m_SlsWidth+1];
while(pnext>=0 && a.m_SlsIdx[pnext*m_SlsWidth+4]<ipiv)
{
pnextnext=a.m_SlsIdx[pnext*m_SlsWidth+1];
//--- prev->next
if(pprev>=0)
a.m_SlsIdx.Set(pprev*m_SlsWidth+1,pnext);
else
a.m_SlsColPtr.Set(j,pnext);
//--- entry->prev, entry->next
a.m_SlsIdx.Set(entry*m_SlsWidth,pnext);
a.m_SlsIdx.Set(entry*m_SlsWidth+1,pnextnext);
//--- next->prev, next->next
a.m_SlsIdx.Set(pnext*m_SlsWidth,pprev);
a.m_SlsIdx.Set(pnext*m_SlsWidth+1,entry);
//--- nextnext->prev
if(pnextnext>=0)
a.m_SlsIdx.Set(pnextnext*m_SlsWidth,entry);
//--- PPrev, Item, PNext
pprev=pnext;
pnext=pnextnext;
}
//--- Next entry
entry=a.m_SlsIdx[entry*m_SlsWidth+3];
}
//--- Reorder other structures
a.m_Nzc.Swap(k,jpiv);
a.m_ColId.Swap(k,jpiv);
vb=a.m_IsDensified[k];
a.m_IsDensified[k]=a.m_IsDensified[jpiv];
a.m_IsDensified[jpiv]=vb;
//--- Handle removal of col/row #K
for(i=0; i<nz1; i++)
{
j=v1i[i];
a.m_Nzc.Set(j,a.m_Nzc[j]-1);
}
a.m_K++;
}
//+------------------------------------------------------------------+
//| This function densifies I1-th column of the sparse trail. |
//| PARAMETERS: |
//| A - sparse trail |
//| I1 - column index |
//| BUpper - upper rectangular submatrix, updated during |
//| densification of the columns (densified columns are|
//| removed) |
//| DTrail - dense trail, receives densified columns from sparse|
//| trail and BUpper |
//+------------------------------------------------------------------+
void CSpTrf::SparseTrailDensify(CSLUV2SparseTrail &a,
int i1,
CSLUV2List1Matrix &BUpper,
CSLUV2DenseTrail &DTrail)
{
//--- create variables
int n=a.m_N;
int k=a.m_K;
int i=0;
int jp=0;
int entry=0;
int pprev=0;
int pnext=0;
//--- check
if(!CAp::Assert(k<n,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(k<=i1,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(!a.m_IsDensified[i1],__FUNCTION__+": integrity check failed"))
return;
//--- Offload items [0,K) of densified column from BUpper
a.m_Tmp0.Fill(0);
jp=BUpper.m_IdxFirst[i1];
while(jp>=0)
{
a.m_Tmp0.Set(BUpper.m_StrgIdx[2*jp+1],BUpper.m_StrgVal[jp]);
jp=BUpper.m_StrgIdx[2*jp+0];
}
SLUV2List1DropSequence(BUpper,i1);
//--- Offload items [K,N) of densified column from BLeft
entry=a.m_SlsColPtr[i1];
while(entry>=0)
{
//--- Offload element
i=a.m_SlsIdx[entry*m_SlsWidth+4];
a.m_Tmp0.Set(i,a.m_SlsVal[entry]);
//--- Remove element from the row list
pprev=a.m_SlsIdx[entry*m_SlsWidth+2];
pnext=a.m_SlsIdx[entry*m_SlsWidth+3];
if(pprev>=0)
a.m_SlsIdx.Set(pprev*m_SlsWidth+3,pnext);
else
a.m_SlsRowPtr.Set(i,pnext);
if(pnext>=0)
a.m_SlsIdx.Set(pnext*m_SlsWidth+2,pprev);
//--- Select next entry
entry=a.m_SlsIdx[entry*m_SlsWidth+1];
}
//--- Densify
a.m_Nzc.Set(i1,0);
a.m_IsDensified[i1]=true;
a.m_SlsColPtr.Set(i1,-1);
DenseTrailAppendColumn(DTrail,a.m_Tmp0,a.m_ColId[i1]);
}
//+------------------------------------------------------------------+
//| This function appends rank-1 update to the sparse trail. Dense |
//| trail is not updated here, but we may move some columns to dense |
//| trail during update (i.e. densify them). Thus, you have to update|
//| dense trail BEFORE you start updating sparse one (otherwise, |
//| recently densified columns will be updated twice). |
//| PARAMETERS: |
//| A - sparse trail |
//| V0I, V0R - update column returned by SparseTrailPivotOut (MUST|
//| be array[N] independently of the NZ0). |
//| NZ0 - non-zero count for update column |
//| V1I, V1R - update row returned by SparseTrailPivotOut |
//| NZ1 - non-zero count for update row |
//| BUpper - upper rectangular submatrix, updated during |
//| densification of the columns (densified columns are|
//| removed) |
//| DTrail - dense trail, receives densified columns from sparse|
//| trail and BUpper |
//| DensificationSupported- if False, no densification is performed|
//+------------------------------------------------------------------+
void CSpTrf::SparseTrailUpdate(CSLUV2SparseTrail &a,
CRowInt &v0i,
CRowDouble &v0r,
int nz0,
CRowInt &v1i,
CRowDouble &v1r,
int nz1,
CSLUV2List1Matrix &BUpper,
CSLUV2DenseTrail &DTrail,
bool DensificationSupported)
{
//--- create variables
int n=a.m_N;
int k=a.m_K;
int i=0;
int j=0;
int i0=0;
int i1=0;
double v1=0;
int densifyabove=(int)MathRound(m_DenseBnd*(n-k))+1;
int nnz=0;
int entry=0;
int newentry=0;
int pprev=0;
int pnext=0;
int p=0;
int nexti=0;
int newoffs=0;
//--- check
if(!CAp::Assert(k<n,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(CAp::Len(v0i)>=nz0+1,__FUNCTION__+": integrity check failed"))
return;
//--- check
if(!CAp::Assert(CAp::Len(v0r)>=nz0+1,__FUNCTION__+": integrity check failed"))
return;
v0i.Set(nz0,-1);
v0r.Set(nz0,0);
//--- Update sparse representation
CApServ::VectorGrowTo(a.m_SlsIdx,(a.m_SlsUsed+nz0*nz1)*m_SlsWidth);
CApServ::VectorGrowTo(a.m_SlsVal,a.m_SlsUsed+nz0*nz1);
for(j=0; j<nz1; j++)
{
if(nz0==0)
continue;
i1=v1i[j];
v1=v1r[j];
//--- Update column #I1
nnz=a.m_Nzc[i1];
i=0;
i0=v0i[i];
entry=a.m_SlsColPtr[i1];
pprev=-1;
while(i<nz0)
{
//--- Handle possible fill-in happening BEFORE already existing
//--- entry of the column list (or simply fill-in, if no entry
//--- is present).
pnext=entry;
if(entry>=0)
nexti=a.m_SlsIdx[entry*m_SlsWidth+4];
else
nexti=n+1;
while(i<nz0)
{
if(i0>=nexti)
break;
//--- Allocate new entry, store column/row/value
newentry=a.m_SlsUsed;
a.m_SlsUsed=newentry+1;
nnz=nnz+1;
newoffs=newentry*m_SlsWidth;
a.m_SlsIdx.Set(newoffs+4,i0);
a.m_SlsIdx.Set(newoffs+5,i1);
a.m_SlsVal.Set(newentry,-(v1*v0r[i]));
//--- Insert entry into column list
a.m_SlsIdx.Set(newoffs,pprev);
a.m_SlsIdx.Set(newoffs+1,pnext);
if(pprev>=0)
a.m_SlsIdx.Set(pprev*m_SlsWidth+1,newentry);
else
a.m_SlsColPtr.Set(i1,newentry);
if(entry>=0)
a.m_SlsIdx.Set(entry*m_SlsWidth,newentry);
//--- Insert entry into row list
p=a.m_SlsRowPtr[i0];
a.m_SlsIdx.Set(newoffs+2,-1);
a.m_SlsIdx.Set(newoffs+3,p);
if(p>=0)
a.m_SlsIdx.Set(p*m_SlsWidth+2,newentry);
a.m_SlsRowPtr.Set(i0,newentry);
//--- Advance pointers
pprev=newentry;
i=i+1;
i0=v0i[i];
}
if(i>=nz0)
break;
//--- Update already existing entry of the column list, if needed
if(entry>=0)
{
if(i0==nexti)
{
a.m_SlsVal.Set(entry,a.m_SlsVal[entry]-v1*v0r[i]);
i=i+1;
i0=v0i[i];
}
pprev=entry;
}
//--- Advance to the next pre-existing entry (if present)
if(entry>=0)
entry=a.m_SlsIdx[entry*m_SlsWidth+1];
}
a.m_Nzc.Set(i1,nnz);
//--- Densify column if needed
if((DensificationSupported && nnz>densifyabove) && !a.m_IsDensified[i1])
SparseTrailDensify(a,i1,BUpper,DTrail);
}
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
class CAmdOrdering
{
public:
static const int m_KNsHeaderSize;
static const int m_LLMentrySize;
static void GenerateAmdPermutation(CSparseMatrix &A,int n,CRowInt &Perm,CRowInt &InvPerm,CAmdBuffer &Buf);
static int GenerateAmdPermutationX(CSparseMatrix &A,bool &Eligible[],int n,CRowInt &Perm,CRowInt &InvPerm,int AmdType,CAmdBuffer &Buf);
private:
static void NsInitEmptySlow(int n,CAmdNSet &SA);
static void NsCopy(CAmdNSet &SSrc,CAmdNSet &SDst);
static void NsAddElement(CAmdNSet &SA,int k);
static void NsAddKth(CAmdNSet &SA,CAmdKNSet &Src,int k);
static void NsSubtract1(CAmdNSet &SA,CAmdNSet &Src);
static void NsSubtractKth(CAmdNSet &SA,CAmdKNSet &Src,int k);
static void NsClear(CAmdNSet &SA);
static int NsCount(CAmdNSet &SA);
static int NsCountNotKth(CAmdNSet &SA,CAmdKNSet &Src,int k);
static int NsCountAndKth(CAmdNSet &SA,CAmdKNSet &Src,int k);
static bool NsEqual(CAmdNSet &S0,CAmdNSet &S1);
static void NsStartEnumeration(CAmdNSet &SA);
static bool NsEnumerate(CAmdNSet &SA,int &J);
static void KNsCompressStorage(CAmdKNSet &SA);
static void KNsRealLocate(CAmdKNSet &SA,int setidx,int NewAllocated);
static void KNsInit(int k,int n,int kPrealloc,CAmdKNSet &SA);
static void KNsInitFromA(CSparseMatrix &A,int n,CAmdKNSet &SA);
static void KNsStartEnumeration(CAmdKNSet &SA,int i);
static bool KNsEnumerate(CAmdKNSet &SA,int &J);
static void KNsDirectAccess(CAmdKNSet &SA,int k,int &idxbegin,int &idxend);
static void KNsAddNewElement(CAmdKNSet &SA,int i,int k);
static void KNsSubtract1(CAmdKNSet &SA,int i,CAmdNSet &Src);
static void KNsAddKthDistinct(CAmdKNSet &SA,int i,CAmdKNSet &Src,int k);
static int KNsCountKth(CAmdKNSet &S0,int k);
static int KNsCountNot(CAmdKNSet &S0,int i,CAmdNSet &S1);
static int KNsCountNotKth(CAmdKNSet &S0,int i,CAmdKNSet &S1,int k);
static int KNsCountAndKth(CAmdKNSet &S0,int i,CAmdKNSet &S1,int k);
static int KNsSumKth(CAmdKNSet &s0,int i);
static void KNsClearKthNoReclaim(CAmdKNSet &SA,int k);
static void KNsClearKthReclaim(CAmdKNSet &SA,int k);
static void MtxInit(int n,CAmdLLMatrix &A);
static void MtxAddColumnTo(CAmdLLMatrix &A,int j,CAmdNSet &S);
static void MtxInsertNewElement(CAmdLLMatrix &A,int i,int j);
static int MtxCountColumnNot(CAmdLLMatrix &A,int j,CAmdNSet &S);
static int MtxCountColumn(CAmdLLMatrix &A,int j);
static void MtxClearX(CAmdLLMatrix &A,int k,bool IsCol);
static void MtxClearColumn(CAmdLLMatrix &A,int j);
static void MtxClearRow(CAmdLLMatrix &A,int j);
static void VtxInit(CSparseMatrix &A,int n,bool CheckExactDegrees,CAmdVertexSet &S);
static void VtxRemoveVertex(CAmdVertexSet &S,int p);
static int VtxGetApprox(CAmdVertexSet &S,int p);
static int VtxGetExact(CAmdVertexSet &S,int p);
static int VtxGetApproxMinDegree(CAmdVertexSet &S);
static void VtxUpdateApproximateDegree(CAmdVertexSet &S,int p,int DNew);
static void VtxUpdateExactDegree(CAmdVertexSet &S,int p,int d);
static void AmdSelectPivotElement(CAmdBuffer &Buf,int k,int &p,int &nodesize);
static void AmdComputeLp(CAmdBuffer &Buf,int p);
static void AmdMasselimination(CAmdBuffer &Buf,int p,int k,int tau);
static void AmdDetectSuperNodes(CAmdBuffer &Buf);
static void AmdMoveToQuasiDense(CAmdBuffer &Buf,CAmdNSet &Cand,int p);
};
//+------------------------------------------------------------------+
//| Constants |
//+------------------------------------------------------------------+
const int CAmdOrdering::m_KNsHeaderSize=2;
const int CAmdOrdering::m_LLMentrySize=6;
//+------------------------------------------------------------------+
//| This function generates approximate minimum degree ordering |
//| INPUT PARAMETERS: |
//| A - lower triangular sparse matrix in CRS format. Only |
//| sparsity structure (as given by Idx[] field) |
//| matters, specific values of matrix elements are |
//| ignored. |
//| N - problem size |
//| Buf - reusable buffer object, does not need special |
//| initialization |
//| OUTPUT PARAMETERS: |
//| Perm - array[N], maps original indexes I to permuted |
//| indexes |
//| InvPerm - array[N], maps permuted indexes I to original |
//| indexes |
//| NOTE: definite 'DEBUG.SLOW' Trace tag will activate extra-slow |
//| (roughly N^3 ops) integrity checks, in addition to cheap |
//| O(1) ones. |
//+------------------------------------------------------------------+
void CAmdOrdering::GenerateAmdPermutation(CSparseMatrix &a,
int n,CRowInt &perm,
CRowInt &invperm,
CAmdBuffer &buf)
{
bool dummy[];
int r=GenerateAmdPermutationX(a,dummy,n,perm,invperm,0,buf);
//--- check
CAp::Assert(r==n,__FUNCTION__+": integrity check failed,the matrix is only partially processed");
}
//+------------------------------------------------------------------+
//| This function generates approximate minimum degree ordering, |
//| either classic or improved with better support for dense rows: |
//| * the classic version processed entire matrix and returns N as |
//| result. The problem with classic version is that it may be |
//| slow for matrices with dense or nearly dense rows |
//| * the improved version processes K most sparse rows, and moves |
//| other N-K ones to the end. The number of sparse rows K is |
//| returned. The Tail, which is now a (N-K)*(N-K) matrix, should|
//| be repeatedly processed by the same function until zero is |
//| returned. |
//| INPUT PARAMETERS: |
//| A - lower triangular sparse matrix in CRS format |
//| Eligible - array[N], set of boolean flags that mark columns of|
//| A as eligible for ordering. Columns that are not |
//| eligible are postponed (moved to the end) by the |
//| improved AMD algorithm. This array is ignored (not |
//| referenced at all) when AMDType=0. |
//| N - problem size |
//| AMDType - ordering type: |
//| * 0 for the classic AMD |
//| * 1 for the improved AMD |
//| Buf - reusable buffer object, does not need special |
//| initialization |
//| OUTPUT PARAMETERS: |
//| Perm - array[N], maps original indexes I to permuted |
//| indexes |
//| InvPerm - array[N], maps permuted indexes I to original |
//| indexes |
//| RESULT: |
//| number of successfully ordered rows/cols; |
//| for AMDType=0: Result=N |
//| for AMDType=1: 0<=Result<=N. Result=0 is returned only when |
//| there are no columns that are both sparse |
//| enough and eligible. |
//| NOTE: defining 'DEBUG.SLOW' Trace tag will activate extra-slow |
//| (roughly N^3 ops) integrity checks, in addition to cheap |
//| O(1) ones. |
//+------------------------------------------------------------------+
int CAmdOrdering::GenerateAmdPermutationX(CSparseMatrix &a,
bool &eligible[],
int n,CRowInt &perm,
CRowInt &invperm,
int amdtype,
CAmdBuffer &buf)
{
//--- create variables
int setprealloc=3;
int inithashbucketsize=16;
int extendeddebug=CAp::IsTraceEnabled("DEBUG.SLOW") && n <= 100;
int result=n;
int i=0;
int j=0;
int k=0;
int p=0;
int nodesize=0;
int cnt0=0;
int cnt1=0;
int tau=0;
double meand=0;
int d=0;
//--- check
if(!CAp::Assert(amdtype==0 || amdtype==1,__FUNCTION__+": unexpected ordering type"))
return(-1);;
//--- initialization
buf.m_N=n;
buf.m_CheckExactDegrees=extendeddebug;
buf.m_ExtendedDebug=extendeddebug;
MtxInit(n,buf.m_MtxL);
KNsInitFromA(a,n,buf.m_SetA);
KNsInit(n,n,setprealloc,buf.m_SetSuper);
for(i=0; i<n ; i++)
KNsAddNewElement(buf.m_SetSuper,i,i);
KNsInit(n,n,setprealloc,buf.m_SetE);
KNsInit(n,n,inithashbucketsize,buf.m_HashBuckets);
NsInitEmptySlow(n,buf.m_NonEmptyBuckets);
CApServ::IVectorSetLengthAtLeast(buf.m_Perm,n);
CApServ::IVectorSetLengthAtLeast(buf.m_InvPerm,n);
CApServ::IVectorSetLengthAtLeast(buf.m_ColumnSwaps,n);
for(i=0; i<n; i++)
{
buf.m_Perm.Set(i,i);
buf.m_InvPerm.Set(i,i);
buf.m_ColumnSwaps.Set(i,i);
}
VtxInit(a,n,buf.m_CheckExactDegrees,buf.m_VertexDegrees);
CAblasF::BSetAllocV(n,true,buf.m_IsSuperNode);
CAblasF::BSetAllocV(n,false,buf.m_IsEliminated);
CAblasF::ISetAllocV(n,-1,buf.m_Arrwe);
CAblasF::IAllocV(n,buf.m_Ls);
NsInitEmptySlow(n,buf.m_SetP);
NsInitEmptySlow(n,buf.m_Lp);
NsInitEmptySlow(n,buf.m_SetRP);
NsInitEmptySlow(n,buf.m_Ep);
NsInitEmptySlow(n,buf.m_ExactDegreeTmp0);
NsInitEmptySlow(n,buf.m_AdjI);
NsInitEmptySlow(n,buf.m_AdjJ);
NsInitEmptySlow(n,buf.m_SetQ);
NsInitEmptySlow(n,buf.m_SetQSuperCand);
if(extendeddebug)
{
buf.m_Dbga=matrix<double>::Identity(n,n);
for(i=0; i<n; i++)
{
for(j=0; j<n; j++)
{
if((j<i && CSparse::SparseExists(a,i,j)) || (j>=i && CSparse::SparseExists(a,j,i)))
buf.m_Dbga.Set(i,j,(0.1/n*(MathSin(i+0.17)+MathCos(MathSqrt(j+0.65)))));
else
break;
}
}
}
tau=0;
if(amdtype==1)
{
//--- check
if(!CAp::Assert(CAp::Len(eligible)>=n,__FUNCTION__+": length(Eligible)<N"))
return(-1);
meand=0.0;
for(i=0; i<n; i++)
{
d=VtxGetApprox(buf.m_VertexDegrees,i);
meand=meand+d;
}
meand=meand/n;
tau=(int)MathRound(10*meand)+2;
for(i=0; i<n; i++)
if(!eligible[i] || VtxGetApprox(buf.m_VertexDegrees,i)>tau)
NsAddElement(buf.m_SetQSuperCand,i);
AmdMoveToQuasiDense(buf,buf.m_SetQSuperCand,-1);
}
k=0;
while(k<n-NsCount(buf.m_SetQ))
{
AmdSelectPivotElement(buf,k,p,nodesize);
AmdComputeLp(buf,p);
AmdMasselimination(buf,p,k,tau);
AmdMoveToQuasiDense(buf,buf.m_SetQSuperCand,p);
AmdDetectSuperNodes(buf);
if(extendeddebug)
{
//--- check
if(!CAp::Assert(buf.m_CheckExactDegrees,__FUNCTION__+": extended debug needs exact degrees"))
return(-1);
for(i=k; i<(k+nodesize); i++)
{
if(buf.m_ColumnSwaps[i]!=i)
{
CApServ::SwapRows(buf.m_Dbga,i,buf.m_ColumnSwaps[i],n);
CApServ::SwapCols(buf.m_Dbga,i,buf.m_ColumnSwaps[i],n);
}
}
for(i=0; i<nodesize; i++)
CAblas::RMatrixGemm(n-k-i,n-k-i,k+i,-1.0,buf.m_Dbga,k+i,0,0,
buf.m_Dbga,0,k+i,0,1.0,
buf.m_Dbga,k+i,k+i);
cnt0=NsCount(buf.m_Lp);
cnt1=0;
for(i=k+1; i<n; i++)
{
if(buf.m_Dbga.Get(i,k)!=0.0)
cnt1++;
}
//--- check
if(!CAp::Assert(cnt0+nodesize-1==cnt1,__FUNCTION__+": integrity check 7344 failed"))
return(-1);
//--- check
if(!CAp::Assert(VtxGetApprox(buf.m_VertexDegrees,p)>=VtxGetExact(buf.m_VertexDegrees,p),__FUNCTION__+": integrity check for ApproxD failed"))
return(-1);
//--- check
if(!CAp::Assert(VtxGetExact(buf.m_VertexDegrees,p)==cnt0,__FUNCTION__+": integrity check for ExactD failed"))
return(-1);
}
//--- check
if(!CAp::Assert(VtxGetApprox(buf.m_VertexDegrees,p)>=NsCount(buf.m_Lp),__FUNCTION__+": integrity check 7956 failed"))
return(-1);
//--- check
if(!CAp::Assert((KNsCountKth(buf.m_SetE,p)>2 || NsCount(buf.m_SetQ)>0) ||
VtxGetApprox(buf.m_VertexDegrees,p)==NsCount(buf.m_Lp),__FUNCTION__+": integrity check 7295 failed"))
return(-1);
KNsStartEnumeration(buf.m_SetE,p);
while(KNsEnumerate(buf.m_SetE,j))
MtxClearColumn(buf.m_MtxL,j);
KNsStartEnumeration(buf.m_SetSuper,p);
while(KNsEnumerate(buf.m_SetSuper,j))
{
buf.m_IsEliminated[j]=true;
MtxClearRow(buf.m_MtxL,j);
}
KNsClearKthReclaim(buf.m_SetA,p);
KNsClearKthReclaim(buf.m_SetE,p);
buf.m_IsSuperNode[p]=false;
VtxRemoveVertex(buf.m_VertexDegrees,p);
k=k+nodesize;
}
//--- check
if(!CAp::Assert(k+NsCount(buf.m_SetQ)==n,__FUNCTION__+": integrity check 6326 failed"))
return(-1);
//--- check
if(!CAp::Assert(k>0 || amdtype==1,__FUNCTION__+": integrity check 9463 failed"))
return(-1);
result=k;
CApServ::IVectorSetLengthAtLeast(perm,n);
CApServ::IVectorSetLengthAtLeast(invperm,n);
for(i=0; i<n; i++)
{
perm.Set(i,buf.m_Perm[i]);
invperm.Set(i,buf.m_InvPerm[i]);
}
return(result);
}
//+------------------------------------------------------------------+
//| Initializes n-set by empty structure. |
//| IMPORTANT: this function need O(N) time for initialization. It is|
//| recommended to reduce its usage as much as possible, |
//| and use nsClear() where possible. |
//| INPUT PARAMETERS: |
//| N - possible set size |
//| OUTPUT PARAMETERS: |
//| SA - empty N-set |
//+------------------------------------------------------------------+
void CAmdOrdering::NsInitEmptySlow(int n,CAmdNSet &sa)
{
sa.m_N=n;
sa.m_NStored=0;
CAblasF::ISetAllocV(n,-999999999,sa.m_LocationOf);
CAblasF::ISetAllocV(n,-999999999,sa.m_Items);
}
//+------------------------------------------------------------------+
//| Copies n-set to properly initialized target set. The target set |
//| has to be properly initialized, and it can be non-empty. If it is|
//| non-empty, its contents is quickly erased before copying. |
//| The cost of this function is O(max(SrcSize,DstSize)) |
//| INPUT PARAMETERS: |
//| SSrc - source N-set |
//| SDst - destination N-set (has same size as SSrc) |
//| OUTPUT PARAMETERS: |
//| SDst - copy of SSrc |
//+------------------------------------------------------------------+
void CAmdOrdering::NsCopy(CAmdNSet &SSrc,CAmdNSet &SDst)
{
SDst=SSrc;
}
//+------------------------------------------------------------------+
//| Add K-th element to the set. The element may already exist in the|
//| set. |
//| INPUT PARAMETERS: |
//| SA - set |
//| K - element to add, 0<=K<N. |
//| OUTPUT PARAMETERS: |
//| SA - modified SA |
//+------------------------------------------------------------------+
void CAmdOrdering::NsAddElement(CAmdNSet &sa,int k)
{
if(sa.m_LocationOf[k]>=0)
return;
int ns=sa.m_NStored;
sa.m_LocationOf.Set(k,ns);
sa.m_Items.Set(ns,k);
sa.m_NStored=ns+1;
}
//+------------------------------------------------------------------+
//| Add K-th set from the source kn-set |
//| INPUT PARAMETERS: |
//| SA - set |
//| Src, K - source kn-set and set index K |
//| OUTPUT PARAMETERS: |
//| SA - modified SA |
//+------------------------------------------------------------------+
void CAmdOrdering::NsAddKth(CAmdNSet &SA,CAmdKNSet &Src,int k)
{
int idxbegin=Src.m_VBegin[k];
int idxend=idxbegin+Src.m_VCnt[k];
int ns=SA.m_NStored;
int j=0;
while(idxbegin<idxend)
{
j=Src.m_Data[idxbegin];
if(SA.m_LocationOf[j]<0)
{
SA.m_LocationOf.Set(j,ns);
SA.m_Items.Set(ns,j);
ns=ns+1;
}
idxbegin=idxbegin+1;
}
SA.m_NStored=ns;
}
//+------------------------------------------------------------------+
//| Subtracts K-th set from the source structure |
//| INPUT PARAMETERS: |
//| SA - set |
//| Src, K - source kn-set and set index K |
//| OUTPUT PARAMETERS: |
//| SA - modified SA |
//+------------------------------------------------------------------+
void CAmdOrdering::NsSubtract1(CAmdNSet &SA,CAmdNSet &Src)
{
//--- create variables
int i=0;
int j=0;
int loc=0;
int item=0;
int ns=SA.m_NStored;
int ss=Src.m_NStored;
if(ss<ns)
{
for(i=0; i<ss; i++)
{
j=Src.m_Items[i];
loc=SA.m_LocationOf[j];
if(loc>=0)
{
item=SA.m_Items[ns-1];
SA.m_Items.Set(loc,item);
SA.m_LocationOf.Set(item,loc);
SA.m_LocationOf.Set(j,-1);
ns=ns-1;
}
}
}
else
{
i=0;
while(i<ns)
{
j=SA.m_Items[i];
loc=Src.m_LocationOf[j];
if(loc>=0)
{
item=SA.m_Items[ns-1];
SA.m_Items.Set(i,item);
SA.m_LocationOf.Set(item,i);
SA.m_LocationOf.Set(j,-1);
ns=ns-1;
}
else
{
i=i+1;
}
}
}
SA.m_NStored=ns;
}
//+------------------------------------------------------------------+
//| Subtracts K-th set from the source structure |
//| INPUT PARAMETERS: |
//| SA - set |
//| Src, K - source kn-set and set index K |
//| OUTPUT PARAMETERS: |
//| SA - modified SA |
//+------------------------------------------------------------------+
void CAmdOrdering::NsSubtractKth(CAmdNSet &SA,CAmdKNSet &Src,
int k)
{
//--- create variables
int idxbegin=Src.m_VBegin[k];
int idxend=idxbegin+Src.m_VCnt[k];
int j=0;
int loc=0;
int ns=SA.m_NStored;
int item=0;
while(idxbegin<idxend)
{
j=Src.m_Data[idxbegin];
loc=SA.m_LocationOf[j];
if(loc>=0)
{
item=SA.m_Items[ns-1];
SA.m_Items.Set(loc,item);
SA.m_LocationOf.Set(item,loc);
SA.m_LocationOf.Set(j,-1);
ns=ns-1;
}
idxbegin=idxbegin+1;
}
SA.m_NStored=ns;
}
//+------------------------------------------------------------------+
//| Clears set |
//| INPUT PARAMETERS: |
//| SA - set to be cleared |
//+------------------------------------------------------------------+
void CAmdOrdering::NsClear(CAmdNSet &SA)
{
SA.m_LocationOf.Fill(-1);
SA.m_NStored=0;
}
//+------------------------------------------------------------------+
//| Counts set elements |
//| INPUT PARAMETERS: |
//| SA - set |
//| RESULT: |
//| number of elements in SA |
//+------------------------------------------------------------------+
int CAmdOrdering::NsCount(CAmdNSet &SA)
{
return(SA.m_NStored);
}
//+------------------------------------------------------------------+
//| Counts set elements not present in the K-th set of the source |
//| structure |
//| INPUT PARAMETERS: |
//| SA - set |
//| Src, K - source kn-set and set index K |
//| RESULT: |
//| number of elements in SA not present in Src[K] |
//+------------------------------------------------------------------+
int CAmdOrdering::NsCountNotKth(CAmdNSet &SA,CAmdKNSet &Src,
int k)
{
//--- create variables
int result=0;
int idxbegin=Src.m_VBegin[k];
int idxend=idxbegin+Src.m_VCnt[k];
int intersectcnt=0;
//--- main loop
for(int i=idxbegin; i<idxend; i++)
{
if(SA.m_LocationOf[Src.m_Data[i]]>=0)
intersectcnt++;
}
result=SA.m_NStored-intersectcnt;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Counts set elements also present in the K-th set of the source |
//| structure |
//| INPUT PARAMETERS: |
//| SA - set |
//| Src, K - source kn-set and set index K |
//| RESULT: |
//| number of elements in SA also present in Src[K] |
//+------------------------------------------------------------------+
int CAmdOrdering::NsCountAndKth(CAmdNSet &SA,CAmdKNSet &Src,
int k)
{
//--- create variables
int result=0;
int idxbegin=Src.m_VBegin[k];
int idxend=idxbegin+Src.m_VCnt[k];
//--- main loop
for(int i=idxbegin; i<idxend; i++)
if(SA.m_LocationOf[Src.m_Data[i]]>=0)
result++;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Compare two sets, returns True for equal sets |
//| INPUT PARAMETERS: |
//| S0 - set 0 |
//| S1 - set 1, must have same parameter N as set 0 |
//| RESULT |
//| True, if sets are equal |
//+------------------------------------------------------------------+
bool CAmdOrdering::NsEqual(CAmdNSet &S0,CAmdNSet &S1)
{
//--- check
if(S0.m_N!=S1.m_N)
return(false);
if(S0.m_NStored!=S1.m_NStored)
return(false);
int ns=S0.m_NStored;
for(int i=0; i<ns; i++)
{
if(S1.m_LocationOf[S0.m_Items[i]]<0)
return(false);
if(S0.m_LocationOf[S1.m_Items[i]]<0)
return(false);
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Prepares iteration over set |
//| INPUT PARAMETERS: |
//| SA - set |
//| OUTPUT PARAMETERS: |
//| SA - SA ready for repeated calls of nsEnumerate() |
//+------------------------------------------------------------------+
void CAmdOrdering::NsStartEnumeration(CAmdNSet &SA)
{
SA.m_IterIdx=0;
}
//+------------------------------------------------------------------+
//| Iterates over the set. Subsequent calls return True and set J to |
//| new set item until iteration stops and False is returned. |
//| INPUT PARAMETERS: |
//| SA - n-set |
//| OUTPUT PARAMETERS: |
//| J - if: |
//| * Result=True - index of element in the set |
//| * Result=False - not set |
//+------------------------------------------------------------------+
bool CAmdOrdering::NsEnumerate(CAmdNSet &SA,int &J)
{
int k=0;
J=0;
k=SA.m_IterIdx;
if(k>=SA.m_NStored)
return(false);
J=SA.m_Items[k];
SA.m_IterIdx=k+1;
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Compresses internal storage, reclaiming previously dropped blocks|
//| To be used internally by kn-set modification functions. |
//| INPUT PARAMETERS: |
//| SA - kn-set to compress |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsCompressStorage(CAmdKNSet &SA)
{
//--- create variables
int blocklen=0;
int setidx=0;
int srcoffs=0;
int dstoffs=0;
//--- main loop
while(srcoffs<SA.m_DataUsed)
{
blocklen=SA.m_Data[srcoffs+0];
setidx=SA.m_Data[srcoffs+1];
//--- check
if(!CAp::Assert(blocklen>=m_KNsHeaderSize,__FUNCTION__+": integrity check 6385 failed"))
return;
if(setidx<0)
{
srcoffs=srcoffs+blocklen;
continue;
}
if(srcoffs!=dstoffs)
{
for(int i=0; i<blocklen; i++)
SA.m_Data.Set(dstoffs+i,SA.m_Data[srcoffs+i]);
SA.m_VBegin.Set(setidx,dstoffs+m_KNsHeaderSize);
}
dstoffs=dstoffs+blocklen;
srcoffs=srcoffs+blocklen;
}
//--- check
if(!CAp::Assert(srcoffs==SA.m_DataUsed,__FUNCTION__+": integrity check 9464 failed"))
return;
SA.m_DataUsed=dstoffs;
}
//+------------------------------------------------------------------+
//| Reallocates internal storage for set #SetIdx, increasing its |
//| capacity to NewAllocated exactly. This function may invalidate |
//| internal pointers for ALL sets in the kn-set structure because it|
//| may perform storage compression in order to reclaim previously |
//| freed space. |
//| INPUT PARAMETERS: |
//| SA - kn-set structure |
//| SetIdx - set to reallocate |
//| NewAllocated - new size for the set, must be at least equal |
//| to already allocated |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsRealLocate(CAmdKNSet &SA,int setidx,
int NewAllocated)
{
//--- create variables
int oldbegin=0;
int oldcnt=0;
int newbegin=0;
//--- check
if(CAp::Len(SA.m_Data)<SA.m_DataUsed+m_KNsHeaderSize+NewAllocated)
{
KNsCompressStorage(SA);
if(CAp::Len(SA.m_Data)<SA.m_DataUsed+m_KNsHeaderSize+NewAllocated)
CApServ::VectorGrowTo(SA.m_Data,SA.m_DataUsed+m_KNsHeaderSize+NewAllocated);
}
oldbegin=SA.m_VBegin[setidx];
oldcnt=SA.m_VCnt[setidx];
newbegin=SA.m_DataUsed+m_KNsHeaderSize;
SA.m_VBegin.Set(setidx,newbegin);
SA.m_VAllocated.Set(setidx,NewAllocated);
SA.m_Data.Set(oldbegin-1,-1);
SA.m_Data.Set(newbegin-2,m_KNsHeaderSize+NewAllocated);
SA.m_Data.Set(newbegin-1,setidx);
SA.m_DataUsed+=SA.m_Data[newbegin-2];
for(int j=0; j<oldcnt; j++)
SA.m_Data.Set(newbegin+j,SA.m_Data[oldbegin+j]);
}
//+------------------------------------------------------------------+
//| Initialize kn-set |
//| INPUT PARAMETERS: |
//| K - sets count |
//| N - set size |
//| kPrealloc- preallocate place per set (can be zero) |
//| OUTPUT PARAMETERS: |
//| SA - K sets of N elements, initially empty |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsInit(int k,int n,int kPrealloc,CAmdKNSet &SA)
{
SA.m_K=n;
SA.m_N=n;
CAblasF::ISetAllocV(n,-1,SA.m_FlagArray);
CAblasF::ISetAllocV(n,kPrealloc,SA.m_VAllocated);
CApServ::IVectorSetLengthAtLeast(SA.m_VBegin,n);
SA.m_VBegin.Set(0,m_KNsHeaderSize);
for(int i=1; i<n; i++)
SA.m_VBegin.Set(i,SA.m_VBegin[i-1]+SA.m_VAllocated[i-1]+m_KNsHeaderSize);
SA.m_DataUsed=SA.m_VBegin[n-1]+SA.m_VAllocated[n-1];
CApServ::IVectorSetLengthAtLeast(SA.m_Data,SA.m_DataUsed);
for(int i=0; i<n; i++)
{
SA.m_Data.Set(SA.m_VBegin[i]-2,m_KNsHeaderSize+SA.m_VAllocated[i]);
SA.m_Data.Set(SA.m_VBegin[i]-1,i);
}
CAblasF::ISetAllocV(n,0,SA.m_VCnt);
}
//+------------------------------------------------------------------+
//| Initialize kn-set from lower triangle of symmetric A |
//| INPUT PARAMETERS: |
//| A - lower triangular sparse matrix in CRS format |
//| N - problem size |
//| OUTPUT PARAMETERS: |
//| SA - N sets of N elements, reproducing both lower and upper|
//| triangles of A |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsInitFromA(CSparseMatrix &A,int n,
CAmdKNSet &SA)
{
//--- create variables
int i=0;
int j=0;
int jj=0;
int j0=0;
int j1=0;
SA.m_K=n;
SA.m_N=n;
CAblasF::ISetAllocV(n,-1,SA.m_FlagArray);
CApServ::IVectorSetLengthAtLeast(SA.m_VAllocated,n);
for(i=0; i<n; i++)
{
//--- check
if(!CAp::Assert(A.m_DIdx[i]<A.m_UIdx[i],__FUNCTION__+": integrity check for diagonal of A failed"))
return;
j0=A.m_RIdx[i];
j1=A.m_DIdx[i]-1;
SA.m_VAllocated.Set(i,2+j1-j0);
for(jj=j0; jj<=j1; jj++)
{
j=A.m_Idx[jj];
SA.m_VAllocated.Set(j,SA.m_VAllocated[j]+1);
}
}
CApServ::IVectorSetLengthAtLeast(SA.m_VBegin,n);
SA.m_VBegin.Set(0,m_KNsHeaderSize);
for(i=1; i<n; i++)
SA.m_VBegin.Set(i,SA.m_VBegin[i-1]+SA.m_VAllocated[i-1]+m_KNsHeaderSize);
SA.m_DataUsed=SA.m_VBegin[n-1]+SA.m_VAllocated[n-1];
CApServ::IVectorSetLengthAtLeast(SA.m_Data,SA.m_DataUsed);
for(i=0; i<n; i++)
{
SA.m_Data.Set(SA.m_VBegin[i]-2,m_KNsHeaderSize+SA.m_VAllocated[i]);
SA.m_Data.Set(SA.m_VBegin[i]-1,i);
}
CAblasF::ISetAllocV(n,0,SA.m_VCnt);
for(i=0; i<n; i++)
{
SA.m_Data.Set(SA.m_VBegin[i]+SA.m_VCnt[i],i);
SA.m_VCnt.Set(i,SA.m_VCnt[i]+1);
j0=A.m_RIdx[i];
j1=A.m_DIdx[i]-1;
for(jj=j0; jj<=j1; jj++)
{
j=A.m_Idx[jj];
SA.m_Data.Set(SA.m_VBegin[i]+SA.m_VCnt[i],j);
SA.m_Data.Set(SA.m_VBegin[j]+SA.m_VCnt[j],i);
SA.m_VCnt.Set(i,SA.m_VCnt[i]+1);
SA.m_VCnt.Set(j,SA.m_VCnt[j]+1);
}
}
}
//+------------------------------------------------------------------+
//| Prepares iteration over I-th set |
//| INPUT PARAMETERS: |
//| SA - kn-set |
//| I - set index |
//| OUTPUT PARAMETERS: |
//| SA - SA ready for repeated calls of knsEnumerate() |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsStartEnumeration(CAmdKNSet &SA,int i)
{
SA.m_IterRow=i;
SA.m_IterIdx=0;
}
//+------------------------------------------------------------------+
//| Iterates over I-th set (as specified during recent |
//| KNsStartEnumeration call). |
//| Subsequent calls return True and set J to new set item until |
//| iteration stops and False is returned. |
//| INPUT PARAMETERS: |
//| S - kn-set |
//| OUTPUT PARAMETERS: |
//| J - if: |
//| * Result = True - index of element in the set |
//| * Result = False - not set |
//+------------------------------------------------------------------+
bool CAmdOrdering::KNsEnumerate(CAmdKNSet &SA,int &J)
{
bool result=false;
J=0;
if(SA.m_IterIdx<SA.m_VCnt[SA.m_IterRow])
{
J=SA.m_Data[SA.m_VBegin[SA.m_IterRow]+SA.m_IterIdx];
SA.m_IterIdx++;
result=true;
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Allows direct access to internal storage of kn-set structure - |
//| returns range of elements SA.Data[idxBegin...idxEnd-1] used to |
//| store K-th set |
//| INPUT PARAMETERS: |
//| SA - kn-set |
//| K - set index |
//| OUTPUT PARAMETERS: |
//| idxBegin, |
//| idxEnd - half-range [idxBegin,idxEnd) of SA.Data that stores|
//| K-th set |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsDirectAccess(CAmdKNSet &SA,int k,
int &idxbegin,
int &idxend)
{
idxbegin=SA.m_VBegin[k];
idxend=idxbegin+SA.m_VCnt[k];
}
//+------------------------------------------------------------------+
//| Add K-th element to I-th set. The caller guarantees that the |
//| element is not present in the target set. |
//| INPUT PARAMETERS: |
//| SA - kn-set |
//| I - set index |
//| K - element to add |
//| OUTPUT PARAMETERS: |
//| SA - modified SA |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsAddNewElement(CAmdKNSet &SA,int i,int k)
{
int cnt=SA.m_VCnt[i];
if(cnt==SA.m_VAllocated[i])
KNsRealLocate(SA,i,2*SA.m_VAllocated[i]+1);
SA.m_Data.Set(SA.m_VBegin[i]+cnt,k);
SA.m_VCnt.Set(i,cnt+1);
}
//+------------------------------------------------------------------+
//| Subtracts source n-set from the I-th set of the destination |
//| kn-set. |
//| INPUT PARAMETERS: |
//| SA - destination kn-set structure |
//| I - set index in the structure |
//| Src - source n-set |
//| OUTPUT PARAMETERS: |
//| SA - I-th set except for elements in Src |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsSubtract1(CAmdKNSet &SA,int I,CAmdNSet &Src)
{
//--- create variables
int j=0;
int cnt=SA.m_VCnt[I];
int idxbegin=SA.m_VBegin[I];
int idxend=idxbegin+cnt;
//--- main loop
while(idxbegin<idxend)
{
j=SA.m_Data[idxbegin];
if(Src.m_LocationOf[j]>=0)
{
SA.m_Data.Set(idxbegin,SA.m_Data[idxend-1]);
idxend--;
cnt=cnt-1;
}
else
idxbegin++;
}
SA.m_VCnt.Set(I,cnt);
}
//+------------------------------------------------------------------+
//| Adds K-th set of the source kn-set to the I-th destination set. |
//| The caller guarantees that SA[I] and Src[J] do NOT intersect, |
//| i.e. do not have shared elements - it allows to use faster |
//| algorithms. |
//| INPUT PARAMETERS: |
//| SA - destination kn-set structure |
//| I - set index in the structure |
//| Src - source kn-set |
//| K - set index |
//| OUTPUT PARAMETERS: |
//| SA - I-th set plus for elements in K-th set of Src |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsAddKthDistinct(CAmdKNSet &SA,int i,
CAmdKNSet &Src,int k)
{
//--- create variables
int idxdst=0;
int idxsrcbegin=0;
int j=0;
int cnt=SA.m_VCnt[i];
int srccnt=Src.m_VCnt[k];
if(cnt+srccnt>SA.m_VAllocated[i])
KNsRealLocate(SA,i,2*(cnt+srccnt)+1);
idxsrcbegin=Src.m_VBegin[k];
idxdst=SA.m_VBegin[i]+cnt;
for(j=0; j<=srccnt-1; j++)
{
SA.m_Data.Set(idxdst,Src.m_Data[idxsrcbegin+j]);
idxdst=idxdst+1;
}
SA.m_VCnt.Set(i,cnt+srccnt);
}
//+------------------------------------------------------------------+
//| Counts elements of K-th set of S0 |
//| INPUT PARAMETERS: |
//| S0 - kn-set structure |
//| K - set index in the structure S0 |
//| RESULT |
//| K-th set element count |
//+------------------------------------------------------------------+
int CAmdOrdering::KNsCountKth(CAmdKNSet &S0,int k)
{
return(S0.m_VCnt[k]);
}
//+------------------------------------------------------------------+
//| Counts elements of I-th set of S0 not present in S1 |
//| INPUT PARAMETERS: |
//| S0 - kn-set structure |
//| I - set index in the structure S0 |
//| S - kn-set to compare against |
//| RESULT |
//| count |
//+------------------------------------------------------------------+
int CAmdOrdering::KNsCountNot(CAmdKNSet &S0,int i,CAmdNSet &S1)
{
//--- create variables
int result=0;
int j=0;
int cnt0=S0.m_VCnt[i];
int idxbegin0=S0.m_VBegin[i];
//--- main loop
for(j=0; j<cnt0; j++)
if(S1.m_LocationOf[S0.m_Data[idxbegin0+j]]<0)
result++;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Counts elements of I-th set of S0 not present in K-th set of S1 |
//| INPUT PARAMETERS: |
//| S0 - kn-set structure |
//| I - set index in the structure S0 |
//| S1 - kn-set to compare against |
//| K - set index in the structure S1 |
//| RESULT |
//| count |
//+------------------------------------------------------------------+
int CAmdOrdering::KNsCountNotKth(CAmdKNSet &S0,int i,
CAmdKNSet &S1,int k)
{
//--- create variables
int result=0;
int j=0;
int cnt0=S0.m_VCnt[i];
int cnt1=S1.m_VCnt[k];
int idxbegin0=S0.m_VBegin[i];
int idxbegin1=S1.m_VBegin[k];
for(j=0; j<cnt1; j++)
S0.m_FlagArray.Set(S1.m_Data[idxbegin1+j],1);
for(j=0; j<cnt0; j++)
{
if(S0.m_FlagArray[S0.m_Data[idxbegin0+j]]<0)
result++;
}
for(j=0; j<cnt1; j++)
S0.m_FlagArray.Set(S1.m_Data[idxbegin1+j],-1);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Counts elements of I-th set of S0 that are also present in K-th |
//| set of S1 |
//| INPUT PARAMETERS: |
//| S0 - kn-set structure |
//| I - set index in the structure S0 |
//| S1 - kn-set to compare against |
//| K - set index in the structure S1 |
//| RESULT |
//| count |
//+------------------------------------------------------------------+
int CAmdOrdering::KNsCountAndKth(CAmdKNSet &S0,int i,
CAmdKNSet &S1,int k)
{
//--- create variables
int result=0;
int j=0;
int cnt0=S0.m_VCnt[i];
int cnt1=S1.m_VCnt[k];
int idxbegin0=S0.m_VBegin[i];
int idxbegin1=S1.m_VBegin[k];
for(j=0; j<cnt1; j++)
S0.m_FlagArray.Set(S1.m_Data[idxbegin1+j],1);
for(j=0; j<cnt0; j++)
if(S0.m_FlagArray[S0.m_Data[idxbegin0+j]]>0)
result++;
for(j=0; j<cnt1; j++)
S0.m_FlagArray.Set(S1.m_Data[idxbegin1+j],-1);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Sums elements in I-th set of S0, returns sum. |
//| INPUT PARAMETERS: |
//| S0 - kn-set structure |
//| I - set index in the structure S0 |
//| RESULT |
//| sum |
//+------------------------------------------------------------------+
int CAmdOrdering::KNsSumKth(CAmdKNSet &S0,int i)
{
//--- create variables
int result=0;
int j=0;
int cnt0=S0.m_VCnt[i];
int idxbegin0=S0.m_VBegin[i];
for(j=0; j<cnt0; j++)
result+=S0.m_Data[idxbegin0+j];
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Clear k-th kn-set in collection. |
//| Freed memory is NOT reclaimed for future garbage collection. |
//| INPUT PARAMETERS: |
//| SA - kn-set structure |
//| K - set index |
//| OUTPUT PARAMETERS: |
//| SA - K-th set was cleared |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsClearKthNoReclaim(CAmdKNSet &SA,int k)
{
SA.m_VCnt.Set(k,0);
}
//+------------------------------------------------------------------+
//| Clear k-th kn-set in collection. |
//| Freed memory is reclaimed for future garbage collection. This |
//| function is NOT recommended if you intend to add elements to this|
//| set in some future, because every addition will result in |
//| reallocation of previously freed memory. |
//| Use KNsClearKthNoReclaim(). |
//| INPUT PARAMETERS: |
//| SA - kn-set structure |
//| K - set index |
//| OUTPUT PARAMETERS: |
//| SA - K-th set was cleared |
//+------------------------------------------------------------------+
void CAmdOrdering::KNsClearKthReclaim(CAmdKNSet &SA,int k)
{
//--- create variables
int dxbegin=SA.m_VBegin[k];
int allocated=SA.m_VAllocated[k];
//--- clear
SA.m_VCnt.Set(k,0);
if(allocated>=m_KNsHeaderSize)
{
SA.m_Data.Set(dxbegin-2,2);
SA.m_Data.Set(dxbegin,allocated);
SA.m_Data.Set(dxbegin+1,-1);
SA.m_VAllocated.Set(k,0);
}
}
//+------------------------------------------------------------------+
//| Initialize linked list matrix |
//| INPUT PARAMETERS: |
//| N - matrix size |
//| OUTPUT PARAMETERS: |
//| A - NxN linked list matrix |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxInit(int n,CAmdLLMatrix &A)
{
A.m_N=n;
CAblasF::ISetAllocV(2*n+1,-1,A.m_VBegin);
CAblasF::ISetAllocV(n,0,A.m_VColCnt);
A.m_EntriesInitialized=0;
}
//+------------------------------------------------------------------+
//| Adds column from matrix to n-set |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| J - column index to add |
//| S - target n-set |
//| OUTPUT PARAMETERS: |
//| S - elements from J-th column are added to S |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxAddColumnTo(CAmdLLMatrix &A,int j,CAmdNSet &S)
{
//--- create variables
int n=A.m_N;
int eidx=A.m_VBegin[n+j];
//--- main loop
while(eidx>=0)
{
NsAddElement(S,A.m_Entries[eidx*m_LLMentrySize+4]);
eidx=A.m_Entries[eidx*m_LLMentrySize+3];
}
}
//+------------------------------------------------------------------+
//| Inserts new element into column J, row I. The caller guarantees |
//| that the element being inserted is NOT already present in the |
//| matrix. |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| I - row index |
//| J - column index |
//| OUTPUT PARAMETERS: |
//| A - element (I,J) added to the list. |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxInsertNewElement(CAmdLLMatrix &A,int i,int j)
{
//--- create variables
int k=0;
int newsize=0;
int eidx=0;
int Offs=0;
int n=A.m_N;
if(A.m_VBegin[2*n]<0)
{
newsize=2*A.m_EntriesInitialized+1;
A.m_Entries.Resize(newsize*m_LLMentrySize);
for(k=A.m_EntriesInitialized; k<newsize-1; k++)
A.m_Entries.Set(k*m_LLMentrySize,k+1);
A.m_Entries.Set((newsize-1)*m_LLMentrySize,A.m_VBegin[2*n]);
A.m_VBegin.Set(2*n,A.m_EntriesInitialized);
A.m_EntriesInitialized=newsize;
}
eidx=A.m_VBegin[2*n];
Offs=eidx*m_LLMentrySize;
A.m_VBegin.Set(2*n,A.m_Entries[Offs]);
A.m_Entries.Set(Offs,-1);
A.m_Entries.Set(Offs+1,A.m_VBegin[i]);
if(A.m_VBegin[i]>=0)
A.m_Entries.Set(A.m_VBegin[i]*m_LLMentrySize,eidx);
A.m_Entries.Set(Offs+2,-1);
A.m_Entries.Set(Offs+3,A.m_VBegin[j+n]);
if(A.m_VBegin[j+n]>=0)
A.m_Entries.Set(A.m_VBegin[j+n]*m_LLMentrySize+2,eidx);
A.m_Entries.Set(Offs+4,i);
A.m_Entries.Set(Offs+5,j);
A.m_VBegin.Set(i,eidx);
A.m_VBegin.Set(j+n,eidx);
A.m_VColCnt.Set(j,A.m_VColCnt[j]+1);
}
//+------------------------------------------------------------------+
//| Counts elements in J-th column that are not present in n-set S |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| J - column index |
//| S - n-set to compare against |
//| RESULT |
//| element count |
//+------------------------------------------------------------------+
int CAmdOrdering::MtxCountColumnNot(CAmdLLMatrix &A,int j,
CAmdNSet &S)
{
//--- create variables
int result=0;
int n=A.m_N;
int eidx=A.m_VBegin[n+j];
while(eidx>=0)
{
if(S.m_LocationOf[A.m_Entries[eidx*m_LLMentrySize+4]]<0)
result++;
eidx=A.m_Entries[eidx*m_LLMentrySize+3];
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Counts elements in J-th column |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| J - column index |
//| RESULT |
//| element count |
//+------------------------------------------------------------------+
int CAmdOrdering::MtxCountColumn(CAmdLLMatrix &A,int j)
{
return(A.m_VColCnt[j]);
}
//+------------------------------------------------------------------+
//| Clears K-th column or row |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| K - column/row index to clear |
//| IsCol - whether we want to clear row or column |
//| OUTPUT PARAMETERS: |
//| A - K-th column or row is empty |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxClearX(CAmdLLMatrix &A,int k,bool IsCol)
{
//--- create variables
int enext=0;
int idxprev=0;
int idxnext=0;
int idxr=0;
int idxc=0;
int n=A.m_N;
int eidx=(IsCol?A.m_VBegin[n+k]: A.m_VBegin[k]);
//--- main loop
while(eidx>=0)
{
idxr=A.m_Entries[eidx*m_LLMentrySize+4];
idxc=A.m_Entries[eidx*m_LLMentrySize+5];
if(IsCol)
enext=A.m_Entries[eidx*m_LLMentrySize+3];
else
enext=A.m_Entries[eidx*m_LLMentrySize+1];
idxprev=A.m_Entries[eidx*m_LLMentrySize];
idxnext=A.m_Entries[eidx*m_LLMentrySize+1];
if(idxprev>=0)
A.m_Entries.Set(idxprev*m_LLMentrySize+1,idxnext);
else
A.m_VBegin.Set(idxr,idxnext);
if(idxnext>=0)
A.m_Entries.Set(idxnext*m_LLMentrySize,idxprev);
idxprev=A.m_Entries[eidx*m_LLMentrySize+2];
idxnext=A.m_Entries[eidx*m_LLMentrySize+3];
if(idxprev>=0)
A.m_Entries.Set(idxprev*m_LLMentrySize+3,idxnext);
else
A.m_VBegin.Set(idxc+n,idxnext);
if(idxnext>=0)
A.m_Entries.Set(idxnext*m_LLMentrySize+2,idxprev);
A.m_Entries.Set(eidx*m_LLMentrySize,A.m_VBegin[2*n]);
A.m_VBegin.Set(2*n,eidx);
eidx=enext;
if(!IsCol)
A.m_VColCnt.Set(idxc,A.m_VColCnt[idxc]-1);
}
if(IsCol)
A.m_VColCnt.Set(k,0);
}
//+------------------------------------------------------------------+
//| Clears J-th column |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| J - column index to clear |
//| OUTPUT PARAMETERS: |
//| A - J-th column is empty |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxClearColumn(CAmdLLMatrix &A,int j)
{
MtxClearX(A,j,true);
}
//+------------------------------------------------------------------+
//| Clears J-th row |
//| INPUT PARAMETERS: |
//| A - NxN linked list matrix |
//| J - row index to clear |
//| OUTPUT PARAMETERS: |
//| A - J-th row is empty |
//+------------------------------------------------------------------+
void CAmdOrdering::MtxClearRow(CAmdLLMatrix &A,int j)
{
MtxClearX(A,j,false);
}
//+------------------------------------------------------------------+
//| Initialize vertex storage using A to estimate initial degrees |
//| INPUT PARAMETERS: |
//| A - NxN lower triangular sparse CRS matrix |
//| N - problem size |
//| CheckExactDegrees- |
//| whether we want to maintain additional exact degress|
//| (the search is still done using approximate ones) |
//| OUTPUT PARAMETERS: |
//| S - vertex set |
//+------------------------------------------------------------------+
void CAmdOrdering::VtxInit(CSparseMatrix &A,int n,
bool CheckExactDegrees,
CAmdVertexSet &S)
{
//--- create variables
int i=0;
int j=0;
int jj=0;
int j0=0;
int j1=0;
//--- initialization
S.m_N=n;
S.m_CheckExactDegrees=CheckExactDegrees;
S.m_SmallestDegree=0;
CAblasF::BSetAllocV(n,true,S.m_IsVertex);
CAblasF::ISetAllocV(n,0,S.m_ApproxD);
for(i=0; i<n; i++)
{
j0=A.m_RIdx[i];
j1=A.m_DIdx[i]-1;
S.m_ApproxD.Set(i,j1-j0+1);
for(jj=j0; jj<=j1; jj++)
{
j=A.m_Idx[jj];
S.m_ApproxD.Set(j,S.m_ApproxD[j]+1);
}
}
if(CheckExactDegrees)
CAblasF::ICopyAllocV(n,S.m_ApproxD,S.m_OptionalExactD);
CAblasF::ISetAllocV(n,-1,S.m_VBegin);
CAblasF::ISetAllocV(n,-1,S.m_VPrev);
CAblasF::ISetAllocV(n,-1,S.m_VNext);
for(i=0; i<n; i++)
{
j=S.m_ApproxD[i];
j0=S.m_VBegin[j];
S.m_VBegin.Set(j,i);
S.m_VNext.Set(i,j0);
S.m_VPrev.Set(i,-1);
if(j0>=0)
S.m_VPrev.Set(j0,i);
}
}
//+------------------------------------------------------------------+
//| Removes vertex from the storage |
//| INPUT PARAMETERS: |
//| S - vertex set |
//| P - vertex to be removed |
//| OUTPUT PARAMETERS: |
//| S - modified |
//+------------------------------------------------------------------+
void CAmdOrdering::VtxRemoveVertex(CAmdVertexSet &S,int p)
{
//--- create variables
int d=S.m_ApproxD[p];
int idxprev=S.m_VPrev[p];
int idxnext=S.m_VNext[p];
//--- check
if(idxprev>=0)
S.m_VNext.Set(idxprev,idxnext);
else
S.m_VBegin.Set(d,idxnext);
if(idxnext>=0)
S.m_VPrev.Set(idxnext,idxprev);
S.m_IsVertex[p]=false;
S.m_ApproxD.Set(p,-9999999);
if(S.m_CheckExactDegrees)
S.m_OptionalExactD.Set(p,-9999999);
}
//+------------------------------------------------------------------+
//| Get approximate degree. Result is undefined for removed vertexes.|
//| INPUT PARAMETERS: |
//| S - vertex set |
//| P - vertex index |
//| RESULT |
//| vertex degree |
//+------------------------------------------------------------------+
int CAmdOrdering::VtxGetApprox(CAmdVertexSet &S,int p)
{
return(S.m_ApproxD[p]);
}
//+------------------------------------------------------------------+
//| Get exact degree (or 0, if not supported). Result is undefined |
//| for removed vertexes. |
//| INPUT PARAMETERS: |
//| S - vertex set |
//| P - vertex index |
//| RESULT |
//| vertex degree |
//+------------------------------------------------------------------+
int CAmdOrdering::VtxGetExact(CAmdVertexSet &S,int p)
{
return (S.m_CheckExactDegrees?S.m_OptionalExactD[p]:0);
}
//+------------------------------------------------------------------+
//| Returns index of vertex with minimum approximate degree, or -1 |
//| when there is no vertex. |
//| INPUT PARAMETERS: |
//| S - vertex set |
//| RESULT |
//| vertex index, or -1 |
//+------------------------------------------------------------------+
int CAmdOrdering::VtxGetApproxMinDegree(CAmdVertexSet &S)
{
//--- create variables
int result=-1;
int n=S.m_N;
//--- main loop
for(int i=S.m_SmallestDegree; i<n; i++)
{
if(S.m_VBegin[i]>=0)
{
S.m_SmallestDegree=i;
result=S.m_VBegin[i];
break;
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Update approximate degree |
//| INPUT PARAMETERS: |
//| S - vertex set |
//| P - vertex to be updated |
//| DNew - new degree |
//| OUTPUT PARAMETERS: |
//| S - modified |
//+------------------------------------------------------------------+
void CAmdOrdering::VtxUpdateApproximateDegree(CAmdVertexSet &S,
int p,int DNew)
{
//--- create variables
int idxprev=S.m_VPrev[p];
int idxnext=S.m_VNext[p];
int oldbegin=0;
int dold=S.m_ApproxD[p];
if(dold==DNew)
return;
if(idxprev>=0)
S.m_VNext.Set(idxprev,idxnext);
else
S.m_VBegin.Set(dold,idxnext);
if(idxnext>=0)
S.m_VPrev.Set(idxnext,idxprev);
oldbegin=S.m_VBegin[DNew];
S.m_VBegin.Set(DNew,p);
S.m_VNext.Set(p,oldbegin);
S.m_VPrev.Set(p,-1);
if(oldbegin>=0)
S.m_VPrev.Set(oldbegin,p);
S.m_ApproxD.Set(p,DNew);
if(DNew<S.m_SmallestDegree)
S.m_SmallestDegree=DNew;
}
//+------------------------------------------------------------------+
//| Update optional exact degree. Silently returns if vertex set does|
//| not store exact degrees. |
//| INPUT PARAMETERS: |
//| S - vertex set |
//| P - vertex to be updated |
//| D - new degree |
//| OUTPUT PARAMETERS: |
//| S - modified |
//+------------------------------------------------------------------+
void CAmdOrdering::VtxUpdateExactDegree(CAmdVertexSet &S,int p,
int d)
{
if(!S.m_CheckExactDegrees)
return;
S.m_OptionalExactD.Set(p,d);
}
//+------------------------------------------------------------------+
//| This function selects K-th pivot with minimum approximate degree |
//| and generates permutation that reorders variable to the K-th |
//| position in the matrix. |
//| Due to supernodal structure of the matrix more than one pivot |
//| variable can be selected and moved to the beginning. The actual |
//| count of pivots selected is returned in NodeSize. |
//| INPUT PARAMETERS: |
//| Buf - properly initialized buffer object |
//| K - pivot index |
//| OUTPUT PARAMETERS: |
//| Buf.Perm - entries [K,K+NodeSize) are initialized by |
//| permutation |
//| Buf.InvPerm - entries [K,K+NodeSize) are initialized by |
//| permutation |
//| Buf.ColumnSwaps - entries [K,K+NodeSize) are initialized by |
//| permutation |
//| P - pivot supervariable |
//| NodeSize - supernode size |
//+------------------------------------------------------------------+
void CAmdOrdering::AmdSelectPivotElement(CAmdBuffer &Buf,
int k,int &p,
int &nodesize)
{
//--- create variables
int i=0;
int j=0;
nodesize=0;
p=VtxGetApproxMinDegree(Buf.m_VertexDegrees);
//--- check
if(!CAp::Assert(p>=0,__FUNCTION__+": integrity check 3634 failed"))
return;
if(!CAp::Assert(VtxGetApprox(Buf.m_VertexDegrees,p)>=0,__FUNCTION__+": integrity check RDFD2 failed"))
return;
KNsStartEnumeration(Buf.m_SetSuper,p);
while(KNsEnumerate(Buf.m_SetSuper,j))
{
i=Buf.m_Perm[j];
Buf.m_ColumnSwaps.Set(k+nodesize,i);
Buf.m_InvPerm.Set(i,Buf.m_InvPerm[k+nodesize]);
Buf.m_InvPerm.Set(k+nodesize,j);
Buf.m_Perm.Set(Buf.m_InvPerm[i],i);
Buf.m_Perm.Set(Buf.m_InvPerm[k+nodesize],k+nodesize);
nodesize++;
}
//--- check
CAp::Assert(VtxGetApprox(Buf.m_VertexDegrees,p)>=0 &&
(!Buf.m_CheckExactDegrees || VtxGetExact(Buf.m_VertexDegrees,p)>=0),
__FUNCTION__+": integrity check RDFD failed");
}
//+------------------------------------------------------------------+
//| This function computes nonzero pattern of Lp, the column that is |
//| added to the lower triangular Cholesky factor. |
//| INPUT PARAMETERS: |
//| Buf - properly initialized buffer object |
//| P - pivot column |
//| OUTPUT PARAMETERS: |
//| Buf.m_setP - initialized with setSuper[P] |
//| Buf.m_Lp - initialized with Lp\P |
//| Buf.m_setRp- initialized with Lp\{P+Q} |
//| Buf.m_Ep - initialized with setE[P] |
//| Buf.m_MtxL - L := L+Lp |
//| Buf.m_Ls - first Buf.LSCnt elements contain subset of Lp |
//| elements that are principal nodes in supervariables.|
//+------------------------------------------------------------------+
void CAmdOrdering::AmdComputeLp(CAmdBuffer &Buf,int p)
{
//--- create variables
int i=0;
NsClear(Buf.m_SetP);
NsAddKth(Buf.m_SetP,Buf.m_SetSuper,p);
NsClear(Buf.m_Lp);
NsAddKth(Buf.m_Lp,Buf.m_SetA,p);
KNsStartEnumeration(Buf.m_SetE,p);
while(KNsEnumerate(Buf.m_SetE,i))
MtxAddColumnTo(Buf.m_MtxL,i,Buf.m_Lp);
NsSubtractKth(Buf.m_Lp,Buf.m_SetSuper,p);
NsCopy(Buf.m_Lp,Buf.m_SetRP);
NsSubtract1(Buf.m_SetRP,Buf.m_SetQ);
Buf.m_LSCnt=0;
NsStartEnumeration(Buf.m_Lp);
while(NsEnumerate(Buf.m_Lp,i))
{
//--- check
if(!CAp::Assert(!Buf.m_IsEliminated[i],__FUNCTION__+": integrity check 0740 failed"))
return;
MtxInsertNewElement(Buf.m_MtxL,i,p);
if(Buf.m_IsSuperNode[i])
{
Buf.m_Ls.Set(Buf.m_LSCnt,i);
Buf.m_LSCnt++;
}
}
NsClear(Buf.m_Ep);
NsAddKth(Buf.m_Ep,Buf.m_SetE,p);
}
//+------------------------------------------------------------------+
//| Having output of AMDComputeLp() in the Buf object, this function |
//| performs mass elimination in the quotient graph. |
//| INPUT PARAMETERS: |
//| Buf - properly initialized buffer object |
//| P - pivot column |
//| K - number of already eliminated columns (P-th is not |
//| counted) |
//| Tau - variables with degrees higher than Tau will be |
//| classified as quasidense |
//| OUTPUT PARAMETERS: |
//| Buf.m_SetA - Lp is eliminated from setA |
//| Buf.m_SetE - Ep is eliminated from setE, P is added |
//| approxD - updated |
//| Buf.m_SetQSuperCand - contains candidates for quasidense |
//| status assignment |
//+------------------------------------------------------------------+
void CAmdOrdering::AmdMasselimination(CAmdBuffer &Buf,int p,
int k,int tau)
{
//--- create variables
int lidx=0;
int lpi=0;
int cntsuperi=0;
int cntq=0;
int cntainoti=0;
int cntainotqi=0;
int cntlpnoti=0;
int cntlpnotqi=0;
int cc=0;
int j=0;
int e=0;
int we=0;
int cnttoclean=0;
int idxbegin=0;
int idxend=0;
int jj=0;
int bnd0=0;
int bnd1=0;
int bnd2=0;
int d=0;
int n=Buf.m_N;
CApServ::IVectorSetLengthAtLeast(Buf.m_Tmp0,n);
cnttoclean=0;
for(lidx=0; lidx<Buf.m_LSCnt; lidx++)
{
if(Buf.m_SetQ.m_LocationOf[Buf.m_Ls[lidx]]<0)
{
lpi=Buf.m_Ls[lidx];
cntsuperi=KNsCountKth(Buf.m_SetSuper,lpi);
KNsDirectAccess(Buf.m_SetE,lpi,idxbegin,idxend);
for(jj=idxbegin; jj<idxend; jj++)
{
e=Buf.m_SetE.m_Data[jj];
we=Buf.m_Arrwe[e];
if(we<0)
{
we=MtxCountColumnNot(Buf.m_MtxL,e,Buf.m_SetQ);
Buf.m_Tmp0.Set(cnttoclean,e);
cnttoclean++;
}
Buf.m_Arrwe.Set(e,we-cntsuperi);
}
}
}
NsClear(Buf.m_SetQSuperCand);
for(lidx=0; lidx<Buf.m_LSCnt; lidx++)
{
if(Buf.m_SetQ.m_LocationOf[Buf.m_Ls[lidx]]<0)
{
lpi=Buf.m_Ls[lidx];
KNsSubtract1(Buf.m_SetA,lpi,Buf.m_Lp);
KNsSubtract1(Buf.m_SetA,lpi,Buf.m_SetP);
KNsSubtract1(Buf.m_SetE,lpi,Buf.m_Ep);
KNsAddNewElement(Buf.m_SetE,lpi,p);
if(Buf.m_ExtendedDebug)
{
//--- check
if(!CAp::Assert(KNsCountNotKth(Buf.m_SetA,lpi,Buf.m_SetSuper,lpi)==KNsCountKth(Buf.m_SetA,lpi),
__FUNCTION__+": integrity check 454F failed"))
return;
//--- check
if(!CAp::Assert(KNsCountAndKth(Buf.m_SetA,lpi,Buf.m_SetSuper,lpi)==0,__FUNCTION__+": integrity check kl5nv failed"))
return;
//--- check
if(!CAp::Assert(NsCountAndKth(Buf.m_Lp,Buf.m_SetSuper,lpi)==KNsCountKth(Buf.m_SetSuper,lpi),__FUNCTION__+": integrity check 8463 failed"))
return;
}
cntq=NsCount(Buf.m_SetQ);
cntsuperi=KNsCountKth(Buf.m_SetSuper,lpi);
cntainoti=KNsCountKth(Buf.m_SetA,lpi);
if(cntq>0)
cntainotqi=KNsCountNot(Buf.m_SetA,lpi,Buf.m_SetQ);
else
cntainotqi=cntainoti;
cntlpnoti=NsCount(Buf.m_Lp)-cntsuperi;
cntlpnotqi=NsCount(Buf.m_SetRP)-cntsuperi;
cc=0;
KNsDirectAccess(Buf.m_SetE,lpi,idxbegin,idxend);
for(jj=idxbegin; jj<idxend; jj++)
{
j=Buf.m_SetE.m_Data[jj];
if(j==p)
continue;
e=Buf.m_Arrwe[j];
if(e<0)
{
if(cntq>0)
e=MtxCountColumnNot(Buf.m_MtxL,j,Buf.m_SetQ);
else
e=MtxCountColumn(Buf.m_MtxL,j);
}
cc=cc+e;
}
bnd0=n-k-NsCount(Buf.m_SetP);
bnd1=VtxGetApprox(Buf.m_VertexDegrees,lpi)+cntlpnoti;
bnd2=cntq+cntainotqi+cntlpnotqi+cc;
d=MathMin(bnd0,MathMin(bnd1,bnd2));
VtxUpdateApproximateDegree(Buf.m_VertexDegrees,lpi,d);
if(tau>0 && d+cntsuperi>tau)
NsAddElement(Buf.m_SetQSuperCand,lpi);
if(Buf.m_CheckExactDegrees)
{
NsClear(Buf.m_ExactDegreeTmp0);
KNsStartEnumeration(Buf.m_SetE,lpi);
while(KNsEnumerate(Buf.m_SetE,j))
MtxAddColumnTo(Buf.m_MtxL,j,Buf.m_ExactDegreeTmp0);
VtxUpdateExactDegree(Buf.m_VertexDegrees,lpi,cntainoti+NsCountNotKth(Buf.m_ExactDegreeTmp0,Buf.m_SetSuper,lpi));
//--- check
if(!CAp::Assert((KNsCountKth(Buf.m_SetE,lpi)>2 || cntq>0) || VtxGetApprox(Buf.m_VertexDegrees,lpi)==VtxGetExact(Buf.m_VertexDegrees,lpi),
__FUNCTION__+": integrity check 7206 failed"))
return;
//--- check
if(!CAp::Assert(VtxGetApprox(Buf.m_VertexDegrees,lpi)>=VtxGetExact(Buf.m_VertexDegrees,lpi),__FUNCTION__+": integrity check 8206 failed"))
return;
}
}
}
for(j=0; j<cnttoclean; j++)
Buf.m_Arrwe.Set(Buf.m_Tmp0[j],-1);
}
//+------------------------------------------------------------------+
//| After mass elimination, but before removal of vertex P, we may |
//| perform supernode detection. Only variables/supernodes in Lp (P |
//| itself is NOT included) can be merged into larger supernodes. |
//| INPUT PARAMETERS: |
//| Buf - properly initialized buffer object |
//| OUTPUT PARAMETERS: |
//| Buf - following fields of Buf may be modified: |
//| * Buf.m_SetSuper |
//| * Buf.m_SetA |
//| * Buf.m_SetE |
//| * Buf.m_IsSuperNode |
//| * ApproxD and ExactD |
//+------------------------------------------------------------------+
void CAmdOrdering::AmdDetectSuperNodes(CAmdBuffer &Buf)
{
//--- create variables
int i=0;
int j=0;
int cnt=0;
int lpi=0;
int lpj=0;
int nj=0;
int hashi=0;
int n=Buf.m_N;
CApServ::IVectorSetLengthAtLeast(Buf.m_SNCandidates,n);
if(Buf.m_LSCnt<2)
return;
for(i=0; i<Buf.m_LSCnt; i++)
if(Buf.m_SetQ.m_LocationOf[Buf.m_Ls[i]]<0)
{
lpi=Buf.m_Ls[i];
hashi=(KNsSumKth(Buf.m_SetA,lpi)+KNsSumKth(Buf.m_SetE,lpi))%n;
NsAddElement(Buf.m_NonEmptyBuckets,hashi);
KNsAddNewElement(Buf.m_HashBuckets,hashi,lpi);
}
NsStartEnumeration(Buf.m_NonEmptyBuckets);
while(NsEnumerate(Buf.m_NonEmptyBuckets,hashi))
{
if(KNsCountKth(Buf.m_HashBuckets,hashi)>=2)
{
cnt=0;
KNsStartEnumeration(Buf.m_HashBuckets,hashi);
while(KNsEnumerate(Buf.m_HashBuckets,i))
{
Buf.m_SNCandidates.Set(cnt,i);
cnt++;
}
for(i=cnt-1; i>=0; i--)
{
for(j=cnt-1; j>=i+1; j--)
{
if(Buf.m_IsSuperNode[Buf.m_SNCandidates[i]] && Buf.m_IsSuperNode[Buf.m_SNCandidates[j]])
{
lpi=Buf.m_SNCandidates[i];
lpj=Buf.m_SNCandidates[j];
NsClear(Buf.m_AdjI);
NsClear(Buf.m_AdjJ);
NsAddKth(Buf.m_AdjI,Buf.m_SetA,lpi);
NsAddKth(Buf.m_AdjJ,Buf.m_SetA,lpj);
NsAddKth(Buf.m_AdjI,Buf.m_SetE,lpi);
NsAddKth(Buf.m_AdjJ,Buf.m_SetE,lpj);
NsAddElement(Buf.m_AdjI,lpi);
NsAddElement(Buf.m_AdjI,lpj);
NsAddElement(Buf.m_AdjJ,lpi);
NsAddElement(Buf.m_AdjJ,lpj);
if(!NsEqual(Buf.m_AdjI,Buf.m_AdjJ))
continue;
if(Buf.m_ExtendedDebug)
{
//--- check
if(!CAp::Assert(VtxGetApprox(Buf.m_VertexDegrees,lpi)>=1 &&
(!Buf.m_CheckExactDegrees || VtxGetExact(Buf.m_VertexDegrees,lpi)>=1),
__FUNCTION__+": integrity check &GBFF1 failed"))
return;
//--- check
if(!CAp::Assert(VtxGetApprox(Buf.m_VertexDegrees,lpj)>=1 &&
(!Buf.m_CheckExactDegrees || VtxGetExact(Buf.m_VertexDegrees,lpj)>=1),
__FUNCTION__+": integrity check &GBFF2 failed"))
return;
//--- check
if(!CAp::Assert(KNsCountAndKth(Buf.m_SetSuper,lpi,Buf.m_SetSuper,lpj)==0,
__FUNCTION__+": integrity check &GBFF3 failed"))
return;
}
nj=KNsCountKth(Buf.m_SetSuper,lpj);
KNsAddKthDistinct(Buf.m_SetSuper,lpi,Buf.m_SetSuper,lpj);
KNsClearKthReclaim(Buf.m_SetSuper,lpj);
KNsClearKthReclaim(Buf.m_SetA,lpj);
KNsClearKthReclaim(Buf.m_SetE,lpj);
Buf.m_IsSuperNode[lpj]=false;
VtxRemoveVertex(Buf.m_VertexDegrees,lpj);
VtxUpdateApproximateDegree(Buf.m_VertexDegrees,lpi,VtxGetApprox(Buf.m_VertexDegrees,lpi)-nj);
if(Buf.m_CheckExactDegrees)
VtxUpdateExactDegree(Buf.m_VertexDegrees,lpi,VtxGetExact(Buf.m_VertexDegrees,lpi)-nj);
}
}
}
}
KNsClearKthNoReclaim(Buf.m_HashBuckets,hashi);
}
NsClear(Buf.m_NonEmptyBuckets);
}
//+------------------------------------------------------------------+
//| Assign quasidense status to proposed supervars, perform all the |
//| necessary cleanup (remove vertices, etc) |
//| INPUT PARAMETERS: |
//| Buf - properly initialized buffer object |
//| Cand - supervariables to be moved to quasidense status |
//| P - current pivot element (used for integrity checks) |
//| or -1, when this function is used for initial |
//| status assignment. |
//| OUTPUT PARAMETERS: |
//| Buf - variables belonging to supervariables in cand are |
//| added to SetQ. Supervariables are removed from all |
//| lists |
//+------------------------------------------------------------------+
void CAmdOrdering::AmdMoveToQuasiDense(CAmdBuffer &Buf,
CAmdNSet &Cand,
int p)
{
//--- create variables
int i=0;
int j=0;
NsStartEnumeration(Cand);
while(NsEnumerate(Cand,j))
{
//--- check
if(!CAp::Assert(j!=p,__FUNCTION__+": integrity check 9464 failed"))
return;
//--- check
if(!CAp::Assert(Buf.m_IsSuperNode[j],__FUNCTION__+": integrity check 6284 failed"))
return;
//--- check
if(!CAp::Assert(!Buf.m_IsEliminated[j],__FUNCTION__+": integrity check 3858 failed"))
return;
KNsStartEnumeration(Buf.m_SetSuper,j);
while(KNsEnumerate(Buf.m_SetSuper,i))
NsAddElement(Buf.m_SetQ,i);
KNsClearKthReclaim(Buf.m_SetA,j);
KNsClearKthReclaim(Buf.m_SetE,j);
Buf.m_IsSuperNode[j]=false;
VtxRemoveVertex(Buf.m_VertexDegrees,j);
}
}
//+------------------------------------------------------------------+
//| Analysis sparse Cholesky: elimination tree, factorization costs, |
//| etc. |
//+------------------------------------------------------------------+
class CSpChol
{
public:
//--- constants
static const int m_MaxSupernode;
static const double m_MaxMergeinEfficiency;
static const int m_SmallFakesTolerance;
static const int m_MaxFastKernel;
static const bool m_RelaxedSupernodes;
//--- methods
static bool SpSymmAnalyze(CSparseMatrix &A,CRowInt &Priorities,int FactType,int PermType,CSpCholAnalysis &Analysis);
static void SpSymmSetModificationStrategy(CSpCholAnalysis &Analysis,int ModStrategy,double P0,double P1,double P2,double P3);
static void SpSymmReload(CSpCholAnalysis &Analysis,CSparseMatrix &A);
static void SpSymmReloadDiagonal(CSpCholAnalysis &Analysis,CRowDouble &d);
static bool SpSymmFactorize(CSpCholAnalysis &Analysis);
static void SpSymmExtract(CSpCholAnalysis &Analysis,CSparseMatrix &A,CRowDouble &d,CRowInt &p);
static void SpSymmSolve(CSpCholAnalysis &Analysis,CRowDouble &b);
static void SpSymmDiagErr(CSpCholAnalysis &Analysis,double &SumSq,double &ErrSq);
private:
static bool UpdateKernel4444(CRowDouble &rowstorage,int offss,int sheight,int offsu,int uheight,CRowDouble &diagd,int offsd,CRowInt &raw2smap,CRowInt &superrowidx,int urbase);
static bool UpdateKernelABC4(CRowDouble &rowstorage,int offss,int twidth,int offsu,int uheight,int urank,int urowstride,int uwidth,CRowDouble &diagd,int offsd,CRowInt &raw2smap,CRowInt &superrowidx,int urbase);
static void GenerateDbgPermutation(CSparseMatrix &A,int n,CRowInt &Perm,CRowInt &InvPerm);
static void BuildUnorderedeTree(CSparseMatrix &A,int n,CRowInt &Parent,CRowInt &tAbove);
static void FromParentToChildren(CRowInt &Parent,int n,CRowInt &ChildrenR,CRowInt &ChildrenI,CRowInt &tTmp0);
static void BuildOrderedeTree(CSparseMatrix &A,int n,CRowInt &Parent,CRowInt &SupernodalPermutation,CRowInt &InvSupernodalPermutation,CRowInt &tRawParentOfRawNode,CRowInt &tRawParentOfReorderedNode,CRowInt &tTmp,bool &tFlagArray[]);
static void CreateSupernodalStructure(CSparseMatrix &at,CRowInt &Parent,int n,CSpCholAnalysis &Analysis,CRowInt &Node2Supernode,CRowInt &tChildrenR,CRowInt &tChildrenI,CRowInt &tParentNodeOfSupernode,CRowInt &tFakeNonZeros,CRowInt &tTmp0,bool &tFlagArray[]);
static void AnalyzeSupernodalDependencies(CSpCholAnalysis &Analysis,CSparseMatrix &RawA,CRowInt &Node2Supernode,int n,CRowInt &tTmp0,CRowInt &tTmp1,bool &tFlagArray[]);
static void LoadMatrix(CSpCholAnalysis &Analysis,CSparseMatrix &at);
static void ExtractMatrix(CSpCholAnalysis &Analysis,CRowInt &Offsets,CRowInt &Strides,CRowDouble &RowStorage,CRowDouble &DiagD,int N,CSparseMatrix &A,CRowDouble &D,CRowInt &P,CRowInt &TmpP);
static void PartialCholeskyPattern(CSparseMatrix &A,int Head,int Tail,CSparseMatrix &ATail,CRowInt &tmpParent,CRowInt &tmpChildrenR,CRowInt &tmpChildrenI,CRowInt &Tmp1,bool &FlagArray[],CSparseMatrix &tmpBottomT,CSparseMatrix &tmpUpdateT,CSparseMatrix &tmpUpdate,CSparseMatrix &tmpNewTailT);
static void TopologicalPermutation(CSparseMatrix&A,CRowInt &P,CSparseMatrix &B);
static int ComputeNonzeroPattern(CSparseMatrix &wrkAT,int ColumnIdx,int N,CRowInt &SuperRowRIdx,CRowInt &SuperRowIdx,int NSuper,CRowInt &ChildrenNodesR,CRowInt &ChildrenNodesI,CRowInt &Node2Supernode,bool &TrueArray[],CRowInt &Tmp0);
static int UpdateSupernode(CSpCholAnalysis &Analysis,int SIdx,int Cols0,int Cols1,int OffsS,CRowInt &Raw2Smap,int UIdx,int WrkRow,CRowDouble &DiagD,int OffsD);
static bool FactorizeSupernode(CSpCholAnalysis &Analysis,int SIdx);
static int RecommendedStrideFor(int RowSize);
static int AlignPositionInArray(int Offs);
static bool UpdateKernelRank1(CRowDouble &RowStorage,int OffsS,int tWidth,int tRowStride,int OffsU,int UHeight,int UWidth,CRowDouble &DiagD,int OffsD,CRowInt &Raw2Smap,CRowInt &SuperRowIdx,int URBase);
static bool UpdateKernelRank2(CRowDouble &RowStorage,int OffsS,int tWidth,int tRowStride,int OffsU,int UHeight,int UWidth,CRowDouble &DiagD,int OffsD,CRowInt &Raw2Smap,CRowInt &SuperRowIdx,int URBase);
static void SlowDebugChecks(CSparseMatrix &A,CRowInt &FillinPerm,int N,int Tail,CSparseMatrix &ReferenceTailA);
static bool DbgMatrixCholesky2(CMatrixDouble &AAA,int Offs,int N,bool IsUpper);
};
//+------------------------------------------------------------------+
//| Constants |
//+------------------------------------------------------------------+
const int CSpChol::m_MaxSupernode=4;
const double CSpChol::m_MaxMergeinEfficiency=0.25;
const int CSpChol::m_SmallFakesTolerance=2;
const int CSpChol::m_MaxFastKernel=4;
const bool CSpChol::m_RelaxedSupernodes=true;
//+------------------------------------------------------------------+
//| Symbolic phase of Cholesky decomposition. |
//| Performs preliminary analysis of Cholesky/LDLT factorization. The|
//| latter is computed with strictly diagonal D (no Bunch-Kauffman |
//| pivoting). |
//| The analysis object produced by this function will be used later |
//| to guide actual decomposition. |
//| Depending on settings specified during factorization, may produce|
//| vanilla Cholesky or L*D*LT decomposition (with strictly diagonal |
//| D), without permutation or with permutation P (being either |
//| topological ordering or sparsity preserving ordering). |
//| Thus, A is represented as either L*LT or L*D*LT or P*L*LT*PT or |
//| P*L*D*LT*PT. |
//| NOTE: L*D*LT family of factorization may be used to factorize |
//| indefinite matrices. However, numerical stability is |
//| guaranteed ONLY for a class of quasi-definite matrices. |
//| INPUT PARAMETERS: |
//| A - sparse square matrix in CRS format, with LOWER |
//| triangle being used to store the matrix. |
//| Priorities - array[N], optional priorities: |
//| * ignored for PermType<>3 and PermType<>-3 |
//| (not referenced at all) |
//| * for PermType=3 or PermType=-3 this array |
//| stores nonnegative column elimination |
//| priorities. Columns with lower priorities are |
//| eliminated first. At least max(Priorities[])+1|
//| internal AMD rounds will be performed, so |
//| avoid specifying too large values here. |
//| Ideally, 0<=Priorities[I]<5. |
//| FactType - factorization type: |
//| * 0 for traditional Cholesky |
//| * 1 for LDLT decomposition with strictly |
//| diagonal D |
//| PermType - permutation type: |
//| *-3 for debug improved AMD (a sequence of |
//| decreasing Tail sizes is generated, ~logN in |
//| total, even if ordering can be done with just |
//| one round of AMD). This ordering is used to |
//| test correctness of multiple AMD rounds. |
//| *-2 for column count ordering (NOT RECOMMENDED!)|
//| *-1 for absence of permutation |
//| * 0 for best permutation available |
//| * 1 for supernodal ordering (improves locality |
//| and performance, but does NOT change fill-in |
//| pattern) |
//| * 2 for supernodal AMD ordering (improves |
//| fill-in) |
//| * 3 for improved AMD (approximate minimum |
//| degree) ordering with better handling of |
//| matrices with dense rows/columns and ability |
//| to perform priority ordering |
//| Analysis - can be uninitialized instance, or previous analysis|
//| results. Previously allocated memory is reused as |
//| much as possible. |
//| Buf - buffer; may be completely uninitialized, or one |
//| remained from previous calls (including ones with |
//| completely different matrices). Previously |
//| allocated temporary space will be reused as much as|
//| possible. |
//| OUTPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure which |
//| will be used later to guide numerical factorization|
//| The numerical values are stored internally in the |
//| structure, but you have to run factorization phase |
//| explicitly with SPSymmFactorize(). You can also |
//| reload another matrix with same sparsity pattern |
//| with SPSymmReload() or rewrite its diagonal with |
//| SPSymmReloadDiagonal(). |
//| This function fails if and only if the matrix A is symbolically |
//| degenerate, i.e. has diagonal element which is exactly zero. In |
//| such case False is returned. |
//| NOTE: defining 'SCHOLESKY' Trace tag will activate tracing. |
//| defining 'SCHOLESKY.SS' Trace tag will activate detailed |
//| tracing of the supernodal structure. |
//| NOTE: defining 'DEBUG.SLOW' Trace tag will activate extra-slow |
//| (roughly N^3 ops) integrity checks, in addition to cheap |
//| O(1) ones. |
//+------------------------------------------------------------------+
bool CSpChol::SpSymmAnalyze(CSparseMatrix &A,
CRowInt &Priorities,
int FactType,
int PermType,
CSpCholAnalysis &Analysis)
{
//--- create variables
bool result=true;
int n=0;
int m=0;
int i=0;
int j=0;
int jj=0;
int j0=0;
int j1=0;
int k=0;
int range0=0;
int range1=0;
int newrange0=0;
int eligiblecnt=0;
bool permready;
//--- check
if(!CAp::Assert(CSparse::SparseIsCRS(A),__FUNCTION__+": A is not stored in CRS format"))
return(false);
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": non-square A"))
return(false);
if(!CAp::Assert(FactType==0 || FactType==1,__FUNCTION__+": unexpected FactType"))
return(false);
if(!CAp::Assert((PermType>=-3 && PermType<=3),__FUNCTION__+": unexpected PermType"))
return(false);
n=CSparse::SparseGetNRows(A);
if(PermType==-3 || PermType==3)
{
//--- check
if(!CAp::Assert(CAp::Len(Priorities)>=n,__FUNCTION__+": length(Priorities)<N"))
return(false);
CAblasF::ICopyAllocV(n,Priorities,Analysis.m_CurPriorities);
}
if(PermType==0)
{
CAblasF::ISetAllocV(n,0,Analysis.m_CurPriorities);
PermType=3;
}
Analysis.m_TaskType=0;
Analysis.m_N=n;
Analysis.m_UnitD=(FactType==0);
Analysis.m_PermType=PermType;
Analysis.m_ExtendedDebug=(CAp::IsTraceEnabled("DEBUG.SLOW") && n <= 100);
Analysis.m_Dotrace=CAp::IsTraceEnabled("SCHOLESKY");
Analysis.m_DotraceSupernodalStructure=(Analysis.m_Dotrace && CAp::IsTraceEnabled("SCHOLESKY.SS"));
Analysis.m_IsTopologicalOrdering=(PermType==-1 || PermType==1);
Analysis.m_ApplyPermutationToOutput=(PermType==-1);
Analysis.m_ModType=0;
Analysis.m_ModParam0=0.0;
Analysis.m_ModParam1=0.0;
Analysis.m_ModParam2=0.0;
Analysis.m_ModParam3=0.0;
//--- Allocate temporaries
CApServ::IVectorSetLengthAtLeast(Analysis.m_TmpParent,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp0,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp1,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp2,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp3,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp4,n+1);
CApServ::BVectorSetLengthAtLeast(Analysis.m_FlagArray,n+1);
//--- Initial Trace message
if(Analysis.m_Dotrace)
{
CAp::Trace("\n\n");
CAp::Trace("////////////////////////////////////////////////////////////////////////////////////////////////////\n");
CAp::Trace("//--- SPARSE CHOLESKY ANALYSIS STARTED //\n");
CAp::Trace("////////////////////////////////////////////////////////////////////////////////////////////////////\n");
//--- Nonzeros count of the original matrix
k=0;
for(i=0; i<n; i++)
k=k+(A.m_DIdx[i]-A.m_RIdx[i])+1;
CAp::Trace(StringFormat("NZ(A) = %d\n",k));
//--- Analyze row statistics
CAp::Trace("=== ANALYZING ROW STATISTICS =======================================================================\n");
CAp::Trace("row size is:\n");
CAblasF::ISetV(n,1,Analysis.m_Tmp0);
for(i=0; i<n; i++)
{
for(jj=A.m_RIdx[i]; jj<A.m_DIdx[i]; jj++)
{
j=A.m_Idx[jj];
Analysis.m_Tmp0.Add(i,1);
Analysis.m_Tmp0.Add(j,1);
}
}
k=1;
while(k<=n)
{
j=0;
for(i=0; i<n; i++)
if(Analysis.m_Tmp0[i]>=k && Analysis.m_Tmp0[i]<2*k)
j++;
CAp::Trace(StringFormat("* [%d..%d) elements: %d rows\n",k,2 * k,j));
k=k*2;
}
}
//--- Initial integrity check - diagonal MUST be symbolically nonzero
for(i=0; i<n; i++)
{
if(A.m_DIdx[i]==A.m_UIdx[i])
{
if(Analysis.m_Dotrace)
CAp::Trace("> the matrix diagonal is symbolically zero,stopping");
return(false);
}
}
//--- What type of permutation do we have?
if(Analysis.m_IsTopologicalOrdering)
{
//--- check
if(!CAp::Assert(PermType==-1 || PermType==1,__FUNCTION__+": integrity check failed (ihebd)"))
return(false);
//--- Build topologically ordered elimination tree
BuildOrderedeTree(A,n,Analysis.m_TmpParent,Analysis.m_SuperPerm,Analysis.m_InvSuperPerm,
Analysis.m_Tmp0,Analysis.m_Tmp1,Analysis.m_Tmp2,Analysis.m_FlagArray);
CApServ::IVectorSetLengthAtLeast(Analysis.m_FillinPerm,n);
CApServ::IVectorSetLengthAtLeast(Analysis.m_InvFillinPerm,n);
CApServ::IVectorSetLengthAtLeast(Analysis.m_EffectivePerm,n);
CApServ::IVectorSetLengthAtLeast(Analysis.m_InvEffectivePerm,n);
for(i=0; i<n; i++)
{
Analysis.m_FillinPerm.Set(i,i);
Analysis.m_InvFillinPerm.Set(i,i);
Analysis.m_EffectivePerm.Set(i,Analysis.m_SuperPerm[i]);
Analysis.m_InvEffectivePerm.Set(i,Analysis.m_InvSuperPerm[i]);
}
//--- Reorder input matrix
TopologicalPermutation(A,Analysis.m_SuperPerm,Analysis.m_TmpAt);
//--- Analyze etree, build supernodal structure
CreateSupernodalStructure(Analysis.m_TmpAt,Analysis.m_TmpParent,n,Analysis,Analysis.m_Node2Supernode,Analysis.m_Tmp0,
Analysis.m_Tmp1,Analysis.m_Tmp2,Analysis.m_Tmp3,Analysis.m_Tmp4,Analysis.m_FlagArray);
//--- Having fully initialized supernodal structure, analyze dependencies
AnalyzeSupernodalDependencies(Analysis,A,Analysis.m_Node2Supernode,n,Analysis.m_Tmp0,Analysis.m_Tmp1,Analysis.m_FlagArray);
}
else
{
//Analysis.Trace();
//--- Generate fill-in reducing permutation
permready=false;
if(PermType==-2)
{
GenerateDbgPermutation(A,n,Analysis.m_FillinPerm,Analysis.m_InvFillinPerm);
permready=true;
}
if(PermType==2)
{
CAmdOrdering::GenerateAmdPermutation(A,n,Analysis.m_FillinPerm,Analysis.m_InvFillinPerm,Analysis.m_AmdTmp);
permready=true;
}
if(PermType==3 || PermType==-3)
{
if(!CAp::Assert(CAp::Len(Analysis.m_CurPriorities)>=n,__FUNCTION__+": integrity check failed (4653)"))
return(false);
//--- Perform iterative AMD, with nearly-dense columns being postponed to be handled later.
//--- The current (residual) matrix A is divided into two parts: Head, with its columns being
//--- properly ordered, and Tail, with its columns being reordered at the next iteration.
//--- After each partial AMD we compute sparsity pattern of the Tail, set it as the new residual
//--- and repeat iteration.
CAblasF::IAllocV(n,Analysis.m_FillinPerm);
CAblasF::IAllocV(n,Analysis.m_InvFillinPerm);
CAblasF::IAllocV(n,Analysis.m_TmpPerm);
CAblasF::IAllocV(n,Analysis.m_InvTmpPerm);
for(i=0; i<n; i++)
{
Analysis.m_FillinPerm.Set(i,i);
Analysis.m_InvFillinPerm.Set(i,i);
}
//Analysis.Trace();
CSparse::SparseCopyBuf(A,Analysis.m_TmpA);
//Analysis.Trace();
CAblasF::BAllocV(n,Analysis.m_Eligible);
//Analysis.Trace();
range0=0;
range1=n;
while(range0<range1)
{
m=range1-range0;
//--- Perform partial AMD ordering of the residual matrix:
//--- * determine columns in the residual part that are eligible for elimination.
//--- * generate partial fill-in reducing permutation (leading Residual-Tail columns
//--- are properly ordered, the rest is unordered).
//--- * update column elimination priorities (decrease by 1)
CAblasF::BSetV(range1-range0,false,Analysis.m_Eligible);
//Analysis.Trace();
eligiblecnt=0;
for(i=0; i<n; i++)
{
j=Analysis.m_FillinPerm[i];
if((j>=range0 && j<range1) && Analysis.m_CurPriorities[i]<=0)
{
Analysis.m_Eligible[j-range0]=true;
eligiblecnt++;
}
}
//Analysis.Trace();
if(Analysis.m_Dotrace)
CAp::Trace(StringFormat("> multiround AMD,column_range=[%d,%d] (%d out of %d),%5.1f%% eligible\n",range0,range1,range1 - range0,n,(double)(100 * eligiblecnt) / (double)m));
newrange0=range0+CAmdOrdering::GenerateAmdPermutationX(Analysis.m_TmpA,Analysis.m_Eligible,range1-range0,Analysis.m_TmpPerm,Analysis.m_InvTmpPerm,1,Analysis.m_AmdTmp);
//Analysis.Trace();
if(PermType==-3)
{
//--- Special debug ordering in order to test correctness of multiple AMD rounds
newrange0=MathMin(newrange0,range0+m/2+1);
}
//Analysis.Trace();
Analysis.m_CurPriorities-=1;
//--- If there were columns that both eligible and sparse enough,
//--- apply permutation and recompute trail.
if(newrange0>range0)
{
//--- Apply permutation TmpPerm[] to the Tail of the permutation FillInPerm[]
for(i=0; i<m; i++)
Analysis.m_FillinPerm.Set(Analysis.m_InvFillinPerm[range0+Analysis.m_InvTmpPerm[i]],range0+i);
//Analysis.Trace();
for(i=0; i<n; i++)
Analysis.m_InvFillinPerm.Set(Analysis.m_FillinPerm[i],i);
//Analysis.Trace();
//--- Compute partial Cholesky of the trailing submatrix (after applying rank-K update to the
//--- trailing submatrix but before Cholesky-factorizing it).
if(newrange0<range1)
{
CSparse::SparseSymmPermTblBuf(Analysis.m_TmpA,false,Analysis.m_TmpPerm,Analysis.m_TmpA2);
//Analysis.Trace();
PartialCholeskyPattern(Analysis.m_TmpA2,newrange0-range0,range1-newrange0,Analysis.m_TmpA,Analysis.m_TmpParent,
Analysis.m_Tmp0,Analysis.m_Tmp1,Analysis.m_Tmp2,Analysis.m_FlagArray,Analysis.m_TmpBottomT,
Analysis.m_TmpUpdateT,Analysis.m_TmpUpdate,Analysis.m_TmpNewTailT);
//Analysis.Trace();
if(Analysis.m_ExtendedDebug)
SlowDebugChecks(A,Analysis.m_FillinPerm,n,range1-newrange0,Analysis.m_TmpA);
//Analysis.Trace();
}
range0=newrange0;
m=range1-range0;
}
//--- Analyze sparsity pattern of the current submatrix (TmpA), manually move completely dense rows to the end.
if(m>0)
{
if(!CAp::Assert((Analysis.m_TmpA.m_M==m && Analysis.m_TmpA.m_N==m) && Analysis.m_TmpA.m_NInitialized==Analysis.m_TmpA.m_RIdx[m],__FUNCTION__+": integrity check failed (0572)"))
return(false);
CAblasF::ISetAllocV(m,1,Analysis.m_Tmp0);
for(i=0; i<m; i++)
{
j0=Analysis.m_TmpA.m_RIdx[i];
j1=Analysis.m_TmpA.m_DIdx[i]-1;
for(jj=j0; jj<=j1; jj++)
{
j=Analysis.m_TmpA.m_Idx[jj];
Analysis.m_Tmp0.Add(i,1);
Analysis.m_Tmp0.Add(j,1);
}
}
//Analysis.Trace();
j=0;
k=0;
for(i=0; i<m; i++)
{
if(Analysis.m_Tmp0[i]<m)
{
Analysis.m_InvTmpPerm.Set(j,i);
j++;
}
}
//Analysis.Trace();
for(i=0; i<=m-1; i++)
{
if(Analysis.m_Tmp0[i]==m)
{
Analysis.m_InvTmpPerm.Set(j,i);
j++;
k++;
}
}
//Analysis.Trace();
for(i=0; i<m; i++)
Analysis.m_TmpPerm.Set(Analysis.m_InvTmpPerm[i],i);
//Analysis.Trace();
//--- check
if(!CAp::Assert(j==m,__FUNCTION__+": integrity check failed (6432)"))
return(false);
if(k>0)
{
//--- K dense rows are moved to the end
if(k<m)
{
//--- There are still exist sparse rows that need reordering, apply permutation and manually truncate matrix
for(i=0; i<m; i++)
Analysis.m_FillinPerm.Set(Analysis.m_InvFillinPerm[range0+Analysis.m_InvTmpPerm[i]],range0+i);
//Analysis.Trace();
for(i=0; i<n; i++)
Analysis.m_InvFillinPerm.Set(Analysis.m_FillinPerm[i],i);
//Analysis.Trace();
CSparse::SparseSymmPermTblBuf(Analysis.m_TmpA,false,Analysis.m_TmpPerm,Analysis.m_TmpA2);
//Analysis.Trace();
CSparse::SparseCopyBuf(Analysis.m_TmpA2,Analysis.m_TmpA);
//Analysis.Trace();
Analysis.m_TmpA.m_M=m-k;
Analysis.m_TmpA.m_N=m-k;
Analysis.m_TmpA.m_NInitialized=Analysis.m_TmpA.m_RIdx[Analysis.m_TmpA.m_M];
//Analysis.Trace();
}
range1=range1-k;
m=range1-range0;
}
}
}
if(Analysis.m_Dotrace)
CAp::Trace(StringFormat("> multiround AMD,column_range=[%d,%d],stopped\n",range0,range1));
//Analysis.Trace();
permready=true;
}
//--- check
if(!CAp::Assert(permready,__FUNCTION__+": integrity check failed (pp4td)"))
return(false);
//--- Apply permutation to the matrix, perform analysis on the initially reordered matrix
//--- (we may need one more reordering, now topological one, due to supernodal analysis).
//--- Build topologically ordered elimination tree
CSparse::SparseSymmPermTblBuf(A,false,Analysis.m_FillinPerm,Analysis.m_TmpA);
//Analysis.Trace();
BuildOrderedeTree(Analysis.m_TmpA,n,Analysis.m_TmpParent,Analysis.m_SuperPerm,Analysis.m_InvSuperPerm,Analysis.m_Tmp0,
Analysis.m_Tmp1,Analysis.m_Tmp2,Analysis.m_FlagArray);
//Analysis.Trace();
CApServ::IVectorSetLengthAtLeast(Analysis.m_EffectivePerm,n);
CApServ::IVectorSetLengthAtLeast(Analysis.m_InvEffectivePerm,n);
for(i=0; i<n; i++)
{
Analysis.m_EffectivePerm.Set(i,Analysis.m_SuperPerm[Analysis.m_FillinPerm[i]]);
Analysis.m_InvEffectivePerm.Set(Analysis.m_EffectivePerm[i],i);
}
//Analysis.Trace();
//--- Reorder input matrix
TopologicalPermutation(Analysis.m_TmpA,Analysis.m_SuperPerm,Analysis.m_TmpAt);
//Analysis.Trace();
//--- Analyze etree, build supernodal structure
CreateSupernodalStructure(Analysis.m_TmpAt,Analysis.m_TmpParent,n,Analysis,Analysis.m_Node2Supernode,Analysis.m_Tmp0,
Analysis.m_Tmp1,Analysis.m_Tmp2,Analysis.m_Tmp3,Analysis.m_Tmp4,Analysis.m_FlagArray);
//Analysis.Trace();
//--- Having fully initialized supernodal structure, analyze dependencies
AnalyzeSupernodalDependencies(Analysis,Analysis.m_TmpA,Analysis.m_Node2Supernode,n,Analysis.m_Tmp0,Analysis.m_Tmp1,
Analysis.m_FlagArray);
//Analysis.Trace();
}
//--- Save information for integrity checks
CAblasF::ICopyAllocV(n+1,Analysis.m_TmpAt.m_RIdx,Analysis.m_ReferenceRIdx);
//--- Load matrix into the supernodal storage
LoadMatrix(Analysis,Analysis.m_TmpAt);
//Analysis.Trace();
return(result);
}
//+------------------------------------------------------------------+
//| Sets modified Cholesky type |
//| INPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure |
//| ModStrategy - modification type: |
//| * 0 for traditional Cholesky/LDLT (Cholesky fails when|
//| encounters nonpositive pivot, LDLT fails when zero|
//| pivot is encountered, no stability checks for|
//| overflows/underflows) |
//| * 1 for modified Cholesky with additional checks: |
//| * pivots less than ModParam0 are increased; (similar |
//| procedure with proper generalization is applied to |
//| LDLT) |
//| * if, at some moment, sum of absolute values of |
//| elements in column J will become greater than |
//| ModParam1, Cholesky/LDLT will treat it as failure |
//| and will stop immediately |
//| * if ModParam0 is zero, no pivot modification is |
//| applied |
//| * if ModParam1 is zero, no overflow check is performed|
//| P0, P1, P2,P3 - modification parameters #0 #1, #2 and #3. |
//| Params #2 and #3 are ignored in current version.|
//| OUTPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure, new |
//| strategy (results will be seen with next |
//| SPSymmFactorize() call) |
//+------------------------------------------------------------------+
void CSpChol::SpSymmSetModificationStrategy(CSpCholAnalysis &Analysis,
int ModStrategy,
double P0,
double P1,
double P2,
double P3)
{
//--- check
if(!CAp::Assert(ModStrategy==0 || ModStrategy==1,__FUNCTION__+": unexpected ModStrategy"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(P0) && P0>=0.0,__FUNCTION__+": bad P0"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(P1),__FUNCTION__+": bad P1"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(P2),__FUNCTION__+": bad P2"))
return;
//--- check
if(!CAp::Assert(CMath::IsFinite(P3),__FUNCTION__+": bad P3"))
return;
Analysis.m_ModType=ModStrategy;
Analysis.m_ModParam0=P0;
Analysis.m_ModParam1=P1;
Analysis.m_ModParam2=P2;
Analysis.m_ModParam3=P3;
}
//+------------------------------------------------------------------+
//| Updates symmetric matrix internally stored in previously |
//| initialized Analysis object. |
//| You can use this function to perform multiple factorizations with|
//| same sparsity patterns: perform symbolic analysis once with |
//| SPSymmAnalyze(), then update internal matrix with SPSymmReload() |
//| and call SPSymmFactorize(). |
//| INPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure |
//| A - sparse square matrix in CRS format with LOWER |
//| triangle being used to store the matrix. The matrix|
//| MUST have sparsity pattern exactly same as one used|
//| to initialize the Analysis object. |
//| The algorithm will fail in an unpredictable way ifsomething |
//| different was passed. |
//| OUTPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure which |
//| will be used later to guide numerical factorization|
//| The numerical values are stored internally in the |
//| structure, but you have to run factorization phase |
//| explicitly with SPSymmAnalyze(). You can also |
//| reload another matrix with same sparsity pattern |
//| with SpSymmReload(). |
//+------------------------------------------------------------------+
void CSpChol::SpSymmReload(CSpCholAnalysis &Analysis,
CSparseMatrix &A)
{
//--- check
if(!CAp::Assert(CSparse::SparseIsCRS(A),__FUNCTION__+": A is not stored in CRS format"))
return;
//--- check
if(!CAp::Assert(CSparse::SparseGetNRows(A)==CSparse::SparseGetNCols(A),__FUNCTION__+": non-square A"))
return;
if(Analysis.m_IsTopologicalOrdering)
{
//--- Topological (fill-in preserving) ordering is used, we can copy
//--- A directly into WrkAT using joint permute+transpose
TopologicalPermutation(A,Analysis.m_EffectivePerm,Analysis.m_TmpAt);
LoadMatrix(Analysis,Analysis.m_TmpAt);
}
else
{
//--- Non-topological permutation; first we perform generic symmetric
//--- permutation, then transpose result
CSparse::SparseSymmPermTblBuf(A,false,Analysis.m_EffectivePerm,Analysis.m_TmpA);
CSparse::SparseCopyToCRSBuf(Analysis.m_TmpA,Analysis.m_TmpAt);
LoadMatrix(Analysis,Analysis.m_TmpAt);
}
}
//+------------------------------------------------------------------+
//| Updates diagonal of the symmetric matrix internally stored in the|
//| previously initialized Analysis object. |
//| When only diagonal of the matrix has changed, this function is |
//| more efficient than SpSymmReload() that has to perform costly |
//| permutation of the entire matrix. |
//| You can use this function to perform multiple factorizations with|
//| same off - diagonal elements: perform symbolic analysis once with|
//| SpSymmAnalyze(), then update diagonal with SpSymmReloadDiagonal()|
//| and call SpSymmFactorize(). |
//| INPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure |
//| D - array[N], diagonal factor |
//| OUTPUT PARAMETERS: |
//| Analysis - symbolic analysis of the matrix structure which |
//| will be used later to guide numerical factorization|
//| The numerical values are stored internally in the |
//| structure, but you have to run factorization phase |
//| explicitly with SpSymmAnalyze(). You can also |
//| reload another matrix with same sparsity pattern |
//| with SpSymmReload(). |
//+------------------------------------------------------------------+
void CSpChol::SpSymmReloadDiagonal(CSpCholAnalysis &Analysis,
CRowDouble &d)
{
//--- create variables
int SIdx=0;
int Cols0=0;
int Cols1=0;
int OffsS=0;
int sstride=0;
//--- check
if(!CAp::Assert(CAp::Len(d)>=Analysis.m_N,__FUNCTION__+": length(D)<N"))
return;
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
OffsS=Analysis.m_RowOffSets[SIdx];
sstride=Analysis.m_RowStrides[SIdx];
for(int j=Cols0; j<Cols1; j++)
Analysis.m_InputStorage.Set(OffsS+(j-Cols0)*sstride+(j-Cols0),d[Analysis.m_InvEffectivePerm[j]]);
}
}
//+------------------------------------------------------------------+
//| Sparse Cholesky factorization of symmetric matrix stored in CRS |
//| format, using precomputed analysis of the sparsity pattern stored|
//| in the Analysis object and specific numeric values that are |
//| presently loaded into the Analysis. |
//| The factorization can be retrieved with SpSymmExtract(). |
//| Alternatively, one can perform some operations without offloading|
//| the matrix(somewhat faster due to itilization of SIMD - friendly |
//| supernodal data structures), most importantly - linear system |
//| solution with SPSymmSolve(). |
//| Depending on settings specified during factorization, may produce|
//| vanilla Cholesky or L*D*LT decomposition (with strictly diagonal |
//| D), without permutation or with permutation P(being either |
//| topological ordering or sparsity preserving ordering). |
//| Thus, A is represented as either L*LT or L*D*LT or P*L*LT*PT or |
//| P*L*D*LT*PT. |
//| NOTE: L*D*LT family of factorization may be used to factorize |
//| indefinite matrices. However, numerical stability is |
//| guaranteed ONLY for a class of quasi - definite matrices. |
//| INPUT PARAMETERS: |
//| Analysis - prior analysis performed on some sparse matrix, |
//| with matrix being stored in Analysis. |
//| OUTPUT PARAMETERS: |
//| Analysis - contains factorization results |
//| The function returns True when factorization resulted in |
//| nondegenerate matrix. False is returned when factorization fails |
//| (Cholesky factorization of indefinite matrix) or LDLT |
//| factorization has exactly zero elements at the diagonal. |
//+------------------------------------------------------------------+
bool CSpChol::SpSymmFactorize(CSpCholAnalysis &Analysis)
{
//--- create variables
int i= 0;
int k= 0;
int ii= 0;
int n=Analysis.m_N;
int Cols0= 0;
int Cols1= 0;
int OffsS= 0;
int blocksize=0;
int SIdx= 0;
int UIdx= 0;
//--- check
if(!CAp::Assert(Analysis.m_TaskType==0,__FUNCTION__+": Analysis type does not match current task"))
return(false);
//--- Prepare structures:
//--- * WrkRows[] store pointers to beginnings of the offdiagonal supernode row ranges;
//--- at the beginning of the work WrkRows[]=0, but as we advance from the column
//--- range [0,A) to [A,B), to [B,C) and so on, we advance WrkRows[] in order to
//--- quickly skip parts that are less than A, less than B, less than C and so on.
CApServ::IVectorSetLengthAtLeast(Analysis.m_Raw2Smap,n);
CApServ::IVectorSetLengthAtLeast(Analysis.m_Tmp0,n+1);
CAblasF::BSetAllocV(n,false,Analysis.m_FlagArray);
CAblasF::ISetAllocV(Analysis.m_NSuper,0,Analysis.m_WrkRows);
CAblasF::RSetAllocV(n,0.0,Analysis.m_DiagD);
CAblasF::RCopyAllocV(Analysis.m_RowOffSets[Analysis.m_NSuper],Analysis.m_InputStorage,Analysis.m_OutputStorage);
//--- Now we can run actual supernodal Cholesky
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
blocksize=Cols1-Cols0;
OffsS=Analysis.m_RowOffSets[SIdx];
//--- Prepare mapping of raw (range 0...N-1) indexes into internal (range 0...BlockSize+OffdiagSize-1) ones
if(Analysis.m_ExtendedDebug)
CAblasF::ISetV(n,-1,Analysis.m_Raw2Smap);
for(i=Cols0; i<Cols1; i++)
Analysis.m_Raw2Smap.Set(i,i-Cols0);
for(k=Analysis.m_SuperRowRIdx[SIdx]; k<Analysis.m_SuperRowRIdx[SIdx+1]; k++)
Analysis.m_Raw2Smap.Set(Analysis.m_SuperRowIdx[k],blocksize+(k-Analysis.m_SuperRowRIdx[SIdx]));
//--- Update current supernode with nonzeros from the current row
for(ii=Analysis.m_LAdjPlusR[SIdx]; ii<Analysis.m_LAdjPlusR[SIdx+1]; ii++)
{
UIdx=Analysis.m_LAdjPlus[ii];
Analysis.m_WrkRows.Set(UIdx,UpdateSupernode(Analysis,SIdx,Cols0,Cols1,OffsS,Analysis.m_Raw2Smap,UIdx,
Analysis.m_WrkRows[UIdx],Analysis.m_DiagD,Analysis.m_SuperColRange[UIdx]));
}
//--- Factorize current supernode
if(!FactorizeSupernode(Analysis,SIdx))
return(false);
}
return(true);
}
//+------------------------------------------------------------------+
//| Extracts result of the last Cholesky / LDLT factorization |
//| performed on the Analysis object. |
//| Following calls will result in the undefined behavior: |
//| * calling for Analysis that was not factorized with |
//| SpSymmFactorize() |
//| * calling after SpSymmFactorize() returned False |
//| INPUT PARAMETERS: |
//| Analysis - prior factorization performed on some sparse matrix|
//| D, P - possibly preallocated buffers |
//| OUTPUT PARAMETERS: |
//| A - Cholesky / LDLT decomposition of A stored in CRS |
//| format in LOWER triangle. |
//| D - array[N], diagonal factor. If no diagonal factor |
//| was required during analysis phase, still returned |
//| but filled with units. |
//| P - array[N], pivots. Permutation matrix P is a product|
//| of P(0)*P(1)*...*P(N - 1), where P(i) is a |
//| permutation of row/col I and P[I](with P[I] >= I). |
//| If no permutation was requested during analysis |
//| phase, still returned but filled with unit elements|
//+------------------------------------------------------------------+
void CSpChol::SpSymmExtract(CSpCholAnalysis &Analysis,
CSparseMatrix &A,
CRowDouble &d,
CRowInt &p)
{
ExtractMatrix(Analysis,Analysis.m_RowOffSets,Analysis.m_RowStrides,Analysis.m_OutputStorage,Analysis.m_DiagD,Analysis.m_N,
A,d,p,Analysis.m_Tmp0);
}
//+------------------------------------------------------------------+
//| Solve linear system A*x = b, using internally stored |
//| factorization of the matrix A. |
//| Works faster than extracting the matrix and solving with |
//| SparseTRSV() due to SIMD - friendly supernodal data structures |
//| being used. |
//| INPUT PARAMETERS: |
//| Analysis - prior factorization performed on some sparse matrix|
//| B - array[N], right - hand side |
//| OUTPUT PARAMETERS: |
//| B - overwritten by X |
//+------------------------------------------------------------------+
void CSpChol::SpSymmSolve(CSpCholAnalysis &Analysis,
CRowDouble &b)
{
//--- create variables
int i=0;
int j=0;
int k=0;
double v=0;
int baseoffs=0;
int Cols0=0;
int Cols1=0;
int OffsS=0;
int sstride=0;
int SIdx=0;
int blocksize=0;
int rbase=0;
int offdiagsize=0;
int n=Analysis.m_N;
int simdwidth=1;
CAblasF::RSetAllocV(n,0.0,Analysis.m_TmpX);
//--- Handle left-hand side permutation, convert data to internal SIMD-friendly format
CAblasF::RSetAllocV(n*simdwidth,0.0,Analysis.m_SimdBuf);
for(i=0; i<n; i++)
Analysis.m_SimdBuf.Set(i*simdwidth,b[Analysis.m_InvEffectivePerm[i]]);
//--- Solve for L*tmp_x=rhs.
//--- The RHS (original and temporary updates) is stored in the SIMD-friendly SIMDBuf which
//--- stores RHS as unevaluated sum of SIMDWidth numbers (this format allows easy updates
//--- with SIMD intrinsics), the result is written into TmpX (traditional contiguous storage).
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
blocksize=Cols1-Cols0;
OffsS=Analysis.m_RowOffSets[SIdx];
sstride=Analysis.m_RowStrides[SIdx];
rbase=Analysis.m_SuperRowRIdx[SIdx];
offdiagsize=Analysis.m_SuperRowRIdx[SIdx+1]-rbase;
//--- Solve for variables in the supernode
for(i=Cols0; i<Cols1; i++)
{
baseoffs=OffsS+(i-Cols0)*sstride-Cols0;
v=0;
for(j=0; j<simdwidth; j++)
v=v+Analysis.m_SimdBuf[i*simdwidth+j];
for(j=Cols0; j<i; j++)
v=v-Analysis.m_OutputStorage[baseoffs+j]*Analysis.m_TmpX[j];
Analysis.m_TmpX.Set(i,v/Analysis.m_OutputStorage[baseoffs+i]);
}
//--- Propagate update to other variables
for(k=0; k<offdiagsize; k++)
{
i=Analysis.m_SuperRowIdx[rbase+k];
baseoffs=OffsS+(k+blocksize)*sstride;
v=Analysis.m_SimdBuf[i*simdwidth];
for(j=0; j<blocksize; j++)
v=v-Analysis.m_OutputStorage[baseoffs+j]*Analysis.m_TmpX[Cols0+j];
Analysis.m_SimdBuf.Set(i*simdwidth,v);
}
}
//--- Solve for D*tmp_x=rhs.
for(i=0; i<n; i++)
{
if(Analysis.m_DiagD[i]!=0.0)
Analysis.m_TmpX.Set(i,Analysis.m_TmpX[i]/Analysis.m_DiagD[i]);
else
Analysis.m_TmpX.Set(i,0.0);
}
//--- Solve for L'*tmp_x=rhs
for(SIdx=Analysis.m_NSuper-1; SIdx>=0; SIdx--)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
blocksize=Cols1-Cols0;
OffsS=Analysis.m_RowOffSets[SIdx];
sstride=Analysis.m_RowStrides[SIdx];
rbase=Analysis.m_SuperRowRIdx[SIdx];
offdiagsize=Analysis.m_SuperRowRIdx[SIdx+1]-rbase;
//--- Subtract already computed variables
for(k=0; k<offdiagsize; k++)
{
baseoffs=OffsS+(k+blocksize)*sstride;
v=Analysis.m_TmpX[Analysis.m_SuperRowIdx[rbase+k]];
for(j=0; j<blocksize; j++)
Analysis.m_TmpX.Add(Cols0+j,-Analysis.m_OutputStorage[baseoffs+j]*v);
}
//--- Solve for variables in the supernode
for(i=blocksize-1; i>=0; i--)
{
baseoffs=OffsS+i*sstride;
v=Analysis.m_TmpX[Cols0+i]/Analysis.m_OutputStorage[baseoffs+i];
for(j=0; j<i; j++)
Analysis.m_TmpX.Add(Cols0+j,-v*Analysis.m_OutputStorage[baseoffs+j]);
Analysis.m_TmpX.Set(Cols0+i,v);
}
}
//--- Handle right-hand side permutation, convert data to internal SIMD-friendly format
for(i=0; i<n; i++)
b.Set(i,Analysis.m_TmpX[Analysis.m_EffectivePerm[i]]);
}
//+------------------------------------------------------------------+
//| Compares diag(L*L') with that of the original A and returns two |
//| metrics: |
//| * SumSq - sum of squares of diag(A) |
//| * ErrSq - sum of squared errors, i.e. Frobenius norm of |
//| diag(L*L')-diag(A) |
//| These metrics can be used to check accuracy of the factorization.|
//| INPUT PARAMETERS: |
//| Analysis - prior factorization performed on some sparse matrix|
//| OUTPUT PARAMETERS: |
//| SumSq, ErrSq - diagonal magnitude and absolute diagonal error |
//+------------------------------------------------------------------+
void CSpChol::SpSymmDiagErr(CSpCholAnalysis &Analysis,double &SumSq,
double &ErrSq)
{
//--- create variables
double v=0;
double vv=0;
int simdwidth=1;
int baseoffs=0;
int Cols0=0;
int Cols1=0;
int OffsS=0;
int sstride=0;
int SIdx=0;
int blocksize=0;
int rbase=0;
int offdiagsize=0;
int i=0;
int j=0;
int k=0;
int n=Analysis.m_N;
SumSq=0;
ErrSq=0;
//--- Scan L, compute diag(L*L')
CAblasF::RSetAllocV(simdwidth*n,0.0,Analysis.m_SimdBuf);
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
blocksize=Cols1-Cols0;
OffsS=Analysis.m_RowOffSets[SIdx];
sstride=Analysis.m_RowStrides[SIdx];
rbase=Analysis.m_SuperRowRIdx[SIdx];
offdiagsize=Analysis.m_SuperRowRIdx[SIdx+1]-rbase;
//--- Handle triangular diagonal block
for(i=Cols0; i<Cols1; i++)
{
baseoffs=OffsS+(i-Cols0)*sstride-Cols0;
v=0;
for(j=0; j<simdwidth; j++)
v+=Analysis.m_SimdBuf[i*simdwidth+j];
for(j=Cols0; j<=i; j++)
{
vv=Analysis.m_OutputStorage[baseoffs+j];
v+=vv*vv*Analysis.m_DiagD[j];
}
SumSq+=CMath::Sqr(Analysis.m_InputStorage[baseoffs+i]);
ErrSq+=CMath::Sqr(Analysis.m_InputStorage[baseoffs+i]-v);
}
//--- Accumulate entries below triangular diagonal block
for(k=0; k<offdiagsize; k++)
{
i=Analysis.m_SuperRowIdx[rbase+k];
baseoffs=OffsS+(k+blocksize)*sstride;
v=Analysis.m_SimdBuf[i*simdwidth];
for(j=0; j<blocksize; j++)
{
vv=Analysis.m_OutputStorage[baseoffs+j];
v+=vv*vv*Analysis.m_DiagD[Cols0+j];
}
Analysis.m_SimdBuf.Set(i*simdwidth,v);
}
}
}
//+------------------------------------------------------------------+
//| This function generates test reodering used for debug purposes |
//| only |
//| INPUT PARAMETERS: |
//| A - lower triangular sparse matrix in CRS format |
//| N - problem size |
//| OUTPUT PARAMETERS: |
//| Perm - array[N], maps original indexes I to permuted |
//| indexes |
//| InvPerm - array[N], maps permuted indexes I to original |
//| indexes |
//+------------------------------------------------------------------+
void CSpChol::GenerateDbgPermutation(CSparseMatrix &A,int n,
CRowInt &Perm,CRowInt &InvPerm)
{
//--- create variables
int i=0;
int j0=0;
int j1=0;
int jj=0;
CRowDouble d;
CRowDouble tmpr;
CRowInt tmpperm;
//--- Initialize D by vertex degrees
CAblasF::RSetAllocV(n,0,d);
for(i=0; i<n; i++)
{
j0=A.m_RIdx[i];
j1=A.m_DIdx[i]-1;
d.Set(i,j1-j0+1);
for(jj=j0; jj<=j1; jj++)
d.Set(A.m_Idx[jj],d[A.m_Idx[jj]]+1);
}
//--- Prepare permutation that orders vertices by degrees
CAblasF::IAllocV(n,InvPerm);
for(i=0; i<n; i++)
InvPerm.Set(i,i);
CTSort::TagSortFastI(d,InvPerm,tmpr,tmpperm,n);
CAblasF::IAllocV(n,Perm);
for(i=0; i<n; i++)
Perm.Set(InvPerm[i],i);
}
//+------------------------------------------------------------------+
//| This function builds elimination tree in the original column |
//| order |
//| INPUT PARAMETERS |
//| A - lower triangular sparse matrix in CRS format |
//| N - problem size |
//| Parent, |
//| tAbove - preallocated temporary array, length at least N + 1|
//| no meaningful output is provided in these variables|
//| OUTPUT PARAMETERS |
//| Parent - array[N], Parent[I] contains index of parent of |
//| I - th column. - 1 is used to denote column with |
//| no parents. |
//+------------------------------------------------------------------+
void CSpChol::BuildUnorderedeTree(CSparseMatrix &A,int n,
CRowInt &Parent,CRowInt &tAbove)
{
//--- create variables
int r=0;
int abover=0;
int k=0;
int j0=0;
int j1=0;
int jj=0;
//--- check
if(!CAp::Assert(CAp::Len(Parent)>n,__FUNCTION__+": input buffer Parent is too short"))
return;
if(!CAp::Assert(CAp::Len(tAbove)>n,__FUNCTION__+": input buffer tAbove is too short"))
return;
//--- Build elimination tree using Liu's algorithm with path compression
for(int j=0; j<n; j++)
{
Parent.Set(j,n);
tAbove.Set(j,n);
j0=A.m_RIdx[j];
j1=A.m_DIdx[j]-1;
for(jj=j0; jj<=j1; jj++)
{
r=A.m_Idx[jj];
abover=tAbove[r];
while(abover<j)
{
k=abover;
tAbove.Set(r,j);
r=k;
abover=tAbove[r];
}
if(abover==n)
{
tAbove.Set(r,j);
Parent.Set(r,j);
}
}
}
//--- Convert to external format
for(int i=0; i<n; i++)
{
if(Parent[i]==n)
Parent.Set(i,-1);
}
}
//+------------------------------------------------------------------+
//| This function analyzes elimination tree stored using |
//|'parent-of-node' format and converts it to the 'childrens-of-node'|
//| format. |
//| INPUT PARAMETERS: |
//| Parent - array[N], supernodal etree |
//| N - problem size |
//| ChildrenR, |
//| ChildrenI, |
//| tTmp0 - preallocated arrays, length at least N + 1 |
//| OUTPUT PARAMETERS: |
//| ChildrenR- array[N + 1], children range(see below) |
//| ChildrenI- array[N + 1], childrens of K-th node are stored in |
//| the elements |
//| ChildrenI[ChildrenR[K]...ChildrenR[K + 1] - 1] |
//+------------------------------------------------------------------+
void CSpChol::FromParentToChildren(CRowInt &Parent,int n,
CRowInt &ChildrenR,
CRowInt &ChildrenI,
CRowInt &tTmp0)
{
//--- create variables
int i=0;
int k=0;
int nodeidx=0;
//--- check
if(!CAp::Assert(CAp::Len(tTmp0)>n,__FUNCTION__+": input buffer tTmp0 is too short"))
return;
if(!CAp::Assert(CAp::Len(ChildrenR)>n,__FUNCTION__+": input buffer ChildrenR is too short"))
return;
if(!CAp::Assert(CAp::Len(ChildrenI)>n,__FUNCTION__+": input buffer ChildrenI is too short"))
return;
//--- Convert etree from per-column parent array to per-column children list
CAblasF::ISetV(n,0,tTmp0);
for(i=0; i<n; i++)
{
nodeidx=Parent[i];
if(nodeidx>=0)
tTmp0.Set(nodeidx,tTmp0[nodeidx]+1);
}
ChildrenR.Set(0,0);
for(i=0; i<n; i++)
ChildrenR.Set(i+1,ChildrenR[i]+tTmp0[i]);
CAblasF::ISetV(n,0,tTmp0);
for(i=0; i<n; i++)
{
k=Parent[i];
if(k>=0)
{
ChildrenI.Set(ChildrenR[k]+tTmp0[k],i);
tTmp0.Set(k,tTmp0[k]+1);
}
}
}
//+------------------------------------------------------------------+
//| This function builds elimination tree and reorders it according |
//| to the topological post - ordering. |
//| INPUT PARAMETERS: |
//| A - lower triangular sparse matrix in CRS format |
//| N - problem size |
//| tRawParentOfRawNode, |
//| tRawParentOfReorderedNode, |
//| tTmp, |
//| tFlagArray - preallocated temporary arrays, length at least |
//| N + 1, no meaningful output is provided in these|
//| variables |
//| OUTPUT PARAMETERS: |
//| Parent - array[N], Parent[I] contains index of parent of |
//| I-th column(after topological reordering). -1 is|
//| used to denote column with no parents. |
//| SupernodalPermutation - array[N], maps original indexes I to |
//| permuted indexes |
//| InvSupernodalPermutation - array[N], maps permuted indexes I |
//| to original indexes |
//+------------------------------------------------------------------+
void CSpChol::BuildOrderedeTree(CSparseMatrix &A,int n,CRowInt &Parent,
CRowInt &SupernodalPermutation,
CRowInt &InvSupernodalPermutation,
CRowInt &tRawParentOfRawNode,
CRowInt &tRawParentOfReorderedNode,
CRowInt &tTmp,bool &tFlagArray[])
{
//--- create variables
int i=0;
int k=0;
int SIdx=0;
int unprocessedchildrencnt=0;
//--- check
if(!CAp::Assert(CAp::Len(tRawParentOfRawNode)>n,__FUNCTION__+": input buffer tRawParentOfRawNode is too short"))
return;
if(!CAp::Assert(CAp::Len(tTmp)>n,__FUNCTION__+": input buffer tTmp is too short"))
return;
if(!CAp::Assert(CAp::Len(tRawParentOfReorderedNode)>n,__FUNCTION__+": input buffer tRawParentOfReorderedNode is too short"))
return;
if(!CAp::Assert(CAp::Len(tFlagArray)>=n+1,__FUNCTION__+": input buffer tFlagArray is too short"))
return;
//--- Avoid spurious compiler warnings
//--- Build elimination tree with original column order
BuildUnorderedeTree(A,n,tRawParentOfRawNode,tTmp);
//--- Compute topological ordering of the elimination tree, produce:
//--- * direct and inverse permutations
//--- * reordered etree stored in Parent[]
CAblasF::ISetAllocV(n,-1,InvSupernodalPermutation);
CAblasF::ISetAllocV(n,-1,SupernodalPermutation);
CAblasF::ISetAllocV(n,-1,Parent);
CAblasF::ISetV(n,-1,tRawParentOfReorderedNode);
CAblasF::ISetV(n,0,tTmp);
for(i=0; i<n; i++)
{
k=tRawParentOfRawNode[i];
if(k>=0)
tTmp.Set(k,tTmp[k]+1);
}
CAblasF::BSetV(n,true,tFlagArray);
SIdx=0;
for(i=0; i<n; i++)
{
if(tFlagArray[i])
{
//--- Move column I to position SIdx, decrease unprocessed children count
SupernodalPermutation.Set(i,SIdx);
InvSupernodalPermutation.Set(SIdx,i);
tFlagArray[i]=false;
k=tRawParentOfRawNode[i];
tRawParentOfReorderedNode.Set(SIdx,k);
if(k>=0)
{
unprocessedchildrencnt=tTmp[k]-1;
tTmp.Set(k,unprocessedchildrencnt);
}
SIdx=SIdx+1;
//--- Add parents (as long as parent has no unprocessed children)
while(k>=0 && unprocessedchildrencnt==0)
{
SupernodalPermutation.Set(k,SIdx);
InvSupernodalPermutation.Set(SIdx,k);
tFlagArray[k]=false;
k=tRawParentOfRawNode[k];
tRawParentOfReorderedNode.Set(SIdx,k);
if(k>=0)
{
unprocessedchildrencnt=tTmp[k]-1;
tTmp.Set(k,unprocessedchildrencnt);
}
SIdx=SIdx+1;
}
}
}
for(i=0; i<n; i++)
{
k=tRawParentOfReorderedNode[i];
if(k>=0)
Parent.Set(i,SupernodalPermutation[k]);
}
}
//+------------------------------------------------------------------+
//| This function analyzes postordered elimination tree and creates |
//| supernodal structure in Analysis object. |
//| INPUT PARAMETERS: |
//| AT - upper triangular CRS matrix, transpose and |
//| reordering of the original input matrix A |
//| Parent - array[N], supernodal etree |
//| N - problem size |
//| tChildrenR, |
//| tChildrenI, |
//| tParentNodeOfSupernode, |
//| tNode2Supernode, |
//| tTmp0, |
//| tFlagArray - temporary arrays, length at least N + 1, simply |
//| provide preallocated place. |
//| OUTPUT PARAMETERS: |
//| Analysis - following fields are initialized: |
//| * Analysis.NSuper |
//| * Analysis.SuperColRange |
//| * Analysis.SuperRowRIdx |
//| * Analysis.SuperRowIdx |
//| * Analysis.ParentSupernode |
//| * Analysis.OutRowCounts |
//| other fields are ignored and not changed. |
//| Node2Supernode - array[N] that maps node indexes to supernode |
//| indexes |
//+------------------------------------------------------------------+
void CSpChol::CreateSupernodalStructure(CSparseMatrix &at,CRowInt &Parent,
int n,CSpCholAnalysis &Analysis,
CRowInt &Node2Supernode,
CRowInt &tChildrenR,
CRowInt &tChildrenI,
CRowInt &tParentNodeOfSupernode,
CRowInt &tFakeNonZeros,
CRowInt &tTmp0,
bool &tFlagArray[])
{
//--- create variables
int NSuper=0;
int i=0;
int j=0;
int k=0;
int sidx=0;
int i0=0;
int ii=0;
int ColumnIdx=0;
int nodeidx=0;
int rfirst=0;
int rlast=0;
int cols0=0;
int cols1=0;
int blocksize=0;
bool createsupernode;
int colcount=0;
int offdiagcnt=0;
int childcolcount=0;
int childoffdiagcnt=0;
int fakezerosinnewsupernode=0;
double mergeinefficiency=0;
bool hastheonlychild;
//--- check
if(!CAp::Assert(CAp::Len(tTmp0)>n,__FUNCTION__+": input buffer tTmp0 is too short"))
return;
if(!CAp::Assert(CAp::Len(tChildrenR)>n,__FUNCTION__+": input buffer ChildrenR is too short"))
return;
if(!CAp::Assert(CAp::Len(tChildrenI)>n,__FUNCTION__+": input buffer ChildrenI is too short"))
return;
if(!CAp::Assert(CAp::Len(tParentNodeOfSupernode)>n,__FUNCTION__+": input buffer tParentNodeOfSupernode is too short"))
return;
if(!CAp::Assert(CAp::Len(tFakeNonZeros)>n,__FUNCTION__+": input buffer tFakeNonzeros is too short"))
return;
if(!CAp::Assert(CAp::Len(tFlagArray)>n,__FUNCTION__+": input buffer tFlagArray is too short"))
return;
//--- Trace
if(Analysis.m_DotraceSupernodalStructure)
CAp::Trace("=== GENERATING SUPERNODAL STRUCTURE ================================================================\n");
//--- Convert etree from per-column parent array to per-column children list
FromParentToChildren(Parent,n,tChildrenR,tChildrenI,tTmp0);
//--- Analyze supernodal structure:
//--- * determine children count for each node
//--- * combine chains of children into supernodes
//--- * generate direct and inverse supernodal (topological) permutations
//--- * generate column structure of supernodes (after supernodal permutation)
CAblasF::ISetAllocV(n,-1,Node2Supernode);
CApServ::IVectorSetLengthAtLeast(Analysis.m_SuperColRange,n+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_SuperRowRIdx,n+1);
CAblasF::ISetV(n,n+1,tParentNodeOfSupernode);
CAblasF::BSetV(n,true,tFlagArray);
NSuper=0;
Analysis.m_SuperColRange.Set(0,0);
Analysis.m_SuperRowRIdx.Set(0,0);
while(Analysis.m_SuperColRange[NSuper]<n)
{
ColumnIdx=Analysis.m_SuperColRange[NSuper];
//--- Compute nonzero pattern of the column, create temporary standalone node
//--- for possible supernodal merge. Newly created node has just one column
//--- and no fake nonzeros.
rfirst=Analysis.m_SuperRowRIdx[NSuper];
rlast=ComputeNonzeroPattern(at,ColumnIdx,n,Analysis.m_SuperRowRIdx,Analysis.m_SuperRowIdx,NSuper,tChildrenR,tChildrenI,Node2Supernode,tFlagArray,tTmp0);
Analysis.m_SuperColRange.Set(NSuper+1,ColumnIdx+1);
Analysis.m_SuperRowRIdx.Set(NSuper+1,rlast);
Node2Supernode.Set(ColumnIdx,NSuper);
tParentNodeOfSupernode.Set(NSuper,Parent[ColumnIdx]);
tFakeNonZeros.Set(NSuper,0);
offdiagcnt=rlast-rfirst;
colcount=1;
NSuper++;
if(Analysis.m_DotraceSupernodalStructure)
{
CAp::Trace(StringFormat("> incoming column %d\n",ColumnIdx));
CAp::Trace(StringFormat("offdiagnnz = %d\n",rlast - rfirst));
CAp::Trace("children = [ ");
for(i=tChildrenR[ColumnIdx]; i<tChildrenR[ColumnIdx+1]; i++)
CAp::Trace(StringFormat("S%d ",Node2Supernode[tChildrenI[i]]));
CAp::Trace("]\n");
}
//--- Decide whether to merge column with previous supernode or not
childcolcount=0;
childoffdiagcnt=0;
mergeinefficiency=0.0;
fakezerosinnewsupernode=0;
createsupernode=false;
hastheonlychild=false;
if(NSuper>=2 && tParentNodeOfSupernode[NSuper-2]==ColumnIdx)
{
childcolcount=Analysis.m_SuperColRange[NSuper-1]-Analysis.m_SuperColRange[NSuper-2];
childoffdiagcnt=Analysis.m_SuperRowRIdx[NSuper-1]-Analysis.m_SuperRowRIdx[NSuper-2];
hastheonlychild=tChildrenR[ColumnIdx+1]-tChildrenR[ColumnIdx]==1;
if((hastheonlychild || m_RelaxedSupernodes) && colcount+childcolcount<=m_MaxSupernode)
{
i=colcount+childcolcount;
k=i*(i+1)/2+offdiagcnt*i;
fakezerosinnewsupernode=tFakeNonZeros[NSuper-2]+tFakeNonZeros[NSuper-1]+(offdiagcnt-(childoffdiagcnt-1))*childcolcount;
mergeinefficiency=(double)fakezerosinnewsupernode/(double)k;
if(colcount+childcolcount==2 && fakezerosinnewsupernode<=m_SmallFakesTolerance)
createsupernode=true;
if(mergeinefficiency<=m_MaxMergeinEfficiency)
createsupernode=true;
}
}
//--- Create supernode if needed
if(createsupernode)
{
//--- Create supernode from nodes NSuper-2 and NSuper-1.
//--- Because these nodes are in the child-parent relation, we can simply
//--- copy nonzero pattern from NSuper-1.
//--- check
if(!CAp::Assert(tParentNodeOfSupernode[NSuper-2]==ColumnIdx,__FUNCTION__+": integrity check 9472 failed"))
return;
i0=Analysis.m_SuperRowRIdx[NSuper-1];
ii=Analysis.m_SuperRowRIdx[NSuper]-Analysis.m_SuperRowRIdx[NSuper-1];
rfirst=Analysis.m_SuperRowRIdx[NSuper-2];
rlast=rfirst+ii;
for(i=0; i<=ii-1; i++)
Analysis.m_SuperRowIdx.Set(rfirst+i,Analysis.m_SuperRowIdx[i0+i]);
Analysis.m_SuperColRange.Set(NSuper-1,ColumnIdx+1);
Analysis.m_SuperRowRIdx.Set(NSuper-1,rlast);
Node2Supernode.Set(ColumnIdx,NSuper-2);
tFakeNonZeros.Set(NSuper-2,fakezerosinnewsupernode);
tParentNodeOfSupernode.Set(NSuper-2,Parent[ColumnIdx]);
NSuper--;
//--- Trace
if(Analysis.m_DotraceSupernodalStructure)
{
CAp::Trace(StringFormat("> merged with supernode S%d",NSuper - 1));
if(mergeinefficiency!=0.0)
CAp::Trace(StringFormat(" (%2.0f%% inefficiency)",mergeinefficiency * 100));
CAp::Trace("\n*\n");
}
}
else
{
//--- Trace
if(Analysis.m_DotraceSupernodalStructure)
CAp::Trace(StringFormat("> standalone node S%d created\n*\n",NSuper - 1));
}
}
Analysis.m_NSuper=NSuper;
//--- check
if(!CAp::Assert(Analysis.m_NSuper>=1,__FUNCTION__+": integrity check failed (95mgd)"))
return;
if(!CAp::Assert(Analysis.m_SuperColRange[0]==0,__FUNCTION__+": integrity check failed (f446s)"))
return;
if(!CAp::Assert(Analysis.m_SuperColRange[NSuper]==n,__FUNCTION__+": integrity check failed (04ut4)"))
return;
CAblasF::ISetAllocV(NSuper,-1,Analysis.m_ParentSupernode);
for(sidx=0; sidx<NSuper; sidx++)
{
nodeidx=tParentNodeOfSupernode[sidx];
if(nodeidx>=0)
{
nodeidx=Node2Supernode[nodeidx];
Analysis.m_ParentSupernode.Set(sidx,nodeidx);
}
}
//--- Allocate supernodal storage
CApServ::IVectorSetLengthAtLeast(Analysis.m_RowOffSets,Analysis.m_NSuper+1);
CApServ::IVectorSetLengthAtLeast(Analysis.m_RowStrides,Analysis.m_NSuper);
Analysis.m_RowOffSets.Set(0,0);
for(i=0; i<Analysis.m_NSuper; i++)
{
blocksize=Analysis.m_SuperColRange[i+1]-Analysis.m_SuperColRange[i];
Analysis.m_RowStrides.Set(i,RecommendedStrideFor(blocksize));
Analysis.m_RowOffSets.Set(i+1,Analysis.m_RowOffSets[i]+Analysis.m_RowStrides[i]*(blocksize+Analysis.m_SuperRowRIdx[i+1]-Analysis.m_SuperRowRIdx[i]));
Analysis.m_RowOffSets.Set(i+1,AlignPositionInArray(Analysis.m_RowOffSets[i+1]));
}
//--- Analyze output structure
CAblasF::ISetAllocV(n,0,Analysis.m_OutRowCounts);
for(sidx=0; sidx<NSuper; sidx++)
{
cols0=Analysis.m_SuperColRange[sidx];
cols1=Analysis.m_SuperColRange[sidx+1];
rfirst=Analysis.m_SuperRowRIdx[sidx];
rlast=Analysis.m_SuperRowRIdx[sidx+1];
blocksize=cols1-cols0;
for(j=cols0; j<cols1; j++)
Analysis.m_OutRowCounts.Add(j,j-cols0+1);
for(ii=rfirst; ii<rlast; ii++)
{
i0=Analysis.m_SuperRowIdx[ii];
Analysis.m_OutRowCounts.Add(i0,blocksize);
}
}
}
//+------------------------------------------------------------------+
//| This function analyzes supernodal structure and precomputes |
//| dependency matrix LAdj + |
//| INPUT PARAMETERS: |
//| Analysis - analysis object with completely initialized |
//| supernodal structure |
//| RawA - original(before reordering) input matrix |
//| Node2Supernode - mapping from node to supernode indexes |
//| N - problem size |
//| tTmp0, |
//| tTmp1, |
//| tFlagArray - temporary arrays, length at least N + 1, simply |
//| provide preallocated place. |
//| OUTPUT PARAMETERS: |
//| Analysis - following fields are initialized: |
//| * Analysis.LAdjPlus |
//| * Analysis.LAdjPlusR |
//| Node2Supernode - array[N] that maps node indexes to supernode |
//| indexes |
//+------------------------------------------------------------------+
void CSpChol::AnalyzeSupernodalDependencies(CSpCholAnalysis &Analysis,
CSparseMatrix &RawA,
CRowInt &Node2Supernode,
int n,CRowInt &tTmp0,
CRowInt &tTmp1,
bool &tFlagArray[])
{
//--- create variables
int i=0;
int j=0;
int rowidx=0;
int j0=0;
int j1=0;
int jj=0;
int rfirst=0;
int rlast=0;
int SIdx=0;
int UIdx=0;
int dbgnzl=0;
int dbgrank1nodes=0;
int dbgrank2nodes=0;
int dbgrank3nodes=0;
int dbgrank4nodes=0;
int dbgbignodes=0;
double dbgtotalflop=0;
double dbgnoscatterflop=0;
double dbgnorowscatterflop=0;
double dbgnocolscatterflop=0;
double dbgcholeskyflop=0;
double dbgcholesky4flop=0;
double dbgrank1flop=0;
double dbgrank4plusflop=0;
double dbg444flop=0;
double dbgxx4flop=0;
double uflop=0;
int WrkRow=0;
int offdiagrow=0;
int lastrow=0;
int UWidth=0;
int UHeight=0;
int urank=0;
int theight=0;
int tWidth=0;
//--- check
if(!CAp::Assert(CAp::Len(tTmp0)>n,__FUNCTION__+": input buffer tTmp0 is too short"))
return;
if(!CAp::Assert(CAp::Len(tTmp1)>n,__FUNCTION__+": input buffer tTmp1 is too short"))
return;
if(!CAp::Assert(CAp::Len(tFlagArray)>n,__FUNCTION__+": input buffer tTmp0 is too short"))
return;
if(!CAp::Assert(CSparse::SparseIsCRS(RawA),__FUNCTION__+": RawA must be CRS matrix"))
return;
//--- Determine LAdjPlus - supernodes feeding updates to the SIdx-th one.
//--- Without supernodes we have: K-th row of L (also denoted as ladj+(K))
//--- includes original nonzeros from A (also denoted as ladj(K)) as well
//--- as all elements on paths in elimination tree from ladj(K) to K.
//--- With supernodes: same principle applied.
CAblasF::ISetAllocV(Analysis.m_NSuper+1,0,Analysis.m_LAdjPlusR);
CAblasF::BSetV(n,true,tFlagArray);
Analysis.m_LAdjPlusR.Set(0,0);
for(SIdx=0; SIdx<=Analysis.m_NSuper-1; SIdx++)
{
//--- Generate list of nodes feeding updates to SIdx-th one
CApServ::VectorGrowTo(Analysis.m_LAdjPlus,Analysis.m_LAdjPlusR[SIdx]+Analysis.m_NSuper);
rfirst=Analysis.m_LAdjPlusR[SIdx];
rlast=rfirst;
for(rowidx=Analysis.m_SuperColRange[SIdx]; rowidx<Analysis.m_SuperColRange[SIdx+1]; rowidx++)
{
i=Analysis.m_InvSuperPerm[rowidx];
j0=RawA.m_RIdx[i];
j1=RawA.m_UIdx[i]-1;
for(jj=j0; jj<=j1; jj++)
{
j=Node2Supernode[Analysis.m_SuperPerm[RawA.m_Idx[jj]]];
if(j<SIdx && tFlagArray[j])
{
Analysis.m_LAdjPlus.Set(rlast,j);
tFlagArray[j]=false;
rlast=rlast+1;
j=Analysis.m_ParentSupernode[j];
while((j>=0 && j<SIdx) && tFlagArray[j])
{
Analysis.m_LAdjPlus.Set(rlast,j);
tFlagArray[j]=false;
rlast=rlast+1;
j=Analysis.m_ParentSupernode[j];
}
}
}
}
for(i=rfirst; i<rlast; i++)
tFlagArray[Analysis.m_LAdjPlus[i]]=true;
Analysis.m_LAdjPlusR.Set(SIdx+1,rlast);
}
//--- Analyze statistics for Trace output
if(Analysis.m_Dotrace)
{
CAp::Trace("=== ANALYZING SUPERNODAL DEPENDENCIES ==============================================================\n");
dbgnzl=0;
dbgrank1nodes=0;
dbgrank2nodes=0;
dbgrank3nodes=0;
dbgrank4nodes=0;
dbgbignodes=0;
dbgtotalflop=0;
dbgnoscatterflop=0;
dbgnorowscatterflop=0;
dbgnocolscatterflop=0;
dbgrank1flop=0;
dbgrank4plusflop=0;
dbg444flop=0;
dbgxx4flop=0;
dbgcholeskyflop=0;
dbgcholesky4flop=0;
CAblasF::ISetV(Analysis.m_NSuper,0,tTmp0);
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
//--- Node sizes
switch(Analysis.m_SuperColRange[SIdx+1]-Analysis.m_SuperColRange[SIdx])
{
case 1:
dbgrank1nodes++;
break;
case 2:
dbgrank2nodes++;
break;
case 3:
dbgrank3nodes++;
break;
case 4:
dbgrank4nodes++;
break;
default:
dbgbignodes++;
break;
}
//--- Nonzeros and FLOP counts
tWidth=Analysis.m_SuperColRange[SIdx+1]-Analysis.m_SuperColRange[SIdx];
theight=tWidth+(Analysis.m_SuperRowRIdx[SIdx+1]-Analysis.m_SuperRowRIdx[SIdx]);
dbgnzl=dbgnzl+theight*tWidth-tWidth*(tWidth-1)/2;
for(i=Analysis.m_LAdjPlusR[SIdx]; i<Analysis.m_LAdjPlusR[SIdx+1]; i++)
{
UIdx=Analysis.m_LAdjPlus[i];
//--- Determine update width, height, rank
WrkRow=tTmp0[UIdx];
offdiagrow=WrkRow;
lastrow=Analysis.m_SuperRowRIdx[UIdx+1]-Analysis.m_SuperRowRIdx[UIdx];
while(offdiagrow<lastrow && Analysis.m_SuperRowIdx[Analysis.m_SuperRowRIdx[UIdx]+offdiagrow]<Analysis.m_SuperColRange[SIdx+1])
offdiagrow++;
UWidth=offdiagrow-WrkRow;
UHeight=lastrow-WrkRow;
urank=Analysis.m_SuperColRange[UIdx+1]-Analysis.m_SuperColRange[UIdx];
tTmp0.Set(UIdx,offdiagrow);
//--- Compute update FLOP cost
uflop=UWidth*UHeight*urank;
dbgtotalflop+=uflop;
if(UHeight==theight && UWidth==tWidth)
dbgnoscatterflop+=uflop;
if(UHeight==theight)
dbgnorowscatterflop+=uflop;
if(UWidth==tWidth)
dbgnocolscatterflop+=uflop;
if(urank==1)
dbgrank1flop+=uflop;
if(urank>=4)
dbgrank4plusflop+=uflop;
if((urank==4 && UWidth==4) && tWidth==4)
dbg444flop+=uflop;
if(tWidth==4)
dbgxx4flop+=uflop;
}
uflop=0;
for(i=0; i<tWidth; i++)
uflop=uflop+(theight-i)*(i+1);
dbgtotalflop+=uflop;
dbgcholeskyflop+=uflop;
if(tWidth==4)
dbgcholesky4flop+=uflop;
}
//--- Output
CAp::Trace("> factor size:\n");
CAp::Trace(StringFormat("nz(L) = %d\n",dbgnzl));
CAp::Trace("> node size statistics:\n");
CAp::Trace(StringFormat("rank1 = %d\n",dbgrank1nodes));
CAp::Trace(StringFormat("rank2 = %d\n",dbgrank2nodes));
CAp::Trace(StringFormat("rank3 = %d\n",dbgrank3nodes));
CAp::Trace(StringFormat("rank4 = %d\n",dbgrank4nodes));
CAp::Trace(StringFormat("big nodes = %d\n",dbgbignodes));
CAp::Trace("> Total FLOP count (fused multiply-adds):\n");
CAp::Trace(StringFormat("total = %.8f MFLOP\n",1.0E-6 * dbgtotalflop));
CAp::Trace("> FLOP counts for updates:\n");
CAp::Trace(StringFormat("no-sctr = %.8f MFLOP (no row scatter,no col scatter,best case)\n",1.0E-6 * dbgnoscatterflop));
CAp::Trace(StringFormat("M4*44->N4 = %.8f MFLOP (no col scatter,big blocks,good case)\n",1.0E-6 * dbg444flop));
CAp::Trace(StringFormat("no-row-sctr = %.8f MFLOP (no row scatter,good case for col-wise storage)\n",1.0E-6 * dbgnorowscatterflop));
CAp::Trace(StringFormat("no-col-sctr = %.8f MFLOP (no col scatter,good case for row-wise storage)\n",1.0E-6 * dbgnocolscatterflop));
CAp::Trace(StringFormat("XX*XX->N4 = %.8f MFLOP\n",1.0E-6 * dbgxx4flop));
CAp::Trace(StringFormat("rank1 = %.8f MFLOP\n",1.0E-6 * dbgrank1flop));
CAp::Trace(StringFormat("rank4+ = %.8f MFLOP\n",1.0E-6 * dbgrank4plusflop));
CAp::Trace("> FLOP counts for Cholesky:\n");
CAp::Trace(StringFormat("cholesky = %.8f MFLOP\n",1.0E-6 * dbgcholeskyflop));
CAp::Trace(StringFormat("cholesky4 = %.8f MFLOP\n",1.0E-6 * dbgcholesky4flop));
}
}
//+------------------------------------------------------------------+
//| This function loads matrix into the supernodal storage. |
//+------------------------------------------------------------------+
void CSpChol::LoadMatrix(CSpCholAnalysis &Analysis,
CSparseMatrix &at)
{
//--- create variables
int i0=0;
int i1=0;
int Cols0=0;
int Cols1=0;
int OffsS=0;
int sstride=0;
int blocksize=0;
int SIdx=0;
bool rowsizesmatch=true;
int n=Analysis.m_N;
//--- Perform quick integrity checks
for(int i=0; i<=n; i++)
rowsizesmatch=(rowsizesmatch && Analysis.m_ReferenceRIdx[i]==at.m_RIdx[i]);
//--- check
if(!CAp::Assert(rowsizesmatch,__FUNCTION__+": sparsity patterns do not match"))
return;
//--- Load
CAblasF::IAllocV(n,Analysis.m_Raw2Smap);
CAblasF::RSetAllocV(Analysis.m_RowOffSets[Analysis.m_NSuper],0.0,Analysis.m_InputStorage);
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
blocksize=Cols1-Cols0;
OffsS=Analysis.m_RowOffSets[SIdx];
sstride=Analysis.m_RowStrides[SIdx];
//--- Load supernode #SIdx using Raw2SMap to perform quick transformation between global and local indexing.
for(int i=Cols0; i<Cols1; i++)
Analysis.m_Raw2Smap.Set(i,i-Cols0);
for(int k=Analysis.m_SuperRowRIdx[SIdx]; k<Analysis.m_SuperRowRIdx[SIdx+1]; k++)
Analysis.m_Raw2Smap.Set(Analysis.m_SuperRowIdx[k],blocksize+(k-Analysis.m_SuperRowRIdx[SIdx]));
for(int j=Cols0; j<Cols1; j++)
{
i0=at.m_RIdx[j];
i1=at.m_RIdx[j+1];
for(int ii=i0; ii<i1; ii++)
Analysis.m_InputStorage.Set(OffsS+Analysis.m_Raw2Smap[at.m_Idx[ii]]*sstride+(j-Cols0),at.m_Vals[ii]);
}
}
}
//+------------------------------------------------------------------+
//| This function extracts computed matrix from the supernodal |
//| storage. |
//| Depending on settings, a supernodal permutation can be applied to|
//| the matrix. |
//| INPUT PARAMETERS: |
//| Analysis - analysis object with completely initialized |
//| supernodal structure |
//| Offsets - offsets for supernodal storage |
//| Strides - row strides for supernodal storage |
//| RowStorage - supernodal storage |
//| DiagD - diagonal factor |
//| N - problem size |
//| TmpP - preallocated temporary array[N + 1] |
//| OUTPUT PARAMETERS: |
//| A - sparse matrix in CRS format: |
//| * for PermType = 0, sparse matrix in the original ordering |
//| (i.e. the matrix is reordered prior to output that may |
//| require considerable amount of operations due to |
//| permutation being applied) |
//| * for PermType = 1, sparse matrix in the topological |
//| ordering. The least overhead for output. |
//| D - array[N], diagonal |
//| P - output permutation in product form |
//+------------------------------------------------------------------+
void CSpChol::ExtractMatrix(CSpCholAnalysis &Analysis,CRowInt &Offsets,
CRowInt &Strides,CRowDouble &RowStorage,
CRowDouble &DiagD,int N,CSparseMatrix &A,
CRowDouble &D,CRowInt &P,CRowInt &TmpP)
{
//--- create variables
int i=0;
int j=0;
int k=0;
int SIdx=0;
int i0=0;
int ii=0;
int rfirst=0;
int rlast=0;
int Cols0=0;
int Cols1=0;
int blocksize=0;
int rowstride=0;
int offdiagsize=0;
int offssdiag=0;
//--- check
if(!CAp::Assert(CAp::Len(TmpP)>N,__FUNCTION__+": preallocated temporary TmpP is too short"))
return;
//--- Basic initialization
A.m_MatrixType=1;
A.m_N=N;
A.m_M=N;
//--- Various permutation types
if(Analysis.m_ApplyPermutationToOutput)
{
//--- check
if(!CAp::Assert(Analysis.m_IsTopologicalOrdering,__FUNCTION__+": critical integrity check failed (attempt to merge in nontopological permutation)"))
return;
//--- Output matrix is topologically permuted, so we return A=L*L' instead of A=P*L*L'*P'.
//--- Somewhat inefficient because we have to apply permutation to L returned by supernodal code.
CApServ::IVectorSetLengthAtLeast(A.m_RIdx,N+1);
CApServ::IVectorSetLengthAtLeast(A.m_DIdx,N);
A.m_RIdx.Set(0,0);
for(i=0; i<N; i++)
{
A.m_RIdx.Set(i+1,A.m_RIdx[i]+Analysis.m_OutRowCounts[Analysis.m_EffectivePerm[i]]);
A.m_DIdx.Set(i,A.m_RIdx[i]);
}
A.m_NInitialized=A.m_RIdx[N];
CApServ::RVectorSetLengthAtLeast(A.m_Vals,A.m_NInitialized);
CApServ::IVectorSetLengthAtLeast(A.m_Idx,A.m_NInitialized);
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
rfirst=Analysis.m_SuperRowRIdx[SIdx];
rlast=Analysis.m_SuperRowRIdx[SIdx+1];
blocksize=Cols1-Cols0;
offdiagsize=rlast-rfirst;
rowstride=Strides[SIdx];
offssdiag=Offsets[SIdx];
for(i=0; i<blocksize; i++)
{
i0=Analysis.m_InvEffectivePerm[Cols0+i];
ii=A.m_DIdx[i0];
for(j=0; j<=i; j++)
{
A.m_Idx.Set(ii,Analysis.m_InvEffectivePerm[Cols0+j]);
A.m_Vals.Set(ii,RowStorage[offssdiag+i*rowstride+j]);
ii=ii+1;
}
A.m_DIdx.Set(i0,ii);
}
for(k=0; k<=offdiagsize-1; k++)
{
i0=Analysis.m_InvEffectivePerm[Analysis.m_SuperRowIdx[k+rfirst]];
ii=A.m_DIdx[i0];
for(j=0; j<=blocksize-1; j++)
{
A.m_Idx.Set(ii,Analysis.m_InvEffectivePerm[Cols0+j]);
A.m_Vals.Set(ii,RowStorage[offssdiag+(blocksize+k)*rowstride+j]);
ii=ii+1;
}
A.m_DIdx.Set(i0,ii);
}
}
for(i=0; i<N; i++)
{
//--- check
if(!CAp::Assert(A.m_DIdx[i]==A.m_RIdx[i+1],__FUNCTION__+": integrity check failed (9473t)"))
return;
CTSort::TagSortMiddleIR(A.m_Idx,A.m_Vals,A.m_RIdx[i],A.m_RIdx[i+1]-A.m_RIdx[i]);
//--- check
if(!CAp::Assert(A.m_Idx[A.m_RIdx[i+1]-1]==i,__FUNCTION__+": integrity check failed (e4tfd)"))
return;
}
CSparse::SparseInitDUIdx(A);
//--- Prepare D[] and P[]
CApServ::RVectorSetLengthAtLeast(D,N);
CApServ::IVectorSetLengthAtLeast(P,N);
for(i=0; i<N; i++)
{
D.Set(i,DiagD[Analysis.m_EffectivePerm[i]]);
P.Set(i,i);
}
}
else
{
//--- The permutation is NOT applied to L prior to extraction,
//--- we return both L and P: A=P*L*L'*P'.
CApServ::IVectorSetLengthAtLeast(A.m_RIdx,N+1);
CApServ::IVectorSetLengthAtLeast(A.m_DIdx,N);
A.m_RIdx.Set(0,0);
for(i=0; i<N; i++)
A.m_RIdx.Set(i+1,A.m_RIdx[i]+Analysis.m_OutRowCounts[i]);
for(i=0; i<N; i++)
A.m_DIdx.Set(i,A.m_RIdx[i]);
A.m_NInitialized=A.m_RIdx[N];
CApServ::RVectorSetLengthAtLeast(A.m_Vals,A.m_NInitialized);
CApServ::IVectorSetLengthAtLeast(A.m_Idx,A.m_NInitialized);
for(SIdx=0; SIdx<Analysis.m_NSuper; SIdx++)
{
Cols0=Analysis.m_SuperColRange[SIdx];
Cols1=Analysis.m_SuperColRange[SIdx+1];
rfirst=Analysis.m_SuperRowRIdx[SIdx];
rlast=Analysis.m_SuperRowRIdx[SIdx+1];
blocksize=Cols1-Cols0;
offdiagsize=rlast-rfirst;
rowstride=Strides[SIdx];
offssdiag=Offsets[SIdx];
for(i=0; i<blocksize; i++)
{
i0=Cols0+i;
ii=A.m_DIdx[i0];
for(j=0; j<=i; j++)
{
A.m_Idx.Set(ii,Cols0+j);
A.m_Vals.Set(ii,RowStorage[offssdiag+i*rowstride+j]);
ii++;
}
A.m_DIdx.Set(i0,ii);
}
for(k=0; k<offdiagsize; k++)
{
i0=Analysis.m_SuperRowIdx[k+rfirst];
ii=A.m_DIdx[i0];
for(j=0; j<blocksize; j++)
{
A.m_Idx.Set(ii,Cols0+j);
A.m_Vals.Set(ii,RowStorage[offssdiag+(blocksize+k)*rowstride+j]);
ii++;
}
A.m_DIdx.Set(i0,ii);
}
}
for(i=0; i<N; i++)
{
//--- check
if(!CAp::Assert(A.m_DIdx[i]==A.m_RIdx[i+1],__FUNCTION__+": integrity check failed (34e43)"))
return;
if(!CAp::Assert(A.m_Idx[A.m_RIdx[i+1]-1]==i,__FUNCTION__+": integrity check failed (k4df5)"))
return;
}
CSparse::SparseInitDUIdx(A);
//--- Extract diagonal
CApServ::RVectorSetLengthAtLeast(D,N);
for(i=0; i<N; i++)
D.Set(i,DiagD[i]);
//--- Convert permutation table into product form
CApServ::IVectorSetLengthAtLeast(P,N);
for(i=0; i<N; i++)
{
P.Set(i,i);
TmpP.Set(i,i);
}
for(i=0; i<N; i++)
{
//--- We need to move element K to position I.
//--- J is where K actually stored
k=Analysis.m_InvEffectivePerm[i];
j=TmpP[k];
//--- Swap elements of P[I:N-1] that is used to store current locations of elements in different way
i0=P[i];
P.Set(i,P[j]);
P.Set(j,i0);
//--- record pivoting of positions I and J
P.Set(i,j);
TmpP.Set(i0,j);
}
}
}
//+------------------------------------------------------------------+
//| Sparisity pattern of partial Cholesky. |
//| This function splits lower triangular L into two parts: leading |
//| HEAD cols and trailing TAIL*TAIL submatrix. Then it computes |
//| sparsity pattern of the Cholesky decomposition of the HEAD, |
//| extracts bottom TAIL*HEAD update matrix U and applies it to the |
//| Tail: |
//| pattern(TAIL) += pattern(U*U') |
//| The pattern(TAIL) is returned. It is important that pattern(TAIL)|
//| is not the sparsity pattern of trailing Cholesky factor, it is |
//| the pattern of the temporary matrix that will be factorized. |
//| The sparsity pattern of HEAD is NOT returned. |
//| INPUT PARAMETERS: |
//| A - lower triangular matrix A whose partial sparsity |
//| pattern is needed. Only sparsity structure matters,|
//| specific element values are ignored. |
//| Head, Tail- sizes of the leading / traling submatrices |
//| tmpParent, |
//| tmpChildrenR, |
//| cmpChildrenI, |
//| Tmp1, |
//| FlagArray - preallocated temporary arrays, length at least |
//| Head + Tail |
//| tmpBottomT, |
//| tmpUpdateT, |
//| tmpUpdate - temporary sparsematrix instances; previously |
//| allocated space will be reused. |
//| OUTPUT PARAMETERS: |
//| ATail - sparsity pattern of the lower triangular temporary |
//| matrix computed prior to Cholesky factorization. |
//| Matrix elements are initialized by placeholder |
//| values. |
//+------------------------------------------------------------------+
void CSpChol::PartialCholeskyPattern(CSparseMatrix &A,
int Head,int Tail,
CSparseMatrix &ATail,
CRowInt &tmpParent,
CRowInt &tmpChildrenR,
CRowInt &tmpChildrenI,
CRowInt &Tmp1,
bool &FlagArray[],
CSparseMatrix &tmpBottomT,
CSparseMatrix &tmpUpdateT,
CSparseMatrix &tmpUpdate,
CSparseMatrix &tmpNewTailT)
{
//--- create variables
int i=0;
int j=0;
int k=0;
int i1=0;
int ii=0;
int j1=0;
int jj=0;
int kb=0;
int cursize=Head+Tail;
double v=(double)1/(double)cursize;
//--- check
if(!CAp::Assert(A.m_M==cursize,__FUNCTION__+": rows(A)!=Head+Tail"))
return;
if(!CAp::Assert(A.m_N==cursize,__FUNCTION__+": cols(A)!=Head+Tail"))
return;
if(!CAp::Assert(CAp::Len(tmpParent)>cursize,__FUNCTION__+": Length(tmpParent)<Head+Tail+1"))
return;
if(!CAp::Assert(CAp::Len(tmpChildrenR)>cursize,__FUNCTION__+": Length(tmpChildrenR)<Head+Tail+1"))
return;
if(!CAp::Assert(CAp::Len(tmpChildrenI)>cursize,__FUNCTION__+": Length(tmpChildrenI)<Head+Tail+1"))
return;
if(!CAp::Assert(CAp::Len(Tmp1)>cursize,__FUNCTION__+": Length(tmp1)<Head+Tail+1"))
return;
if(!CAp::Assert(CAp::Len(FlagArray)>cursize,__FUNCTION__+": Length(tmp1)<Head+Tail+1"))
return;
//--- Compute leading Head columns of the Cholesky decomposition of A.
//--- These columns will be used later to update sparsity pattern of the trailing
//--- Tail*Tail matrix.
//--- Actually, we need just bottom Tail rows of these columns whose transpose (a
//--- Head*Tail matrix) is stored in the tmpBottomT matrix. In order to do so in
//--- the most efficient way we analyze elimination tree of the reordered matrix.
//--- In addition to BOTTOM matrix B we also compute an UPDATE matrix U which does
//--- not include rows with duplicating sparsity patterns (only parents in the
//--- elimination tree are included). Using update matrix to compute the sparsity
//--- pattern is much more efficient because we do not spend time on children columns.
//--- NOTE: because Cholesky decomposition deals with matrix columns, we transpose
//--- A, store it into ATail, and work with transposed matrix.
CSparse::SparseCopyTransposeCRSBuf(A,ATail);
BuildUnorderedeTree(A,cursize,tmpParent,Tmp1);
FromParentToChildren(tmpParent,cursize,tmpChildrenR,tmpChildrenI,Tmp1);
tmpBottomT.m_M=Head;
tmpBottomT.m_N=Tail;
CAblasF::IAllocV(Head+1,tmpBottomT.m_RIdx);
tmpBottomT.m_RIdx.Set(0,0);
tmpUpdateT.m_M=Head;
tmpUpdateT.m_N=Tail;
CAblasF::IAllocV(Head+1,tmpUpdateT.m_RIdx);
tmpUpdateT.m_RIdx.Set(0,0);
CAblasF::BSetV(Tail,false,FlagArray);
for(j=0; j<Head; j++)
{
//--- Start J-th row of the tmpBottomT
kb=tmpBottomT.m_RIdx[j];
CAblasF::IGrowV(kb+Tail,tmpBottomT.m_Idx);
CAblasF::RGrowV(kb+Tail,tmpBottomT.m_Vals);
//-- copy sparsity pattern J-th column of the reordered matrix
jj=ATail.m_DIdx[j];
j1=ATail.m_RIdx[j+1]-1;
while(jj<=j1 && ATail.m_Idx[jj]<Head)
jj++;
while(jj<=j1)
{
i=ATail.m_Idx[jj]-Head;
tmpBottomT.m_Idx.Set(kb,i);
tmpBottomT.m_Vals.Set(kb,v);
FlagArray[i]=true;
kb++;
jj++;
}
//--- Fetch sparsity pattern from the immediate children in the elimination tree
for(jj=tmpChildrenR[j]; jj<tmpChildrenR[j+1]; jj++)
{
j1=tmpChildrenI[jj];
i1=-1;
for(ii=tmpBottomT.m_RIdx[j1]; ii<tmpBottomT.m_RIdx[j1+1]; ii++)
{
i=tmpBottomT.m_Idx[ii];
if(!FlagArray[i])
{
tmpBottomT.m_Idx.Set(kb,i);
tmpBottomT.m_Vals.Set(kb,v);
FlagArray[i]=true;
kb++;
}
}
}
//--- Finalize row of tmpBottomT
for(ii=tmpBottomT.m_RIdx[j]; ii<kb; ii++)
FlagArray[tmpBottomT.m_Idx[ii]]=false;
tmpBottomT.m_RIdx.Set(j+1,kb);
//--- Only columns that forward their sparsity pattern directly into the Tail are added to tmpUpdateT
if(tmpParent[j]>=Head)
{
//--- J-th column of the Head forwards its sparsity pattern directly into the Tail, save it to tmpUpdateT
k=tmpUpdateT.m_RIdx[j];
CAblasF::IGrowV(k+Tail,tmpUpdateT.m_Idx);
CAblasF::RGrowV(k+Tail,tmpUpdateT.m_Vals);
for(jj=tmpBottomT.m_RIdx[j]; jj<tmpBottomT.m_RIdx[j+1]; jj++)
{
tmpUpdateT.m_Idx.Set(k,tmpBottomT.m_Idx[jj]);
tmpUpdateT.m_Vals.Set(k,v);
k=k+1;
}
tmpUpdateT.m_RIdx.Set(j+1,k);
}
else
{
//--- J-th column of the Head forwards its sparsity pattern to another column in the Head,
//--- no need to save it to tmpUpdateT. Save empty row.
tmpUpdateT.m_RIdx.Set(j+1,tmpUpdateT.m_RIdx[j]);
}
}
CSparse::SparseCreateCRSInplace(tmpUpdateT);
CSparse::SparseCopyTransposeCRSBuf(tmpUpdateT,tmpUpdate);
//--- Apply update U*U' to the trailing Tail*Tail matrix and generate new
//--- residual matrix in tmpNewTailT. Then transpose/copy it to TmpA[].
CAblasF::BSetV(Tail,false,FlagArray);
tmpNewTailT.m_M=Tail;
tmpNewTailT.m_N=Tail;
CAblasF::IAllocV(Tail+1,tmpNewTailT.m_RIdx);
tmpNewTailT.m_RIdx.Set(0,0);
for(j=0; j<Tail; j++)
{
k=tmpNewTailT.m_RIdx[j];
CAblasF::IGrowV(k+Tail,tmpNewTailT.m_Idx);
CAblasF::RGrowV(k+Tail,tmpNewTailT.m_Vals);
//--- Copy row from the reordered/transposed matrix stored in TmpA
tmpNewTailT.m_Idx.Set(k,j);
tmpNewTailT.m_Vals.Set(k,1);
FlagArray[j]=true;
k=k+1;
jj=ATail.m_DIdx[Head+j]+1;
j1=-1;
for(jj=ATail.m_DIdx[Head+j]+1; jj<ATail.m_RIdx[Head+j+1]; jj++)
{
i=ATail.m_Idx[jj]-Head;
tmpNewTailT.m_Idx.Set(k,i);
tmpNewTailT.m_Vals.Set(k,v);
FlagArray[i]=true;
k++;
}
//--- Apply update U*U' to J-th column of new Tail (J-th row of tmpNewTailT):
//--- * scan J-th row of U
//--- * for each nonzero element, append corresponding row of U' (elements from J+1-th) to tmpNewTailT
//--- * FlagArray[] is used to avoid duplication of nonzero elements
j1=-1;
for(jj=tmpUpdate.m_RIdx[j]; jj<tmpUpdate.m_RIdx[j+1]; jj++)
{
//--- Get row of U', skip leading elements up to J-th
ii=tmpUpdateT.m_RIdx[tmpUpdate.m_Idx[jj]];
i1=tmpUpdateT.m_RIdx[tmpUpdate.m_Idx[jj]+1]-1;
while(ii<=i1 && tmpUpdateT.m_Idx[ii]<=j)
ii++;
//--- Append the rest of the row to tmpNewTailT
while(ii<=i1)
{
i=tmpUpdateT.m_Idx[ii];
if(!FlagArray[i])
{
tmpNewTailT.m_Idx.Set(k,i);
tmpNewTailT.m_Vals.Set(k,v);
FlagArray[i]=true;
k++;
}
ii++;
}
//--- Continue or stop early (if we completely filled output buffer)
if((k-tmpNewTailT.m_RIdx[j])==(Tail-j))
break;
}
//--- Finalize:
//--- * clean up FlagArray[]
//--- * save K to RIdx[]
//
for(ii=tmpNewTailT.m_RIdx[j]; ii<k; ii++)
FlagArray[tmpNewTailT.m_Idx[ii]]=false;
tmpNewTailT.m_RIdx.Set(j+1,k);
}
CSparse::SparseCreateCRSInplace(tmpNewTailT);
CSparse::SparseCopyTransposeCRSBuf(tmpNewTailT,ATail);
}
//+------------------------------------------------------------------+
//| This function is a specialized version of SparseSymmPermTbl() |
//| that takes into account specifics of topological reorderings |
//| (improves performance) and additionally transposes its output. |
//| INPUT PARAMETERS: |
//| A - sparse lower triangular matrix in CRS format. |
//| P - array[N] which stores permutation table; |
//| P[I] = J means that I-th row/column of matrix A is |
//| moved to J-th position. For performance reasons we |
//| do NOT check that P[] is a correct permutation |
//| (that there is no repetitions, just that all its |
//| elements are in [0, N) range. |
//| B - sparse matrix object that will hold output. |
//| Previously allocated memory will be reused as much as possible. |
//| OUTPUT PARAMETERS: |
//| B - permuted and transposed upper triangular matrix in |
//| the special internal CRS - like matrix format |
//| (MatrixType = -10082). |
//+------------------------------------------------------------------+
void CSpChol::TopologicalPermutation(CSparseMatrix&A,
CRowInt &P,
CSparseMatrix &B)
{
//--- create variables
int i=0;
int j=0;
int jj=0;
int j0=0;
int j1=0;
int k=0;
int k0=0;
int n= A.m_N;
bool bflag=true;
//--- check
if(!CAp::Assert(A.m_MatrixType==1,__FUNCTION__+": incorrect matrix type (convert your matrix to CRS)"))
return;
if(!CAp::Assert(CAp::Len(P)>=A.m_N,__FUNCTION__+": Length(P)<N"))
return;
if(!CAp::Assert(A.m_M==A.m_N,__FUNCTION__+": matrix is non-square"))
return;
if(!CAp::Assert(A.m_NInitialized==A.m_RIdx[A.m_N],__FUNCTION__+": integrity check failed"))
return;
for(i=0; i<n; i++)
{
j=P[i];
bflag=(bflag && j>=0 && j<n);
}
//--- check
if(!CAp::Assert(bflag,__FUNCTION__+": P[] contains values outside of [0,N) range"))
return;
//--- Prepare output
B.m_MatrixType=-10082;
B.m_N=n;
B.m_M=n;
CApServ::IVectorSetLengthAtLeast(B.m_DIdx,n);
CApServ::IVectorSetLengthAtLeast(B.m_UIdx,n);
//--- Determine row sizes (temporary stored in DIdx) and ranges
CAblasF::ISetV(n,0,B.m_UIdx);
for(i=0; i<n; i++)
{
j0=A.m_RIdx[i];
j1=A.m_UIdx[i]-1;
for(jj=j0; jj<=j1; jj++)
{
j=A.m_Idx[jj];
B.m_UIdx.Add(j,1);
}
}
for(i=0; i<n; i++)
B.m_DIdx.Set(P[i],B.m_UIdx[i]);
CApServ::IVectorSetLengthAtLeast(B.m_RIdx,n+1);
B.m_RIdx.Set(0,0);
for(i=0; i<n; i++)
{
B.m_RIdx.Set(i+1,B.m_RIdx[i]+B.m_DIdx[i]);
B.m_UIdx.Set(i,B.m_RIdx[i]);
}
B.m_NInitialized=B.m_RIdx[n];
CApServ::IVectorSetLengthAtLeast(B.m_Idx,B.m_NInitialized);
CApServ::RVectorSetLengthAtLeast(B.m_Vals,B.m_NInitialized);
//--- Process matrix
for(i=0; i<n; i++)
{
j0=A.m_RIdx[i];
j1=A.m_UIdx[i];
k=P[i];
for(jj=j0; jj<j1; jj++)
{
j=P[A.m_Idx[jj]];
k0=B.m_UIdx[j];
B.m_Idx.Set(k0,k);
B.m_Vals.Set(k0,A.m_Vals[jj]);
B.m_UIdx.Set(j,k0+1);
}
}
}
//+------------------------------------------------------------------+
//| Determine nonzero pattern of the column. |
//| This function takes as input: |
//| * A ^ T - transpose of original input matrix |
//| * index of column of L being computed |
//| * SuperRowRIdx[] and SuperRowIdx[] - arrays that store row |
//| structure of supernodes, and NSuper - supernodes count |
//| * ChildrenNodesR[], ChildrenNodesI[] - arrays that store children|
//| nodes for each node |
//| * Node2Supernode[] - array that maps node indexes to supernodes |
//| * TrueArray[] - array[N] that has all of its elements set to |
//| True(this invariant is preserved on output) |
//| * Tmp0[] - array[N], temporary array |
//| As output, it constructs nonzero pattern(diagonal element not |
//| included) of the column #ColumnIdx on top of SuperRowIdx[] array,|
//| starting at location SuperRowIdx[SuperRowRIdx[NSuper]] and till |
//| location SuperRowIdx[Result-1], where Result is a function result|
//| The SuperRowIdx[] array is automatically resized as needed. |
//| It is important that this function computes nonzero pattern, but |
//| it does NOT change other supernodal structures. The caller still |
//| has to finalize the column(setup supernode ranges, mappings, etc)|
//+------------------------------------------------------------------+
int CSpChol::ComputeNonzeroPattern(CSparseMatrix &wrkAT,
int ColumnIdx,int N,
CRowInt &SuperRowRIdx,
CRowInt &SuperRowIdx,
int NSuper,
CRowInt &ChildrenNodesR,
CRowInt &ChildrenNodesI,
CRowInt &Node2Supernode,
bool &TrueArray[],
CRowInt &Tmp0)
{
//--- create variables
int result=0;
int i=0;
int ii=0;
int jj=0;
int i0=ChildrenNodesR[ColumnIdx];
int i1=ChildrenNodesR[ColumnIdx+1];
int j0=0;
int j1=0;
int cidx=0;
int rfirst=0;
int rlast=0;
int tfirst=0;
int tlast=0;
int supernodalchildrencount=0;
//--- check
if(!CAp::Assert(CAp::Len(TrueArray)>=N,__FUNCTION__+": input temporary is too short"))
return(-1);
if(!CAp::Assert(CAp::Len(Tmp0)>=N,__FUNCTION__+": input temporary is too short"))
return(-1);
//--- Determine supernodal children in Tmp0
for(ii=i0; ii<i1; ii++)
{
i=Node2Supernode[ChildrenNodesI[ii]];
if(TrueArray[i])
{
Tmp0.Set(supernodalchildrencount,i);
TrueArray[i]=false;
supernodalchildrencount++;
}
}
for(i=0; i<supernodalchildrencount; i++)
TrueArray[Tmp0[i]]=true;
//--- Initialized column by nonzero pattern from A
rfirst=SuperRowRIdx[NSuper];
tfirst=rfirst+N;
CAblasF::IGrowV(rfirst+2*N,SuperRowIdx);
i0=wrkAT.m_RIdx[ColumnIdx]+1;
i1=wrkAT.m_RIdx[ColumnIdx+1];
CAblasF::ICopyVX(i1-i0,wrkAT.m_Idx,i0,SuperRowIdx,rfirst);
rlast=rfirst+(i1-i0);
//--- For column with small number of children use ordered merge algorithm.
//--- For column with many children it is better to perform unsorted merge,
//--- and then sort the sequence.
if(supernodalchildrencount<=4)
{
//--- Ordered merge. The best approach for small number of children,
//--- but may have O(N^2) running time when O(N) children are present.
for(cidx=0; cidx<supernodalchildrencount; cidx++)
{
//--- Skip initial elements that do not contribute to subdiagonal nonzero pattern
i0=SuperRowRIdx[Tmp0[cidx]];
i1=SuperRowRIdx[Tmp0[cidx]+1]-1;
while(i0<=i1 && SuperRowIdx[i0]<=ColumnIdx)
i0++;
j0=rfirst;
j1=rlast-1;
//--- Handle degenerate cases: empty merge target or empty merge source.
if(j1<j0)
{
CAblasF::ICopyVX(i1-i0+1,SuperRowIdx,i0,SuperRowIdx,rlast);
rlast=rlast+(i1-i0+1);
continue;
}
if(i1<i0)
continue;
//--- General case: two non-empty sorted sequences given by [I0,I1] and [J0,J1],
//--- have to be merged and stored into [RFirst,RLast).
ii=SuperRowIdx[i0];
jj=SuperRowIdx[j0];
tlast=tfirst;
while(true)
{
if(ii<jj)
{
SuperRowIdx.Set(tlast,ii);
tlast++;
i0++;
if(i0>i1)
break;
ii=SuperRowIdx[i0];
}
if(jj<ii)
{
SuperRowIdx.Set(tlast,jj);
tlast++;
j0++;
if(j0>j1)
break;
jj=SuperRowIdx[j0];
}
if(jj==ii)
{
SuperRowIdx.Set(tlast,ii);
tlast++;
i0++;
j0++;
if(i0>i1)
break;
if(j0>j1)
break;
ii=SuperRowIdx[i0];
jj=SuperRowIdx[j0];
}
}
for(ii=i0; ii<=i1; ii++)
{
SuperRowIdx.Set(tlast,SuperRowIdx[ii]);
tlast++;
}
for(jj=j0; jj<=j1; jj++)
{
SuperRowIdx.Set(tlast,SuperRowIdx[jj]);
tlast++;
}
CAblasF::ICopyVX(tlast-tfirst,SuperRowIdx,tfirst,SuperRowIdx,rfirst);
rlast=rfirst+(tlast-tfirst);
}
result=rlast;
}
else
{
//--- Unordered merge followed by sort. Guaranteed N*logN worst case.
for(ii=rfirst; ii<rlast; ii++)
TrueArray[SuperRowIdx[ii]]=false;
for(cidx=0; cidx<supernodalchildrencount; cidx++)
{
//--- Skip initial elements that do not contribute to subdiagonal nonzero pattern
i0=SuperRowRIdx[Tmp0[cidx]];
i1=SuperRowRIdx[Tmp0[cidx]+1];
while(i0<i1 && SuperRowIdx[i0]<=ColumnIdx)
i0++;
//--- Append elements not present in the sequence
for(ii=i0; ii<i1; ii++)
{
i=SuperRowIdx[ii];
if(TrueArray[i])
{
SuperRowIdx.Set(rlast,i);
rlast++;
TrueArray[i]=false;
}
}
}
for(ii=rfirst; ii<rlast; ii++)
TrueArray[SuperRowIdx[ii]]=true;
CTSort::TagSortMiddleI(SuperRowIdx,rfirst,rlast-rfirst);
result=rlast;
}
return(result);
}
//+------------------------------------------------------------------+
//| Update target supernode with data from one of its children. This |
//| operation is a supernodal equivalent of the column update in the |
//| left - looking Cholesky. |
//| The generic update has following form: |
//| S := S - scatter(U*D*Uc') |
//| where |
//| * S is an tHeight*tWidth rectangular target matrix that is: |
//| * stored with tStride >= tWidth in |
//| RowStorage[OffsS:OffsS + tHeight * tStride - 1] |
//| * lower trapezoidal i.e. its leading tWidth*tWidth submatrix is|
//| lower triangular. One may update either entire tWidth*tWidth |
//| submatrix or just its lower part, because upper triangle is |
//| not referenced anyway. |
//| * the height of S is not given because it is not actually |
//| needed |
//| * U is an uHeight*uRank rectangular update matrix tht is: |
//| * stored with row stride uStride >= uRank in |
//| RowStorage[OffsU:OffsU + uHeight * uStride - 1]. |
//| * Uc is the leading uWidth*uRank submatrix of U |
//| * D is uRank*uRank diagonal matrix that is: |
//| * stored in DiagD[OffsD:OffsD + uRank - 1] |
//| * unit, when Analysis.UnitD = True. In this case it can be |
//| ignored, although DiagD still contains 1's in all of its |
//| entries |
//| * uHeight <= tHeight, uWidth <= tWidth, so scatter operation is|
//| needed to update S with smaller update. |
//| * scatter() is an operation that extends smaller |
//| uHeight*uWidth update matrix U*Uc' into larger tHeight*tWidth|
//| target matrix by adding zero rows and columns into U*Uc': |
//| * I-th row of update modifies |
//| Raw2SMap[SuperRowIdx[URBase + I]] -th row of the matrix S |
//| * J-th column of update modifies |
//| Raw2SMap[SuperRowIdx[URBase + J]] -th col of the matrix S |
//+------------------------------------------------------------------+
int CSpChol::UpdateSupernode(CSpCholAnalysis &Analysis,
int SIdx,
int Cols0,
int Cols1,
int OffsS,
CRowInt &Raw2Smap,
int UIdx,
int WrkRow,
CRowDouble &DiagD,
int OffsD)
{
//--- create variables
int result=0;
int i=0;
int j=0;
int k=0;
int UWidth=0;
int UHeight=0;
int targetrow=0;
int targetcol=0;
int offdiagrow=0;
int lastrow=0;
int offs0=0;
int offsj=0;
int offsk=0;
double v=0;
int tWidth=Cols1-Cols0;
int theight=tWidth+(Analysis.m_SuperRowRIdx[SIdx+1]-Analysis.m_SuperRowRIdx[SIdx]);
int OffsU=Analysis.m_RowOffSets[UIdx];
int colu0=Analysis.m_SuperColRange[UIdx];
int colu1=Analysis.m_SuperColRange[UIdx+1];
int URBase=Analysis.m_SuperRowRIdx[UIdx];
int urlast=Analysis.m_SuperRowRIdx[UIdx+1];
int urank=colu1-colu0;
int tRowStride=Analysis.m_RowStrides[SIdx];
int urowstride=Analysis.m_RowStrides[UIdx];
//--- Skip leading uRank+WrkRow rows of U because they are not used.
OffsU+=(colu1-colu0+WrkRow)*urowstride;
//--- Analyze range of rows in supernode LAdjPlus[II] and determine two subranges:
//--- * one with indexes stored at SuperRowIdx[WrkRow:OffdiagRow);
//--- these indexes are the ones that intersect with range of rows/columns [ColS0,ColS1)
//--- occupied by diagonal block of the supernode SIdx
//--- * one with indexes stored at SuperRowIdx[OffdiagRow:LastRow);
//--- these indexes are ones that intersect with range of rows occupied by
//--- offdiagonal block of the supernode SIdx
if(Analysis.m_ExtendedDebug)
{
//--- check
if(!CAp::Assert(Analysis.m_SuperRowIdx[URBase+WrkRow]>=Cols0,__FUNCTION__+": integrity check 6378 failed"))
return(-1);
if(!CAp::Assert(Analysis.m_SuperRowIdx[URBase+WrkRow]<Cols1,__FUNCTION__+": integrity check 6729 failed"))
return(-1);
}
offdiagrow=WrkRow;
lastrow=urlast-URBase;
while(offdiagrow<lastrow && Analysis.m_SuperRowIdx[offdiagrow+URBase]<Cols1)
offdiagrow++;
UWidth=offdiagrow-WrkRow;
UHeight=lastrow-WrkRow;
result=offdiagrow;
if(Analysis.m_ExtendedDebug)
{
//--- Extended integrity check (if requested)
//--- check
if(!CAp::Assert(WrkRow<offdiagrow && Analysis.m_SuperRowIdx[WrkRow+URBase]>=Cols0,__FUNCTION__+": integrity check failed (44trg6)"))
return(-1);
for(i=WrkRow; i<lastrow; i++)
{
//--- check
if(!CAp::Assert(Raw2Smap[Analysis.m_SuperRowIdx[i+URBase]]>=0,__FUNCTION__+": integrity check failed (43t63)"))
return(-1);
}
}
//--- Handle special cases
if(tRowStride==4)
{
//--- Target is stride-4 column, try several kernels that may work with tWidth=3 and tWidth=4
if(UWidth==4 && tWidth==4 && urank==4 && urowstride==4)
{
if(UpdateKernel4444(Analysis.m_OutputStorage,OffsS,theight,OffsU,UHeight,Analysis.m_DiagD,colu0,Raw2Smap,Analysis.m_SuperRowIdx,URBase+WrkRow))
return(result);
}
if(UpdateKernelABC4(Analysis.m_OutputStorage,OffsS,tWidth,OffsU,UHeight,urank,urowstride,UWidth,Analysis.m_DiagD,colu0,Raw2Smap,Analysis.m_SuperRowIdx,URBase+WrkRow))
return(result);
}
if(urank==1 && urowstride==1)
{
if(UpdateKernelRank1(Analysis.m_OutputStorage,OffsS,tWidth,tRowStride,OffsU,UHeight,UWidth,Analysis.m_DiagD,colu0,Raw2Smap,Analysis.m_SuperRowIdx,URBase+WrkRow))
return(result);
}
if(urank==2 && urowstride==2)
{
if(UpdateKernelRank2(Analysis.m_OutputStorage,OffsS,tWidth,tRowStride,OffsU,UHeight,UWidth,Analysis.m_DiagD,colu0,Raw2Smap,Analysis.m_SuperRowIdx,URBase+WrkRow))
return(result);
}
//--- Handle general update, rerefence code
CApServ::IVectorSetLengthAtLeast(Analysis.m_U2Smap,UHeight);
for(i=0; i<UHeight; i++)
Analysis.m_U2Smap.Set(i,Raw2Smap[Analysis.m_SuperRowIdx[URBase+WrkRow+i]]);
if(Analysis.m_UnitD)
{
//--- Unit D, vanilla Cholesky
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Analysis.m_U2Smap[k]*tRowStride;
for(j=0; j<UWidth; j++)
{
targetcol=Analysis.m_U2Smap[j];
offsj=OffsU+j*urowstride;
offsk=OffsU+k*urowstride;
offs0=targetrow+targetcol;
v=Analysis.m_OutputStorage[offs0];
for(i=0; i<urank; i++)
v-=Analysis.m_OutputStorage[offsj+i]*Analysis.m_OutputStorage[offsk+i];
Analysis.m_OutputStorage.Set(offs0,v);
}
}
}
else
{
//--- Non-unit D, LDLT decomposition
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Analysis.m_U2Smap[k]*tRowStride;
for(j=0; j<UWidth; j++)
{
targetcol=Analysis.m_U2Smap[j];
offsj=OffsU+j*urowstride;
offsk=OffsU+k*urowstride;
offs0=targetrow+targetcol;
v=Analysis.m_OutputStorage[offs0];
for(i=0; i<urank; i++)
v-=Analysis.m_OutputStorage[offsj+i]*DiagD[OffsD+i]*Analysis.m_OutputStorage[offsk+i];
Analysis.m_OutputStorage.Set(offs0,v);
}
}
}
return(result);
}
//+------------------------------------------------------------------+
//| Factorizes target supernode, returns True on success, False on |
//| failure. |
//+------------------------------------------------------------------+
bool CSpChol::FactorizeSupernode(CSpCholAnalysis &Analysis,int SIdx)
{
//--- create variables
int i=0;
int j=0;
int k=0;
double v=0;
double vs=0;
double possignvraw=0;
int Cols0=Analysis.m_SuperColRange[SIdx];
int Cols1=Analysis.m_SuperColRange[SIdx+1];
int OffsS=Analysis.m_RowOffSets[SIdx];
int blocksize=Cols1-Cols0;
int offdiagsize=Analysis.m_SuperRowRIdx[SIdx+1]-Analysis.m_SuperRowRIdx[SIdx];
int sstride=Analysis.m_RowStrides[SIdx];
bool controlpivot=(Analysis.m_ModType==1 && Analysis.m_ModParam0>0.0);
bool controloverflow=(Analysis.m_ModType==1 && Analysis.m_ModParam1>0.0);
//--- check
if(Analysis.m_UnitD)
{
//--- Classic Cholesky
for(j=0; j<=blocksize-1; j++)
{
//--- Compute J-th column
vs=0;
for(k=j; k<(blocksize+offdiagsize); k++)
{
v=Analysis.m_OutputStorage[OffsS+k*sstride+j];
for(i=0; i<j; i++)
v-=Analysis.m_OutputStorage[OffsS+k*sstride+i]*Analysis.m_OutputStorage[OffsS+j*sstride+i];
Analysis.m_OutputStorage.Set(OffsS+k*sstride+j,v);
vs+=MathAbs(v);
}
if(controloverflow && vs>Analysis.m_ModParam1)
//--- Possible failure due to accumulation of numerical errors
return(false);
//--- Handle pivot element
v=Analysis.m_OutputStorage[OffsS+j*sstride+j];
if(controlpivot && v<=Analysis.m_ModParam0)
{
//--- Basic modified Cholesky
v=MathSqrt(Analysis.m_ModParam0);
Analysis.m_DiagD.Set(Cols0+j,1.0);
Analysis.m_OutputStorage.Set(OffsS+j*sstride+j,v);
v=1/v;
for(k=j+1; k<blocksize+offdiagsize; k++)
Analysis.m_OutputStorage.Set(OffsS+k*sstride+j,v*Analysis.m_OutputStorage[OffsS+k*sstride+j]);
}
else
{
//--- Default case
if(v<=0)
return(false);
Analysis.m_DiagD.Set(Cols0+j,1.0);
v=1/MathSqrt(v);
for(k=j; k<blocksize+offdiagsize; k++)
Analysis.m_OutputStorage.Set(OffsS+k*sstride+j,v*Analysis.m_OutputStorage[OffsS+k*sstride+j]);
}
}
}
else
{
//--- LDLT with diagonal D
for(j=0; j<blocksize; j++)
{
//--- Compute J-th column
vs=0;
for(k=j; k<(blocksize+offdiagsize); k++)
{
v=Analysis.m_OutputStorage[OffsS+k*sstride+j];
for(i=0; i<j; i++)
v-=Analysis.m_OutputStorage[OffsS+k*sstride+i]*Analysis.m_DiagD[Cols0+i]*Analysis.m_OutputStorage[OffsS+j*sstride+i];
Analysis.m_OutputStorage.Set(OffsS+k*sstride+j,v);
vs+=MathAbs(v);
}
if(controloverflow && vs>Analysis.m_ModParam1)
//--- Possible failure due to accumulation of numerical errors
return(false);
//--- Handle pivot element
possignvraw=CApServ::PosSign(Analysis.m_InputStorage[OffsS+j*sstride+j]);
v=Analysis.m_OutputStorage[OffsS+j*sstride+j];
if(controlpivot && v/possignvraw<=Analysis.m_ModParam0)
{
//--- Basic modified LDLT
v=possignvraw*Analysis.m_ModParam0;
Analysis.m_DiagD.Set(Cols0+j,v);
Analysis.m_OutputStorage.Set(OffsS+j*sstride+j,1.0);
v=1/v;
for(k=j+1; k<blocksize+offdiagsize; k++)
Analysis.m_OutputStorage.Mul(OffsS+k*sstride+j,v);
}
else
{
//--- Unmodified LDLT
if(v==0)
return(false);
Analysis.m_DiagD.Set(Cols0+j,v);
v=1/v;
for(k=j; k<blocksize+offdiagsize; k++)
Analysis.m_OutputStorage.Mul(OffsS+k*sstride+j,v);
}
}
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| This function returns recommended stride for given row size |
//+------------------------------------------------------------------+
int CSpChol::RecommendedStrideFor(int RowSize)
{
//--- create variables
int result=RowSize;
if(RowSize==3)
result=4;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| This function aligns position in array in order to better |
//| accommodate to SIMD specifics. |
//| NOTE: this function aligns position measured in double precision |
//| numbers, not in bits or bytes. If you want to have 256-bit |
//| aligned position, round Offs to nearest multiple of 4 that |
//| is not less than Offs. |
//+------------------------------------------------------------------+
int CSpChol::AlignPositionInArray(int Offs)
{
//--- create variables
int result=Offs;
if(Offs%4!=0)
result+=4-Offs%4;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Fast kernels for small supernodal updates: special rank - 1 |
//| function. |
//| ! See comments on UpdateSupernode() for information on generic |
//| supernodal updates, including notation used below. |
//| The generic update has following form: |
//| S := S - scatter(U*D*Uc') |
//| This specialized function performs rank - 1 update, i.e.: |
//| * S is a tHeight*A matrix, with A <= 4 |
//| * U is a uHeight * 1 matrix with unit stride |
//| * Uc' is a 1*B matrix, with B<=A |
//| * scatter() scatters rows and columns of U*Uc' |
//| Return value: |
//| * True if update was applied |
//| * False if kernel refused to perform an update(quick exit for |
//| unsupported combinations of input sizes) |
//+------------------------------------------------------------------+
bool CSpChol::UpdateKernelRank1(CRowDouble &RowStorage,
int OffsS,int tWidth,
int tRowStride,int OffsU,
int UHeight,int UWidth,
CRowDouble &DiagD,int OffsD,
CRowInt &Raw2Smap,
CRowInt &SuperRowIdx,
int URBase)
{
//--- create variables
bool result=false;
int k=0;
int targetrow=0;
double d0=DiagD[OffsD];
double u00=0;
double u10=0;
double u20=0;
double u30=0;
double uk=0;
int col0=0;
int col1=0;
int col2=0;
int col3=0;
//--- Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
if(tWidth>4)
return(result);
if(UWidth>4)
return(result);
//--- Determine target columns, load update matrix
if(UWidth>=1)
{
col0=Raw2Smap[SuperRowIdx[URBase+0]];
u00=d0*RowStorage[OffsU+0];
}
if(UWidth>=2)
{
col1=Raw2Smap[SuperRowIdx[URBase+1]];
u10=d0*RowStorage[OffsU+1];
}
if(UWidth>=3)
{
col2=Raw2Smap[SuperRowIdx[URBase+2]];
u20=d0*RowStorage[OffsU+2];
}
if(UWidth>=4)
{
col3=Raw2Smap[SuperRowIdx[URBase+3]];
u30=d0*RowStorage[OffsU+3];
}
//--- Run update
switch(UWidth)
{
case 1:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk=RowStorage[OffsU+k];
RowStorage.Add(targetrow+col0,-u00*uk);
}
break;
case 2:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk=RowStorage[OffsU+k];
RowStorage.Add(targetrow+col0,-u00*uk);
RowStorage.Add(targetrow+col1,- u10*uk);
}
break;
case 3:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk=RowStorage[OffsU+k];
RowStorage.Add(targetrow+col0,-u00*uk);
RowStorage.Add(targetrow+col1,-u10*uk);
RowStorage.Add(targetrow+col2,-u20*uk);
}
break;
case 4:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk=RowStorage[OffsU+k];
RowStorage.Add(targetrow+col0,-u00*uk);
RowStorage.Add(targetrow+col1,-u10*uk);
RowStorage.Add(targetrow+col2,-u20*uk);
RowStorage.Add(targetrow+col3,-u30*uk);
}
break;
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Fast kernels for small supernodal updates : |
//| special rank - 2 function. |
//| ! See comments on UpdateSupernode() for information on generic |
//| ! supernodal updates, including notation used below. |
//| The generic update has following form : |
//| S := S - Scatter(U*D*Uc') |
//| This specialized function performs rank - 2 update, i.e. : |
//| * S is a tHeight*A matrix, with A <= 4 |
//| * U is a uHeight * 2 matrix with row stride equal to 2 |
//| * Uc' is a 2*B matrix, with B<=A |
//| * Scatter() scatters rows and columns of U*Uc |
//| Return value : |
//| * True if update was applied |
//| * False if kernel refused to perform an update(quick exit for |
//| unsupported combinations of input sizes) |
//+------------------------------------------------------------------+
bool CSpChol::UpdateKernelRank2(CRowDouble &RowStorage,int OffsS,
int tWidth,int tRowStride,int OffsU,
int UHeight,int UWidth,
CRowDouble &DiagD,int OffsD,
CRowInt &Raw2Smap,CRowInt &SuperRowIdx,
int URBase)
{
//--- create variables
bool result=false;
int k=0;
int targetrow=0;
double d0=DiagD[OffsD];
double d1=DiagD[OffsD+1];
double u00=0;
double u10=0;
double u20=0;
double u30=0;
double u01=0;
double u11=0;
double u21=0;
double u31=0;
double uk0=0;
double uk1=0;
int col0=0;
int col1=0;
int col2=0;
int col3=0;
//--- Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
if(tWidth>4 || UWidth>4)
return(result);
//--- Determine target columns, load update matrix
if(UWidth>=1)
{
col0=Raw2Smap[SuperRowIdx[URBase+0]];
u00=d0*RowStorage[OffsU+0];
u01=d1*RowStorage[OffsU+1];
}
if(UWidth>=2)
{
col1=Raw2Smap[SuperRowIdx[URBase+1]];
u10=d0*RowStorage[OffsU+1*2+0];
u11=d1*RowStorage[OffsU+1*2+1];
}
if(UWidth>=3)
{
col2=Raw2Smap[SuperRowIdx[URBase+2]];
u20=d0*RowStorage[OffsU+2*2+0];
u21=d1*RowStorage[OffsU+2*2+1];
}
if(UWidth>=4)
{
col3=Raw2Smap[SuperRowIdx[URBase+3]];
u30=d0*RowStorage[OffsU+3*2+0];
u31=d1*RowStorage[OffsU+3*2+1];
}
//--- Run update
switch(UWidth)
{
case 1:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk0=RowStorage[OffsU+2*k+0];
uk1=RowStorage[OffsU+2*k+1];
RowStorage.Add(targetrow+col0,-(u00*uk0+u01*uk1));
}
break;
case 2:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk0=RowStorage[OffsU+2*k];
uk1=RowStorage[OffsU+2*k+1];
RowStorage.Add(targetrow+col0,-(u00*uk0+u01*uk1));
RowStorage.Add(targetrow+col1,-(u10*uk0+u11*uk1));
}
break;
case 3:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk0=RowStorage[OffsU+2*k+0];
uk1=RowStorage[OffsU+2*k+1];
RowStorage.Add(targetrow+col0,-(u00*uk0+u01*uk1));
RowStorage.Add(targetrow+col1,-(u10*uk0+u11*uk1));
RowStorage.Add(targetrow+col2,-(u20*uk0+u21*uk1));
}
break;
case 4:
for(k=0; k<UHeight; k++)
{
targetrow=OffsS+Raw2Smap[SuperRowIdx[URBase+k]]*tRowStride;
uk0=RowStorage[OffsU+2*k+0];
uk1=RowStorage[OffsU+2*k+1];
RowStorage.Add(targetrow+col0,-(u00*uk0+u01*uk1));
RowStorage.Add(targetrow+col1,-(u10*uk0+u11*uk1));
RowStorage.Add(targetrow+col2,-(u20*uk0+u21*uk1));
RowStorage.Add(targetrow+col3,-(u30*uk0+u31*uk1));
}
break;
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| Debug checks for sparsity structure |
//+------------------------------------------------------------------+
void CSpChol::SlowDebugChecks(CSparseMatrix &A,CRowInt &FillinPerm,
int N,
int Tail,
CSparseMatrix &ReferenceTailA)
{
//--- create variables
int i=0;
int j=0;
CSparseMatrix perma;
CMatrixDouble densea;
densea=matrix<double>::Identity(N,N);
CSparse::SparseSymmPermTblBuf(A,false,FillinPerm,perma);
densea.Resize(N,N);
for(i=0; i<N; i++)
{
for(j=0; j<=i; j++)
{
if(!CSparse::SparseExists(perma,i,j))
{
densea.Set(i,j,0);
continue;
}
if(i!=j)
densea.Set(i,j,0.01*(MathCos(i+1)+1.23*MathSin(j+1))/N);
}
}
//--- check
if(!CAp::Assert(DbgMatrixCholesky2(densea,0,N-Tail,false),__FUNCTION__+": densechol failed"))
return;
CAblas::RMatrixRightTrsM(Tail,N-Tail,densea,0,0,false,false,1,densea,N-Tail,0);
CAblas::RMatrixSyrk(Tail,N-Tail,-1.0,densea,N-Tail,0,0,1.0,densea,N-Tail,N-Tail,false);
for(i=N-Tail; i<N; i++)
{
for(j=N-Tail; j<=i; j++)
{
//--- check
if(!CAp::Assert(!(densea.Get(i,j)==0.0 && CSparse::SparseExists(ReferenceTailA,i-(N-Tail),j-(N-Tail))),__FUNCTION__+": structure check 1 failed"))
return;
if(!CAp::Assert(!(densea.Get(i,j)!=0.0 && !CSparse::SparseExists(ReferenceTailA,i-(N-Tail),j-(N-Tail))),__FUNCTION__+": structure check 2 failed"))
return;
}
}
}
//+------------------------------------------------------------------+
//| Dense Cholesky driver for internal integrity checks |
//+------------------------------------------------------------------+
bool CSpChol::DbgMatrixCholesky2(CMatrixDouble &AAA,
int Offs,
int N,
bool IsUpper)
{
//--- check
if(N<0)
return(false);
//--- create variables
bool result=true;
int i=0;
int j=0;
double ajj=0;
double v=0;
double r=0;
CRowDouble tmp=vector<double>::Zeros(2*N);
int i_=0;
int i1_=0;
//--- Quick return if possible
if(N==0)
return(result);
if(IsUpper)
{
//--- Compute the Cholesky factorization A = U'*U.
for(j=0; j<N; j++)
{
//--- Compute U(J,J) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=AAA.Get(i_,Offs+j)*AAA.Get(i_,Offs+j);
ajj=AAA.Get(Offs+j,Offs+j)-v;
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N-1 of row J.
if(j<N-1)
{
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Add(i_,-AAA.Get(i_+i1_,Offs+j));
CAblas::RMatrixMVect(N-j-1,j,AAA,Offs,Offs+j+1,1,tmp,0,tmp,N);
i1_=(N)-(Offs+j+1);
for(i_=Offs+j+1; i_<Offs+N; i_++)
AAA.Add(Offs+j,i_,tmp[i_+i1_]);
}
r=1/ajj;
for(i_=Offs+j+1; i_<Offs+N; i_++)
AAA.Mul(Offs+j,i_,r);
}
}
}
else
{
//---- Compute the Cholesky factorization A = L*L'.
for(j=0; j<N; j++)
{
//--- Compute L(J+1,J+1) and test for non-positive-definiteness.
v=0.0;
for(i_=Offs; i_<Offs+j; i_++)
v+=MathPow(AAA.Get(Offs+j,i_),2);
ajj=AAA.Get(Offs+j,Offs+j)-v;
if(ajj<=0.0)
{
AAA.Set(Offs+j,Offs+j,ajj);
return(false);
}
ajj=MathSqrt(ajj);
AAA.Set(Offs+j,Offs+j,ajj);
//--- Compute elements J+1:N of column J.
if(j<N)
{
r=1/ajj;
if(j>0)
{
i1_=Offs;
for(i_=0; i_<j; i_++)
tmp.Set(i_,AAA.Get(Offs+j,i_+i1_));
CAblas::RMatrixMVect(N-j-1,j,AAA,Offs+j+1,Offs,0,tmp,0,tmp,N);
for(i=0; i<N-j-1; i++)
AAA.Add(Offs+j+1+i,Offs+j,-tmp[N+i]*r);
}
else
{
for(i=0; i<N-j-1; i++)
AAA.Mul(Offs+j+1+i,Offs+j,r);
}
}
}
}
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| This object stores state of the iterative norm estimation |
//| algorithm. |
//| You should use ALGLIB functions to work with this object. |
//+------------------------------------------------------------------+
struct CNormEstimatorState
{
//--- variables
int m_N;
int m_M;
int m_NStart;
int m_NIts;
int m_SeedVal;
bool m_NeedMv;
bool m_NeedMtv;
double m_RepNorm;
//--- arrays
CRowDouble m_X;
CRowDouble m_X0;
CRowDouble m_X1;
CRowDouble m_T;
CRowDouble m_XBest;
CRowDouble m_Mv;
CRowDouble m_Mtv;
//--- states
CHighQualityRandState m_R;
RCommState m_RState;
//--- constructor / destructor
CNormEstimatorState(void);
~CNormEstimatorState(void) {}
void Copy(const CNormEstimatorState &obj);
//--- overloading
void operator=(const CNormEstimatorState &obj) { Copy(obj); }
};
//+------------------------------------------------------------------+
//| Constructor |
//+------------------------------------------------------------------+
CNormEstimatorState::CNormEstimatorState(void)
{
m_N=0;
m_M=0;
m_NStart=0;
m_NIts=0;
m_SeedVal=0;
m_NeedMv=false;
m_NeedMtv=false;
m_RepNorm=0;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CNormEstimatorState::Copy(const CNormEstimatorState &obj)
{
m_N=obj.m_N;
m_M=obj.m_M;
m_NStart=obj.m_NStart;
m_NIts=obj.m_NIts;
m_SeedVal=obj.m_SeedVal;
m_NeedMv=obj.m_NeedMv;
m_NeedMtv=obj.m_NeedMtv;
m_RepNorm=obj.m_RepNorm;
m_X=obj.m_X;
m_X0=obj.m_X0;
m_X1=obj.m_X1;
m_T=obj.m_T;
m_XBest=obj.m_XBest;
m_Mv=obj.m_Mv;
m_Mtv=obj.m_Mtv;
m_R=obj.m_R;
m_RState=obj.m_RState;
}
//+------------------------------------------------------------------+
//| Iterative Norm Estimation |
//+------------------------------------------------------------------+
class CNormEstimator
{
public:
static void NormEstimatorCreate(int m,int n,int nstart,int nits,CNormEstimatorState &state);
static void NormEstimatorSetSeed(CNormEstimatorState &state,int SeedVal);
static bool NormEstimatorIteration(CNormEstimatorState &state);
static void NormEstimatorEstimateSparse(CNormEstimatorState &state,CSparseMatrix &a);
static void NormEstimatorResults(CNormEstimatorState &state,double &nrm);
static void NormEstimatorRestart(CNormEstimatorState &state);
};
//+------------------------------------------------------------------+
//| This procedure initializes matrix norm estimator. |
//| USAGE: |
//| 1. User initializes algorithm state with NormEstimatorCreate() |
//| call |
//| 2. User calls NormEstimatorEstimateSparse() (or |
//| NormEstimatorIteration()) |
//| 3. User calls NormEstimatorResults() to get solution. |
//| INPUT PARAMETERS: |
//| M - number of rows in the matrix being estimated, M>0 |
//| N - number of columns in the matrix being estimated, |
//| N>0 |
//| NStart - number of random starting vectors, recommended |
//| value - at least 5. |
//| NIts - number of iterations to do with best starting |
//| vector recommended value - at least 5. |
//| OUTPUT PARAMETERS: |
//| State - structure which stores algorithm state |
//| NOTE: this algorithm is effectively deterministic, i.e. it always|
//| returns same result when repeatedly called for the same |
//| matrix. In fact, algorithm uses randomized starting v |
//| ectors, but internal random numbers generator always |
//| generates same sequence of the random values (it is a |
//| feature, not bug). |
//| Algorithm can be made non-deterministic with |
//| NormEstimatorSetSeed(0) call. |
//+------------------------------------------------------------------+
void CNormEstimator::NormEstimatorCreate(int m,int n,int nstart,int nits,
CNormEstimatorState &state)
{
//--- check
if(!CAp::Assert(m>0,__FUNCTION__+": M<=0"))
return;
if(!CAp::Assert(n>0,__FUNCTION__+": N<=0"))
return;
if(!CAp::Assert(nstart>0,__FUNCTION__+": NStart<=0"))
return;
if(!CAp::Assert(nits>0,__FUNCTION__+": NIts<=0"))
return;
//--- initialization
state.m_M=m;
state.m_N=n;
state.m_NStart=nstart;
state.m_NIts=nits;
state.m_SeedVal=11;
CHighQualityRand::HQRndRandomize(state.m_R);
state.m_X0.Resize(state.m_N);
state.m_T.Resize(state.m_M);
state.m_X1.Resize(state.m_N);
state.m_XBest.Resize(state.m_N);
state.m_X.Resize(MathMax(state.m_N,state.m_M));
state.m_Mv.Resize(state.m_M);
state.m_Mtv.Resize(state.m_N);
state.m_RState.ia.Resize(3+1);
state.m_RState.ra.Resize(2+1);
state.m_RState.stage=-1;
}
//+------------------------------------------------------------------+
//| This function changes seed value used by algorithm. In some cases|
//| we need deterministic processing, i.e. subsequent calls must |
//| return equal results, in other cases we need non-deterministic |
//| algorithm which returns different results for the same matrix on |
//| every pass. |
//| Setting zero seed will lead to non-deterministic algorithm, while|
//| non-zero value will make our algorithm deterministic. |
//| INPUT PARAMETERS: |
//| State - norm estimator state, must be initialized with a |
//| call to NormEstimatorCreate() |
//| SeedVal - seed value, >=0. Zero value=non-deterministic algo.|
//+------------------------------------------------------------------+
void CNormEstimator::NormEstimatorSetSeed(CNormEstimatorState &state,
int SeedVal)
{
//--- check
if(!CAp::Assert(SeedVal>=0,__FUNCTION__+": SeedVal<0"))
return;
state.m_SeedVal=SeedVal;
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CNormEstimator::NormEstimatorIteration(CNormEstimatorState &state)
{
//--- create variables
bool result;
int n=0;
int m=0;
int i=0;
int itcnt=0;
double v=0;
double growth=0;
double bestgrowth=0;
int i_=0;
int label=-1;
//--- Reverse communication preparations
//--- I know it looks ugly, but it works the same way
//--- anywhere from C++ to Python.
//--- This code initializes locals by:
//--- * random values determined during code
//--- generation - on first subroutine call
//--- * values from previous call - on subsequent calls
if(state.m_RState.stage>=0)
{
n=state.m_RState.ia[0];
m=state.m_RState.ia[1];
i=state.m_RState.ia[2];
itcnt=state.m_RState.ia[3];
v=state.m_RState.ra[0];
growth=state.m_RState.ra[1];
bestgrowth=state.m_RState.ra[2];
}
else
{
n=359;
m=-58;
i=-919;
itcnt=-909;
v=81;
growth=255;
bestgrowth=74;
}
switch(state.m_RState.stage)
{
case 0:
label=0;
break;
case 1:
label=1;
break;
case 2:
label=2;
break;
case 3:
label=3;
break;
default:
//--- Routine body
n=state.m_N;
m=state.m_M;
if(state.m_SeedVal>0)
CHighQualityRand::HQRndSeed(state.m_SeedVal,state.m_SeedVal+2,state.m_R);
bestgrowth=0;
state.m_XBest=vector<double>::Zeros(n);
state.m_XBest.Set(0,1);
itcnt=0;
label=4;
break;
}
//--- main loop
while(label>=0)
switch(label)
{
case 4:
if(itcnt>state.m_NStart-1)
{
label=6;
break;
}
do
{
v=0;
for(i=0; i<n; i++)
{
state.m_X0.Set(i,CHighQualityRand::HQRndNormal(state.m_R));
v+=CMath::Sqr(state.m_X0[i]);
}
}
while(v==0.0);
v=1/MathSqrt(v);
state.m_X0*=v;
for(i_=0; i_<n; i_++)
state.m_X.Set(i_,state.m_X0[i_]);
state.m_NeedMv=true;
state.m_NeedMtv=false;
state.m_RState.stage=0;
label=-1;
break;
case 0:
for(i_=0; i_<m; i_++)
state.m_X.Set(i_,state.m_Mv[i_]);
state.m_NeedMv=false;
state.m_NeedMtv=true;
state.m_RState.stage=1;
label=-1;
break;
case 1:
state.m_X1=state.m_Mtv;
v=CAblasF::RDotV2(n,state.m_X1);
growth=MathSqrt(MathSqrt(v));
if(growth>bestgrowth)
{
v=1/MathSqrt(v);
state.m_XBest=state.m_X1.ToVector()*v;
bestgrowth=growth;
}
itcnt++;
label=4;
break;
case 6:
state.m_X0=state.m_XBest;
itcnt=0;
case 7:
if(itcnt>state.m_NIts-1)
{
label=9;
break;
}
for(i_=0; i_<n; i_++)
state.m_X.Set(i_,state.m_X0[i_]);
state.m_NeedMv=true;
state.m_NeedMtv=false;
state.m_RState.stage=2;
label=-1;
break;
case 2:
for(i_=0; i_<m; i_++)
state.m_X.Set(i_,state.m_Mv[i_]);
state.m_NeedMv=false;
state.m_NeedMtv=true;
state.m_RState.stage=3;
label=-1;
break;
case 3:
state.m_X1=state.m_Mtv;
v=CAblasF::RDotV2(n,state.m_X1);
state.m_RepNorm=MathSqrt(MathSqrt(v));
if(v!=0.0)
{
v=1/MathSqrt(v);
state.m_X0=state.m_X1.ToVector()*v;
}
itcnt++;
label=7;
break;
case 9:
result=false;
return(result);
}
//--- Saving state
state.m_RState.ia.Set(0,n);
state.m_RState.ia.Set(1,m);
state.m_RState.ia.Set(2,i);
state.m_RState.ia.Set(3,itcnt);
state.m_RState.ra.Set(0,v);
state.m_RState.ra.Set(1,growth);
state.m_RState.ra.Set(2,bestgrowth);
//--- return result
return(true);
}
//+------------------------------------------------------------------+
//| This function estimates norm of the sparse M*N matrix A. |
//| INPUT PARAMETERS: |
//| State - norm estimator state, must be initialized with a |
//| call to NormEstimatorCreate() |
//| A - sparse M*N matrix, must be converted to CRS format |
//| prior to calling this function. |
//| After this function is over you can call NormEstimatorResults() |
//| to get estimate of the norm(A). |
//+------------------------------------------------------------------+
void CNormEstimator::NormEstimatorEstimateSparse(CNormEstimatorState &state,
CSparseMatrix &a)
{
NormEstimatorRestart(state);
while(NormEstimatorIteration(state))
{
if(state.m_NeedMv)
{
CSparse::SparseMV(a,state.m_X,state.m_Mv);
continue;
}
if(state.m_NeedMtv)
{
CSparse::SparseMTV(a,state.m_X,state.m_Mtv);
continue;
}
}
}
//+------------------------------------------------------------------+
//| Matrix norm estimation results |
//| INPUT PARAMETERS: |
//| State - algorithm state |
//| OUTPUT PARAMETERS: |
//| Nrm - estimate of the matrix norm, Nrm >= 0 |
//+------------------------------------------------------------------+
void CNormEstimator::NormEstimatorResults(CNormEstimatorState &state,
double &nrm)
{
nrm=0;
nrm=state.m_RepNorm;
}
//+------------------------------------------------------------------+
//| This function restarts estimator and prepares it for the next |
//| estimation round. |
//| INPUT PARAMETERS: |
//| State - algorithm state |
//+------------------------------------------------------------------+
void CNormEstimator::NormEstimatorRestart(CNormEstimatorState &state)
{
state.m_RState.ia.Resize(3+1);
state.m_RState.ra=vector<double>::Zeros(2+1);
state.m_RState.stage=-1;
}
//+------------------------------------------------------------------+
//| Schur decomposition of Hessenberg matrix |
//+------------------------------------------------------------------+
class CHsSchur
{
public:
static void RMatrixInternalSchurDecomposition(CMatrixDouble &h,int n,int tneeded,int zneeded,CRowDouble &wr,CRowDouble &wi,CMatrixDouble &z,int &info);
static bool UpperHessenbergSchurDecomposition(CMatrixDouble &h,const int n,CMatrixDouble &s);
static void InternalSchurDecomposition(CMatrixDouble &h,const int n,const int tneeded,const int zneeded,double &wr[],double &wi[],CMatrixDouble &z,int &info);
static void InternalSchurDecomposition(CMatrixDouble &h,const int n,const int tneeded,const int zneeded,CRowDouble &wr,CRowDouble &wi,CMatrixDouble &z,int &info);
private:
static void InternalAuxSchur(const bool wantt,const bool wantz,const int n,const int ilo,const int ihi,CMatrixDouble &h,CRowDouble &wr,CRowDouble &wi,const int iloz,const int ihiz,CMatrixDouble &z,CRowDouble &work,CRowDouble &workv3,CRowDouble &workc1,CRowDouble &works1,int &info);
static void Aux2x2Schur(double &a,double &b,double &c,double &d,double &rt1r,double &rt1i,double &rt2r,double &rt2i,double &cs,double &sn);
static double ExtSchurSign(const double a,const double b);
static int ExtSchurSignToone(const double b);
};
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
void CHsSchur::RMatrixInternalSchurDecomposition(CMatrixDouble &h,
int n,int tneeded,int zneeded,CRowDouble &wr,CRowDouble &wi,
CMatrixDouble &z,int &info)
{
//--- create variables
int i=0;
int j=0;
CMatrixDouble h1;
CMatrixDouble z1;
CRowDouble wr1;
CRowDouble wi1;
info=0;
//--- Allocate space
wr.Resize(n);
wi.Resize(n);
if(zneeded==2)
CApServ::RMatrixSetLengthAtLeast(z,n,n);
//--- ALGLIB version
h1.Resize(n+1,n+1);
for(i=0; i<n; i++)
{
for(j=0; j<n; j++)
h1.Set(1+i,1+j,h.Get(i,j));
}
if(zneeded==1)
{
z1.Resize(n+1,n+1);
for(i=0; i<n; i++)
for(j=0; j<n; j++)
z1.Set(1+i,1+j,z.Get(i,j));
}
InternalSchurDecomposition(h1,n,tneeded,zneeded,wr1,wi1,z1,info);
for(i=0; i<=n-1; i++)
{
wr.Set(i,wr1[i+1]);
wi.Set(i,wi1[i+1]);
}
if(tneeded!=0)
{
for(i=0; i<n; i++)
for(j=0; j<n; j++)
h.Set(i,j,h1.Get(1+i,1+j));
}
if(zneeded!=0)
{
if(!CApServ::RMatrixSetLengthAtLeast(z,n,n))
return;
for(i=0; i<n; i++)
for(j=0; j<n; j++)
z.Set(i,j,z1.Get(1+i,1+j));
}
}
//+------------------------------------------------------------------+
//| Subroutine performing the Schur decomposition of a matrix in |
//| upper Hessenberg form using the QR algorithm with multiple |
//| shifts. |
//| The source matrix H is represented as S'*H*S = T, where H - |
//| matrix in upper Hessenberg form, S - orthogonal matrix (Schur |
//| vectors), T - upper quasi-triangular matrix (with blocks of sizes|
//| 1x1 and 2x2 on the main diagonal). |
//| Input parameters: |
//| H - matrix to be decomposed. |
//| Array whose indexes range within [1..N, 1..N]. |
//| N - size of H, N>=0. |
//| Output parameters: |
//| H ? contains the matrix T. |
//| Array whose indexes range within [1..N, 1..N]. |
//| All elements below the blocks on the main diagonal |
//| are equal to 0. |
//| S - contains Schur vectors. |
//| Array whose indexes range within [1..N, 1..N]. |
//| Note 1: |
//| The block structure of matrix T could be easily recognized: |
//| since all the elements below the blocks are zeros, the |
//| elements a[i+1,i] which are equal to 0 show the block border.|
//| Note 2: |
//| the algorithm performance depends on the value of the |
//| internal parameter NS of InternalSchurDecomposition |
//| subroutine which defines the number of shifts in the QR |
//| algorithm (analog of the block width in block matrix |
//| algorithms in linear algebra). If you require maximum |
//| performance on your machine, it is recommended to |
//| adjust thisparameter manually. |
//| Result: |
//| True, if the algorithm has converged and the parameters H and|
//| S contain the result. |
//| False, if the algorithm has not converged. |
//| Algorithm implemented on the basis of subroutine DHSEQR |
//| (LAPACK 3.0 library). |
//+------------------------------------------------------------------+
bool CHsSchur::UpperHessenbergSchurDecomposition(CMatrixDouble &h,
const int n,
CMatrixDouble &s)
{
//--- create variables
bool result;
int info=0;
//--- create arrays
CRowDouble wi;
CRowDouble wr;
//--- function call
InternalSchurDecomposition(h,n,1,2,wr,wi,s,info);
result=info==0;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Internal subroutine |
//+------------------------------------------------------------------+
void CHsSchur::InternalSchurDecomposition(CMatrixDouble &h,const int n,
const int tneeded,
const int zneeded,
CRowDouble &wr,CRowDouble &wi,
CMatrixDouble &z,int &info)
{
//--- check
if(!CAp::Assert(n>=0,__FUNCTION__+": incorrect N!"))
return;
if(!CAp::Assert(tneeded==0 || tneeded==1,__FUNCTION__+": incorrect TNeeded!"))
return;
if(!CAp::Assert((zneeded==0 || zneeded==1) || zneeded==2,__FUNCTION__+": incorrect ZNeeded!"))
return;
//--- create variables
int i=0;
int i1=0;
int i2=0;
int ierr=0;
int ii=0;
int itemp=0;
int itn=0;
int its=0;
int j=0;
int k=0;
int l=0;
int maxb=0;
int nr=0;
int ns=0;
int nv=0;
double absw=0;
double smlnum=0;
double tau=0;
double temp=0;
double tst1=0;
double ulp=0;
double unfl=0;
bool initz;
bool wantt;
bool wantz;
double cnst=0;
bool failflag;
int p1=0;
int p2=0;
double vt=0;
int i_=0;
int i1_=0;
//--- create arrays
CRowDouble v;
CRowDouble vv;
CRowDouble work;
CRowDouble workc1;
CRowDouble works1;
CRowDouble workv3;
CRowDouble tmpwr;
CRowDouble tmpwi;
CMatrixDouble s;
//--- initialization
info=0;
//--- Set the order of the multi-shift QR algorithm to be used.
//--- If you want to tune algorithm, change this values
ns=12;
maxb=50;
//--- Now 2 < NS <= MAXB < NH.
maxb=(int)MathMax(3,maxb);
ns=MathMin(maxb,ns);
//--- Initialize
cnst=1.5;
//--- allocation
work=vector<double>::Zeros((int)MathMax(n,1)+1);
s=matrix<double>::Zeros(ns+1,ns+1);
v=vector<double>::Zeros(ns+2);
vv=vector<double>::Zeros(ns+2);
wr=vector<double>::Zeros((int)MathMax(n,1)+1);
wi=vector<double>::Zeros((int)MathMax(n,1)+1);
workc1=vector<double>::Zeros(2);
works1=vector<double>::Zeros(2);
workv3=vector<double>::Zeros(4);
tmpwr.Resize((int)MathMax(n,1)+1);
tmpwi.Resize((int)MathMax(n,1)+1);
//--- initialization
wantt=tneeded==1;
initz=zneeded==2;
wantz=zneeded!=0;
info=0;
//--- Initialize Z, if necessary
if(initz)
z=matrix<double>::Eye(n+1,n+1);
//--- Quick return if possible
if(n==0)
return;
//--- check
if(n==1)
{
wr.Set(1,h.Get(1,1));
wi.Set(1,0);
//--- exit the function
return;
}
//--- Set rows and columns 1 to N to zero below the first
//--- subdiagonal.
h=h.TriU(-1)*1.0;
//--- Test if N is sufficiently small
if((ns<=2 || ns>n) || maxb>=n)
{
//--- Use the standard double-shift algorithm
InternalAuxSchur(wantt,wantz,n,1,n,h,wr,wi,1,n,z,work,workv3,workc1,works1,info);
//--- fill entries under diagonal blocks of T with zeros
if(wantt)
{
j=1;
while(j<=n)
{
//--- check
if(wi[j]==0.0)
{
for(i=j+1; i<=n; i++)
h.Set(i,j,0);
j=j+1;
}
else
{
for(i=j+2; i<=n; i++)
{
h.Set(i,j,0);
h.Set(i,j+1,0);
}
j=j+2;
}
}
}
//--- exit the function
return;
}
//--- change values
unfl=CMath::m_minrealnumber;
ulp=2*CMath::m_machineepsilon;
smlnum=unfl*(n/ulp);
//--- I1 and I2 are the indices of the first row and last column of H
//--- to which transformations must be applied. If eigenvalues only are
//--- being computed, I1 and I2 are set inside the main loop.
i1=1;
i2=n;
//--- ITN is the total number of multiple-shift QR iterations allowed.
itn=30*n;
//--- The main loop begins here. I is the loop index and decreases from
//--- IHI to ILO in steps of at most MAXB. Each iteration of the loop
//--- works with the active submatrix in rows and columns L to I.
//--- Eigenvalues I+1 to IHI have already converged. Either L = ILO or
//--- H(L,L-1) is negligible so that the matrix splits.
i=n;
while(true)
{
l=1;
//--- check
if(i<1)
{
//--- fill entries under diagonal blocks of T with zeros
if(wantt)
{
j=1;
while(j<=n)
{
//--- check
if(wi[j]==0.0)
{
for(i=j+1; i<=n; i++)
h.Set(i,j,0);
j=j+1;
}
else
{
for(i=j+2; i<=n; i++)
{
h.Set(i,j,0);
h.Set(i,j+1,0);
}
j=j+2;
}
}
}
//--- Exit
return;
}
//--- Perform multiple-shift QR iterations on rows and columns ILO to I
//--- until a submatrix of order at most MAXB splits off at the bottom
//--- because a subdiagonal element has become negligible.
failflag=true;
for(its=0; its<=itn; its++)
{
//--- Look for a single small subdiagonal element.
for(k=i; k>=l+1; k--)
{
tst1=MathAbs(h[k-1][k-1])+MathAbs(h[k][k]);
//--- check
if(tst1==0.0)
tst1=CBlas::UpperHessenberg1Norm(h,l,i,l,i,work);
//--- check
if(MathAbs(h[k][k-1])<=MathMax(ulp*tst1,smlnum))
break;
}
l=k;
//--- check
if(l>1)
//--- H(L,L-1) is negligible.
h.Set(l,l-1,0);
//--- Exit from loop if a submatrix of order <= MAXB has split off.
if(l>=i-maxb+1)
{
failflag=false;
break;
}
//--- Now the active submatrix is in rows and columns L to I. If
//--- eigenvalues only are being computed, only the active submatrix
//--- need be transformed.
if(its==20 || its==30)
{
//--- Exceptional shifts.
for(ii=i-ns+1; ii<=i; ii++)
{
wr.Set(ii,cnst*(MathAbs(h.Get(ii,ii-1))+MathAbs(h.Get(ii,ii))));
wi.Set(ii,0);
}
}
else
{
//--- Use eigenvalues of trailing submatrix of order NS as shifts.
CBlas::CopyMatrix(h,i-ns+1,i,i-ns+1,i,s,1,ns,1,ns);
//--- function call
InternalAuxSchur(false,false,ns,1,ns,s,tmpwr,tmpwi,1,ns,z,work,workv3,workc1,works1,ierr);
for(p1=1; p1<=ns; p1++)
{
wr.Set(i-ns+p1,tmpwr[p1]);
wi.Set(i-ns+p1,tmpwi[p1]);
}
//--- check
if(ierr>0)
{
//--- If DLAHQR failed to compute all NS eigenvalues, use the
//--- unconverged diagonal elements as the remaining shifts.
for(ii=1; ii<=ierr; ii++)
{
wr.Set(i-ns+ii,s.Get(ii,ii));
wi.Set(i-ns+ii,0);
}
}
}
//--- Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
//--- where G is the Hessenberg submatrix H(L:I,L:I) and w is
//--- the vector of shifts (stored in WR and WI). The result is
//--- stored in the local array V.
v.Set(1,1);
for(ii=2; ii<ns; ii++)
v.Set(ii,0);
nv=1;
for(j=i-ns+1; j<=i; j++)
{
//--- check
if(wi[j]>=0.0)
{
//--- check
if(wi[j]==0.0)
{
//--- real shift
p1=nv+1;
for(i_=1; i_<=p1; i_++)
vv.Set(i_,v[i_]);
//--- function call
CBlas::MatrixVectorMultiply(h,l,l+nv,l,l+nv-1,false,vv,1,nv,1.0,v,1,nv+1,-wr[j]);
nv=nv+1;
}
else
{
//--- check
if(wi[j]>0.0)
{
//--- complex conjugate pair of shifts
p1=nv+1;
for(i_=1; i_<=p1; i_++)
vv.Set(i_,v[i_]);
//--- function call
CBlas::MatrixVectorMultiply(h,l,l+nv,l,l+nv-1,false,v,1,nv,1.0,vv,1,nv+1,-(2*wr[j]));
//--- function call
itemp=CBlas::VectorIdxAbsMax(vv,1,nv+1);
temp=1/MathMax(MathAbs(vv[itemp]),smlnum);
p1=nv+1;
for(i_=1; i_<=p1; i_++)
vv.Set(i_,temp*vv[i_]);
//--- function call
absw=CBlas::PyThag2(wr[j],wi[j]);
temp=temp*absw*absw;
//--- function call
CBlas::MatrixVectorMultiply(h,l,l+nv+1,l,l+nv,false,vv,1,nv+1,1.0,v,1,nv+2,temp);
nv=nv+2;
}
}
//--- Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
//--- reset it to the unit vector.
itemp=CBlas::VectorIdxAbsMax(v,1,nv);
temp=MathAbs(v[itemp]);
//--- check
if(temp==0.0)
{
v.Set(1,1);
for(ii=2; ii<=nv; ii++)
v.Set(ii,0);
}
else
{
temp=MathMax(temp,smlnum);
vt=1/temp;
for(i_=1; i_<=nv; i_++)
v.Set(i_,vt*v[i_]);
}
}
}
//--- Multiple-shift QR step
for(k=l; k<=i-1; k++)
{
//--- The first iteration of this loop determines a reflection G
//--- from the vector V and applies it from left and right to H,
//--- thus creating a nonzero bulge below the subdiagonal.
//--- Each subsequent iteration determines a reflection G to
//--- restore the Hessenberg form in the (K-1)th column, and thus
//--- chases the bulge one step toward the bottom of the active
//--- submatrix. NR is the order of G.
nr=MathMin(ns+1,i-k+1);
//--- check
if(k>l)
{
//--- change values
p1=k-1;
p2=k+nr-1;
i1_=k-1;
for(i_=1; i_<=nr; i_++)
v.Set(i_,h.Get(i_+i1_,p1));
}
//--- function call
CAblas::GenerateReflection(v,nr,tau);
//--- check
if(k>l)
{
h.Set(k,k-1,v[1]);
for(ii=k+1; ii<=i; ii++)
h.Set(ii,k-1,0);
}
v.Set(1,1);
//--- Apply G from the left to transform the rows of the matrix in
//--- columns K to I2.
CAblas::ApplyReflectionFromTheLeft(h,tau,v,k,k+nr-1,k,i2,work);
//--- Apply G from the right to transform the columns of the
//--- matrix in rows I1 to min(K+NR,I).
CAblas::ApplyReflectionFromTheRight(h,tau,v,i1,MathMin(k+nr,i),k,k+nr-1,work);
//--- check
if(wantz)
//--- Accumulate transformations in the matrix Z
CAblas::ApplyReflectionFromTheRight(z,tau,v,1,n,k,k+nr-1,work);
}
}
//--- Failure to converge in remaining number of iterations
if(failflag)
{
info=i;
//--- exit the function
return;
}
//--- A submatrix of order <= MAXB in rows and columns L to I has split
//--- off. Use the double-shift QR algorithm to handle it.
InternalAuxSchur(wantt,wantz,n,l,i,h,wr,wi,1,n,z,work,workv3,workc1,works1,info);
//--- check
if(info>0)
return;
//--- Decrement number of remaining iterations, and return to start of
//--- the main loop with a new value of I.
itn=itn-its;
i=l-1;
}
}
//+------------------------------------------------------------------+
//| Translation of DLAHQR from LAPACK |
//+------------------------------------------------------------------+
void CHsSchur::InternalAuxSchur(const bool wantt,const bool wantz,
const int n,const int ilo,const int ihi,
CMatrixDouble &h,CRowDouble &wr,CRowDouble &wi,
const int iloz,const int ihiz,CMatrixDouble &z,
CRowDouble &work,CRowDouble &workv3,
CRowDouble &workc1,CRowDouble &works1,int &info)
{
//--- create variables
double safmin=0;
double tst=0;
double ab=0;
double ba=0;
double aa=0;
double bb=0;
double rt1r=0;
double rt1i=0;
double rt2r=0;
double rt2i=0;
double tr=0;
double det=0;
double rtdisc=0;
double h21s=0;
int i=0;
int i1=0;
int i2=0;
int itmax=0;
int its=0;
int j=0;
int k=0;
int l=0;
int m=0;
int nh=0;
int nr=0;
int nz=0;
double cs=0;
double h11=0;
double h12=0;
double h21=0;
double h22=0;
double s=0;
double smlnum=0;
double sn=0;
double sum=0;
double t1=0;
double t2=0;
double t3=0;
double v2=0;
double v3=0;
bool failflag;
double dat1=0;
double dat2=0;
int p1=0;
double him1im1=0;
double him1i=0;
double hiim1=0;
double hii=0;
double wrim1=0;
double wri=0;
double wiim1=0;
double wii=0;
double ulp=0;
//--- initialization
info=0;
dat1=0.75;
dat2=-0.4375;
ulp=CMath::m_machineepsilon;
//--- Quick return if possible
if(n==0)
return;
//--- check
if(ilo==ihi)
{
wr.Set(ilo,h.Get(ilo,ilo));
wi.Set(ilo,0);
//--- exit the function
return;
}
//--- clear out the trash
//
for(j=ilo; j<ihi-2; j++)
{
h.Set(j+2,j,0);
h.Set(j+3,j,0);
}
if(ilo<=ihi-2)
h.Set(ihi,ihi-2,0);
//--- initialization
nh=ihi-ilo+1;
nz=ihiz-iloz+1;
//--- Set machine-dependent constants for the stopping criterion.
//--- If norm(H) <= sqrt(OVFL), overflow should not occur.
safmin=CMath::m_minrealnumber;
smlnum=safmin*(nh/ulp);
//--- I1 and I2 are the indices of the first row and last column of H
//--- to which transformations must be applied. If eigenvalues only are
//--- being computed, I1 and I2 are set inside the main loop.
if(wantt)
{
i1=1;
i2=n;
}
else
i1=i2=-99999;
//--- ITN is the total number of QR iterations allowed.
itmax=30*MathMax(10,nh);
//--- The main loop begins here. I is the loop index and decreases from
//--- IHI to ILO in steps of 1 or 2. Each iteration of the loop works
//--- with the active submatrix in rows and columns L to I.
//--- Eigenvalues I+1 to IHI have already converged. Either L = ILO or
//--- H(L,L-1) is negligible so that the matrix splits.
i=ihi;
while(true)
{
l=ilo;
//--- check
if(i<ilo)
return;
//--- Perform QR iterations on rows and columns ILO to I until a
//--- submatrix of order 1 or 2 splits off at the bottom because a
//--- subdiagonal element has become negligible.
failflag=true;
for(its=0; its<=itmax; its++)
{
//--- Look for a single small subdiagonal element.
for(k=i; k>l; k--)
{
//--- check
if(MathAbs(h[k][k-1])<=smlnum)
break;
tst=MathAbs(h[k-1][k-1])+MathAbs(h[k][k]);
//--- check
if(tst==0.0)
{
if(k-2>=ilo)
tst=tst+MathAbs(h[k-1][k-2]);
if(k+1<=ihi)
tst=tst+MathAbs(h[k+1][k]);
}
//--- The following is a conservative small subdiagonal
//--- deflation criterion due to Ahues & Tisseur (LAWN 122,
//--- 1997). It has better mathematical foundation and
//--- improves accuracy in some cases.
if(MathAbs(h[k][k-1])<=(double)(ulp*tst))
{
ab=MathMax(MathAbs(h[k][k-1]),MathAbs(h[k-1][k]));
ba=MathMin(MathAbs(h[k][k-1]),MathAbs(h[k-1][k]));
aa=MathMax(MathAbs(h[k][k]),MathAbs(h[k-1][k-1]-h[k][k]));
bb=MathMin(MathAbs(h[k][k]),MathAbs(h[k-1][k-1]-h[k][k]));
s=aa+ab;
if((ba*(ab/s))<=MathMax(smlnum,ulp*(bb*(aa/s))))
break;
}
}
l=k;
//--- check
if(l>ilo)
//--- H(L,L-1) is negligible
h.Set(l,l-1,0);
//--- Exit from loop if a submatrix of order 1 or 2 has split off.
if(l>=i-1)
{
failflag=false;
break;
}
//--- Now the active submatrix is in rows and columns L to I. If
//--- eigenvalues only are being computed, only the active submatrix
//--- need be transformed.
if(!wantt)
{
i1=l;
i2=i;
}
if(its==10)
{
//--- Exceptional shift.
s=MathAbs(h[l+1][l])+MathAbs(h[l+2][l+1]);
h22=h11=dat1*s+h[l][l];
h12=dat2*s;
h21=s;
}
else
{
if(its==20)
{
//--- Exceptional shift.
s=MathAbs(h[i][i-1])+MathAbs(h[i-1][i-2]);
h22=h11=dat1*s+h[i][i];
h12=dat2*s;
h21=s;
}
else
{
//--- Prepare to use Francis' double shift
//--- (i.e. 2nd degree generalized Rayleigh quotient)
h11=h[i-1][i-1];
h21=h[i][i-1];
h12=h[i-1][i];
h22=h[i][i];
}
}
s=MathAbs(h11)+MathAbs(h12)+MathAbs(h21)+MathAbs(h22);
if(s==0.0)
{
rt1r=0;
rt1i=0;
rt2r=0;
rt2i=0;
}
else
{
h11=h11/s;
h21=h21/s;
h12=h12/s;
h22=h22/s;
tr=(h11+h22)/2;
det=(h11-tr)*(h22-tr)-h12*h21;
rtdisc=MathSqrt(MathAbs(det));
if(det>=0.0)
{
//--- complex conjugate shifts
rt1r=tr*s;
rt2r=rt1r;
rt1i=rtdisc*s;
rt2i=-rt1i;
}
else
{
//--- real shifts (use only one of them)
rt1r=tr+rtdisc;
rt2r=tr-rtdisc;
if(MathAbs(rt1r-h22)<=MathAbs(rt2r-h22))
{
rt1r=rt1r*s;
rt2r=rt1r;
}
else
{
rt2r=rt2r*s;
rt1r=rt2r;
}
rt1i=0;
rt2i=0;
}
}
//--- Look for two consecutive small subdiagonal elements.
for(m=i-2; m>=l; m--)
{
//--- Determine the effect of starting the double-shift QR
//--- iteration at row M, and see if this would make H(M,M-1)
//--- negligible.
s=MathAbs(h[m][m]-rt2r)+MathAbs(rt2i)+MathAbs(h[m+1][m]);
h21s=h[m+1][m]/s;
workv3.Set(1,h21s*h[m][m+1]+(h[m][m]-rt1r)*((h[m][m]-rt2r)/s)-rt1i*(rt2i/s));
workv3.Set(2,h21s*(h[m][m]+h[m+1][m+1]-rt1r-rt2r));
workv3.Set(3,h21s*h[m+2][m+1]);
s=MathAbs(workv3[1])+MathAbs(workv3[2])+MathAbs(workv3[3]);
workv3.Set(1,workv3[1]/s);
workv3.Set(2,workv3[2]/s);
workv3.Set(3,workv3[3]/s);
//--- check
if(m==l)
break;
if((MathAbs(h.Get(m,m-1))*(MathAbs(workv3[2])+MathAbs(workv3[3])))<=(ulp*MathAbs(workv3[1])*(MathAbs(h[m-1][m-1])+MathAbs(h[m][m])+MathAbs(h[m+1][m+1]))))
break;
}
//--- Double-shift QR step
for(k=m; k<i; k++)
{
//--- The first iteration of this loop determines a reflection G
//--- from the vector V and applies it from left and right to H,
//--- thus creating a nonzero bulge below the subdiagonal.
//--- Each subsequent iteration determines a reflection G to
//--- restore the Hessenberg form in the (K-1)th column, and thus
//--- chases the bulge one step toward the bottom of the active
//--- submatrix. NR is the order of G.
nr=(int)MathMin(3,i-k+1);
//--- check
if(k>m)
{
for(p1=1; p1<=nr; p1++)
workv3.Set(p1,h.Get(k+p1-1,k-1));
}
//--- function call
CAblas::GenerateReflection(workv3,nr,t1);
//--- check
if(k>m)
{
h.Set(k,k-1,workv3[1]);
h.Set(k+1,k-1,0);
//--- check
if(k<i-1)
h.Set(k+2,k-1,0);
}
else
{
//--- check
if(m>l)
//--- Use the following instead of
//--- H( K, K-1 ) = -H( K, K-1 ) to
//--- avoid a bug when v(2) and v(3)
//--- underflow.
h.Set(k,k-1,-h[k][k-1]);
}
v2=workv3[2];
t2=t1*v2;
//--- check
if(nr==3)
{
v3=workv3[3];
t3=t1*v3;
//--- Apply G from the left to transform the rows of the matrix
//--- in columns K to I2.
for(j=k; j<=i2; j++)
{
sum=h[k][j]+v2*h[k+1][j]+v3*h[k+2][j];
h.Set(k,j,h[k][j]-sum*t1);
h.Set(k+1,j,h[k+1][j]-sum*t2);
h.Set(k+2,j,h[k+2][j]-sum*t3);
}
//--- Apply G from the right to transform the columns of the
//--- matrix in rows I1 to min(K+3,I).
for(j=i1; j<=MathMin(k+3,i); j++)
{
sum=h[j][k]+v2*h[j][k+1]+v3*h[j][k+2];
h.Set(j,k,h[j][k]-sum*t1);
h.Set(j,k+1,h[j][k+1]-sum*t2);
h.Set(j,k+2,h[j][k+2]-sum*t3);
}
//--- check
if(wantz)
{
//--- Accumulate transformations in the matrix Z
for(j=iloz; j<=ihiz; j++)
{
sum=z[j][k]+v2*z[j][k+1]+v3*z[j][k+2];
z.Set(j,k,z[j][k]-sum*t1);
z.Set(j,k+1,z[j][k+1]-sum*t2);
z.Set(j,k+2,z[j][k+2]-sum*t3);
}
}
}
else
{
//--- check
if(nr==2)
{
//--- Apply G from the left to transform the rows of the matrix
//--- in columns K to I2.
for(j=k; j<=i2; j++)
{
sum=h[k][j]+v2*h[k+1][j];
h.Set(k,j,h[k][j]-sum*t1);
h.Set(k+1,j,h[k+1][j]-sum*t2);
}
//--- Apply G from the right to transform the columns of the
//--- matrix in rows I1 to min(K+3,I).
for(j=i1; j<=i; j++)
{
sum=h[j][k]+v2*h[j][k+1];
h.Set(j,k,h[j][k]-sum*t1);
h.Set(j,k+1,h[j][k+1]-sum*t2);
}
//--- check
if(wantz)
{
//--- Accumulate transformations in the matrix Z
for(j=iloz; j<=ihiz; j++)
{
sum=z[j][k]+v2*z[j][k+1];
z.Set(j,k,z[j][k]-sum*t1);
z.Set(j,k+1,z[j][k+1]-sum*t2);
}
}
}
}
}
}
//--- check
if(failflag)
{
//--- Failure to converge in remaining number of iterations
info=i;
//--- exit the function
return;
}
//--- Convergence
if(l==i)
{
//--- H(I,I-1) is negligible: one eigenvalue has converged.
wr.Set(i,h.Get(i,i));
wi.Set(i,0);
}
else
{
//--- check
if(l==i-1)
{
//--- H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
//--- Transform the 2-by-2 submatrix to standard Schur form,
//--- and compute and store the eigenvalues.
him1im1=h[i-1][i-1];
him1i=h[i-1][i];
hiim1=h[i][i-1];
hii=h[i][i];
//--- function call
Aux2x2Schur(him1im1,him1i,hiim1,hii,wrim1,wiim1,wri,wii,cs,sn);
//--- change values
wr.Set(i-1,wrim1);
wi.Set(i-1,wiim1);
wr.Set(i,wri);
wi.Set(i,wii);
h.Set(i-1,i-1,him1im1);
h.Set(i-1,i,him1i);
h.Set(i,i-1,hiim1);
h.Set(i,i,hii);
//--- check
if(wantt)
{
//--- Apply the transformation to the rest of H.
if(i2>i)
{
workc1.Set(1,cs);
works1.Set(1,sn);
//--- function call
CRotations::ApplyRotationsFromTheLeft(true,i-1,i,i+1,i2,workc1,works1,h,work);
}
workc1.Set(1,cs);
works1.Set(1,sn);
//--- function call
CRotations::ApplyRotationsFromTheRight(true,i1,i-2,i-1,i,workc1,works1,h,work);
}
//--- check
if(wantz)
{
//--- Apply the transformation to Z.
workc1.Set(1,cs);
works1.Set(1,sn);
//--- function call
CRotations::ApplyRotationsFromTheRight(true,iloz,iloz+nz-1,i-1,i,workc1,works1,z,work);
}
}
}
//--- Decrement number of remaining iterations, and return to start of
//--- the main loop with new value of I.
i=l-1;
}
}
//+------------------------------------------------------------------+
//| 2x2 |
//+------------------------------------------------------------------+
void CHsSchur::Aux2x2Schur(double&a,double&b,double&c,double&d,
double&rt1r,double&rt1i,double&rt2r,
double&rt2i,double&cs,double&sn)
{
//--- create variables
double multpl=0;
double aa=0;
double bb=0;
double bcmax=0;
double bcmis=0;
double cc=0;
double cs1=0;
double dd=0;
double eps=0;
double p=0;
double sab=0;
double sac=0;
double scl=0;
double sigma=0;
double sn1=0;
double tau=0;
double temp=0;
double z=0;
//--- initialization
rt1r=0;
rt1i=0;
rt2r=0;
rt2i=0;
cs=0;
sn=0;
multpl=4.0;
eps=CMath::m_machineepsilon;
//--- check
if(c==0.0)
{
cs=1;
sn=0;
}
else
{
//--- check
if(b==0.0)
{
//--- Swap rows and columns
cs=0;
sn=1;
temp=d;
d=a;
a=temp;
b=-c;
c=0;
}
else
{
//--- check
if(a-d==0.0 && ExtSchurSignToone(b)!=ExtSchurSignToone(c))
{
cs=1;
sn=0;
}
else
{
//--- change values
temp=a-d;
p=0.5*temp;
bcmax=MathMax(MathAbs(b),MathAbs(c));
bcmis=MathMin(MathAbs(b),MathAbs(c))*ExtSchurSignToone(b)*ExtSchurSignToone(c);
scl=MathMax(MathAbs(p),bcmax);
z=p/scl*p+bcmax/scl*bcmis;
//--- If Z is of the order of the machine accuracy, postpone the
//--- decision on the nature of eigenvalues
if(z>=multpl*eps)
{
//--- Real eigenvalues. Compute A and D.
z=p+ExtSchurSign(MathSqrt(scl)*MathSqrt(z),p);
a=d+z;
d=d-bcmax/z*bcmis;
//--- Compute B and the rotation matrix
tau=CBlas::PyThag2(c,z);
cs=z/tau;
sn=c/tau;
b=b-c;
c=0;
}
else
{
//--- Complex eigenvalues, or real (almost) equal eigenvalues.
//--- Make diagonal elements equal.
sigma=b+c;
tau=CBlas::PyThag2(sigma,temp);
cs=MathSqrt(0.5*(1+MathAbs(sigma)/tau));
sn=-(p/(tau*cs)*ExtSchurSign(1,sigma));
//--- Compute [ AA BB ] = [ A B ] [ CS -SN ]
//--- [ CC DD ] [ C D ] [ SN CS ]
aa=a*cs+b*sn;
bb=-(a*sn)+b*cs;
cc=c*cs+d*sn;
dd=-(c*sn)+d*cs;
//--- Compute [ A B ] = [ CS SN ] [ AA BB ]
//--- [ C D ] [-SN CS ] [ CC DD ]
a=aa*cs+cc*sn;
b=bb*cs+dd*sn;
c=-(aa*sn)+cc*cs;
d=-(bb*sn)+dd*cs;
temp=0.5*(a+d);
a=temp;
d=temp;
//--- check
if(c!=0.0)
{
//--- check
if(b!=0.0)
{
//--- check
if(ExtSchurSignToone(b)==ExtSchurSignToone(c))
{
//--- Real eigenvalues: reduce to upper triangular form
sab=MathSqrt(MathAbs(b));
sac=MathSqrt(MathAbs(c));
//--- function call
p=ExtSchurSign(sab*sac,c);
tau=1/MathSqrt(MathAbs(b+c));
a=temp+p;
d=temp-p;
b=b-c;
c=0;
cs1=sab*tau;
sn1=sac*tau;
temp=cs*cs1-sn*sn1;
sn=cs*sn1+sn*cs1;
cs=temp;
}
}
else
{
//--- change values
b=-c;
c=0;
temp=cs;
cs=-sn;
sn=temp;
}
}
}
}
}
}
//--- Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
rt1r=a;
rt2r=d;
//--- check
if(c==0.0)
{
rt1i=0;
rt2i=0;
}
else
{
rt1i=MathSqrt(MathAbs(b))*MathSqrt(MathAbs(c));
rt2i=-rt1i;
}
}
//+------------------------------------------------------------------+
//| Schur sign |
//+------------------------------------------------------------------+
double CHsSchur::ExtSchurSign(const double a,const double b)
{
//--- create variables
double result=0;
//--- check
if(b>=0.0)
result=MathAbs(a);
else
result=-MathAbs(a);
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| Schur sign (1 or -1) |
//+------------------------------------------------------------------+
int CHsSchur::ExtSchurSignToone(const double b)
{
//--- create variables
int result=0;
//--- check
if(b>=0.0)
result=1;
else
result=-1;
//--- return result
return(result);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CSpChol::UpdateKernel4444(CRowDouble &rowstorage,
int offss,
int sheight,
int offsu,
int uheight,
CRowDouble &diagd,
int offsd,
CRowInt &raw2smap,
CRowInt &superrowidx,
int urbase)
{
//--- create variables
double d0=diagd[offsd+0];
double d1=diagd[offsd+1];
double d2=diagd[offsd+2];
double d3=diagd[offsd+3];
double u00=d0*rowstorage[offsu+0*4+0];
double u01=d1*rowstorage[offsu+0*4+1];
double u02=d2*rowstorage[offsu+0*4+2];
double u03=d3*rowstorage[offsu+0*4+3];
double u10=d0*rowstorage[offsu+1*4+0];
double u11=d1*rowstorage[offsu+1*4+1];
double u12=d2*rowstorage[offsu+1*4+2];
double u13=d3*rowstorage[offsu+1*4+3];
double u20=d0*rowstorage[offsu+2*4+0];
double u21=d1*rowstorage[offsu+2*4+1];
double u22=d2*rowstorage[offsu+2*4+2];
double u23=d3*rowstorage[offsu+2*4+3];
double u30=d0*rowstorage[offsu+3*4+0];
double u31=d1*rowstorage[offsu+3*4+1];
double u32=d2*rowstorage[offsu+3*4+2];
double u33=d3*rowstorage[offsu+3*4+3];
int targetrow=0;
int offsk=0;
double uk0=0;
double uk1=0;
double uk2=0;
double uk3=0;
for(int k=0; k<uheight; k++)
{
targetrow=offss+raw2smap[superrowidx[urbase+k]]*4;
offsk=offsu+k*4;
uk0=rowstorage[offsk+0];
uk1=rowstorage[offsk+1];
uk2=rowstorage[offsk+2];
uk3=rowstorage[offsk+3];
rowstorage.Set(targetrow,rowstorage[targetrow+0]-u00*uk0-u01*uk1-u02*uk2-u03*uk3);
rowstorage.Set(targetrow+1,rowstorage[targetrow+1]-u10*uk0-u11*uk1-u12*uk2-u13*uk3);
rowstorage.Set(targetrow+2,rowstorage[targetrow+2]-u20*uk0-u21*uk1-u22*uk2-u23*uk3);
rowstorage.Set(targetrow+3,rowstorage[targetrow+3]-u30*uk0-u31*uk1-u32*uk2-u33*uk3);
}
return(true);
}
//+------------------------------------------------------------------+
//| |
//+------------------------------------------------------------------+
bool CSpChol::UpdateKernelABC4(CRowDouble &rowstorage,
int offss,
int twidth,
int offsu,
int uheight,
int urank,
int urowstride,
int uwidth,
CRowDouble &diagd,
int offsd,
CRowInt &raw2smap,
CRowInt &superrowidx,
int urbase)
{
//--- create variables
int k=0;
int targetrow=0;
int targetcol=0;
int offsk=0;
double d0=0;
double d1=0;
double d2=0;
double d3=0;
double u00=0;
double u01=0;
double u02=0;
double u03=0;
double u10=0;
double u11=0;
double u12=0;
double u13=0;
double u20=0;
double u21=0;
double u22=0;
double u23=0;
double u30=0;
double u31=0;
double u32=0;
double u33=0;
double uk0=0;
double uk1=0;
double uk2=0;
double uk3=0;
int srccol0=0;
int srccol1=0;
int srccol2=0;
int srccol3=0;
//--- Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
if(twidth<3 || twidth>4)
return(false);
if(uwidth<3 || uwidth>4)
return(false);
if(urank>4)
return(false);
//--- Determine source columns for target columns, -1 if target column
//--- is not updated.
srccol0=-1;
srccol1=-1;
srccol2=-1;
srccol3=-1;
for(k=0; k<uwidth; k++)
{
targetcol=raw2smap[superrowidx[urbase+k]];
switch(targetcol)
{
case 0:
srccol0=k;
break;
case 1:
srccol1=k;
break;
case 2:
srccol2=k;
break;
case 3:
srccol3=k;
break;
}
}
//--- Load update matrix into aligned/rearranged 4x4 storage
if(urank>=1)
d0=diagd[offsd+0];
if(urank>=2)
d1=diagd[offsd+1];
if(urank>=3)
d2=diagd[offsd+2];
if(urank>=4)
d3=diagd[offsd+3];
if(srccol0>=0)
{
if(urank>=1)
u00=d0*rowstorage[offsu+srccol0*urowstride+0];
if(urank>=2)
u01=d1*rowstorage[offsu+srccol0*urowstride+1];
if(urank>=3)
u02=d2*rowstorage[offsu+srccol0*urowstride+2];
if(urank>=4)
u03=d3*rowstorage[offsu+srccol0*urowstride+3];
}
if(srccol1>=0)
{
if(urank>=1)
u10=d0*rowstorage[offsu+srccol1*urowstride+0];
if(urank>=2)
u11=d1*rowstorage[offsu+srccol1*urowstride+1];
if(urank>=3)
u12=d2*rowstorage[offsu+srccol1*urowstride+2];
if(urank>=4)
u13=d3*rowstorage[offsu+srccol1*urowstride+3];
}
if(srccol2>=0)
{
if(urank>=1)
u20=d0*rowstorage[offsu+srccol2*urowstride+0];
if(urank>=2)
u21=d1*rowstorage[offsu+srccol2*urowstride+1];
if(urank>=3)
u22=d2*rowstorage[offsu+srccol2*urowstride+2];
if(urank>=4)
u23=d3*rowstorage[offsu+srccol2*urowstride+3];
}
if(srccol3>=0)
{
if(urank>=1)
u30=d0*rowstorage[offsu+srccol3*urowstride+0];
if(urank>=2)
u31=d1*rowstorage[offsu+srccol3*urowstride+1];
if(urank>=3)
u32=d2*rowstorage[offsu+srccol3*urowstride+2];
if(urank>=4)
u33=d3*rowstorage[offsu+srccol3*urowstride+3];
}
//--- Run update
switch(urank)
{
case 1:
for(k=0; k<uheight; k++)
{
targetrow=offss+raw2smap[superrowidx[urbase+k]]*4;
offsk=offsu+k*urowstride;
uk0=rowstorage[offsk];
rowstorage.Set(targetrow,rowstorage[targetrow]-u00*uk0);
rowstorage.Set(targetrow+1,rowstorage[targetrow+1]-u10*uk0);
rowstorage.Set(targetrow+2,rowstorage[targetrow+2]-u20*uk0);
rowstorage.Set(targetrow+3,rowstorage[targetrow+3]-u30*uk0);
}
break;
case 2:
for(k=0; k<uheight; k++)
{
targetrow=offss+raw2smap[superrowidx[urbase+k]]*4;
offsk=offsu+k*urowstride;
uk0=rowstorage[offsk];
uk1=rowstorage[offsk+1];
rowstorage.Set(targetrow,rowstorage[targetrow+0]-u00*uk0-u01*uk1);
rowstorage.Set(targetrow+1,rowstorage[targetrow+1]-u10*uk0-u11*uk1);
rowstorage.Set(targetrow+2,rowstorage[targetrow+2]-u20*uk0-u21*uk1);
rowstorage.Set(targetrow+3,rowstorage[targetrow+3]-u30*uk0-u31*uk1);
}
break;
case 3:
for(k=0; k<uheight; k++)
{
targetrow=offss+raw2smap[superrowidx[urbase+k]]*4;
offsk=offsu+k*urowstride;
uk0=rowstorage[offsk];
uk1=rowstorage[offsk+1];
uk2=rowstorage[offsk+2];
rowstorage.Set(targetrow,rowstorage[targetrow]-u00*uk0-u01*uk1-u02*uk2);
rowstorage.Set(targetrow+1,rowstorage[targetrow+1]-u10*uk0-u11*uk1-u12*uk2);
rowstorage.Set(targetrow+2,rowstorage[targetrow+2]-u20*uk0-u21*uk1-u22*uk2);
rowstorage.Set(targetrow+3,rowstorage[targetrow+3]-u30*uk0-u31*uk1-u32*uk2);
}
break;
case 4:
for(k=0; k<uheight; k++)
{
targetrow=offss+raw2smap[superrowidx[urbase+k]]*4;
offsk=offsu+k*urowstride;
uk0=rowstorage[offsk];
uk1=rowstorage[offsk+1];
uk2=rowstorage[offsk+2];
uk3=rowstorage[offsk+3];
rowstorage.Set(targetrow,rowstorage[targetrow+0]-u00*uk0-u01*uk1-u02*uk2-u03*uk3);
rowstorage.Set(targetrow+1,rowstorage[targetrow+1]-u10*uk0-u11*uk1-u12*uk2-u13*uk3);
rowstorage.Set(targetrow+2,rowstorage[targetrow+2]-u20*uk0-u21*uk1-u22*uk2-u23*uk3);
rowstorage.Set(targetrow+3,rowstorage[targetrow+3]-u30*uk0-u31*uk1-u32*uk2-u33*uk3);
}
break;
}
//--- return result
return(true);
}
//+------------------------------------------------------------------+
Reference in New Issue View Git Blame Copy Permalink